Define getWorkingDirectory via FFI.

6 files changed, 16 insertions, 18 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 3a3cf20a..37f33f56 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,11 @@
 2013-05-26  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
+	* interp/sys-os.boot (getWorkingDirectory): New.  Define via FFI.
+	Replace all uses of GET-CURRENT-DIRECTORY.
+	* interp/daase.lisp (GET-CURRENT-DIRECTORY): Remove.
+
+2013-05-26  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
 	* interp/nlib.lisp (MAKE-FULL-NAMESTRING): Move to sys-utility.boot.
 	Rename to makeFullFilePath.  Adjust callers.
 
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 36aa0c27..80e57d56 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2011, Gabriel Dos Reis.
+;; Copyright (C) 2007-2013, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -806,17 +806,6 @@
 		   (setq data (|getSystemModulePath| data)))))))
       data)))
 
-;; Current directory
-;; Contributed by Juergen Weiss.
-#+:cmu
-(defun get-current-directory ()
-  (namestring (extensions::default-directory)))
-
-#-:cmu
-(defun get-current-directory ()
-  (namestring (truename "")))
-
-  
 ; localdatabase tries to find files in the order of:
 ;  NRLIB/index.KAF
 
@@ -851,7 +840,7 @@
    (let (thisdir nrlibs libs object only dir key 
 		 (|$forceDatabaseUpdate| t) noexpose)
      (declare (special |$forceDatabaseUpdate|))
-     (setq thisdir (get-current-directory))
+     (setq thisdir (|getWorkingDirectory|))
      (setq noexpose nil)
      (multiple-value-setq (only dir noexpose) (processOptions options))
      ;don't force exposure during database build
@@ -1025,7 +1014,7 @@
   (setq *compressvector* nil)
   (withSpecialConstructors)
   (localdatabase nil
-     (list (list '|dir| (get-current-directory) ))
+     (list (list '|dir| (|getWorkingDirectory|) ))
      'make-database)
   (dolist (dir dirlist)
           (localdatabase nil 
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 9bf70aa3..ebd70a47 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -1948,7 +1948,7 @@ reportCount () ==
 
 --% )library
 library args ==
-  origDir := GET_-CURRENT_-DIRECTORY()
+  origDir := getWorkingDirectory()
   $newConlist: local := nil
   -- Users typically specify abbreviations without quotes.  
   LOCALDATABASE([STRING a for a in args],$options)
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 317eaf4a..f990c2c5 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -242,7 +242,7 @@
 
 
 (defun get-directory-list (ft)
-  (let ((cd (get-current-directory)))
+  (let ((cd (|getWorkingDirectory|)))
     (cond ((member ft '("NRLIB" "DAASE" "EXPOSED") :test #'string=)
            (if (eq |$UserLevel| '|development|)
                (cons cd $library-directory-list)
diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot
index 4a5ed497..a9a54d17 100644
--- a/src/interp/sys-os.boot
+++ b/src/interp/sys-os.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2007-2012 Gabriel Dos Reis.
+-- Copyright (C) 2007-2013 Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -49,6 +49,9 @@ loadSystemRuntimeCore()
 
 --% File System Support
 
+++ Current working directory
+import oa__getcwd: () -> string for getWorkingDirectory
+
 ++ change current working directory.
 import oa__chdir: string -> int for changeDirectory
        -- 0: success, -1: failure
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index f4ef0187..c8dfa8b6 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -79,7 +79,7 @@
       direc))))
 
 (defun interp-make-directory (direc)
-  (let ((current-dir (get-current-directory)))
+  (let ((current-dir (|getWorkingDirectory|)))
     (setq direc (namestring direc))
     (|ensureTrailingSlash|
      (if (string= direc "")