From 5b90309d09bb9f9d17ff86f644994953ce94c0b3 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Mon, 27 May 2013 01:36:14 +0000
Subject: Define getWorkingDirectory via FFI.

---
 src/ChangeLog            |  6 ++++++
 src/interp/daase.lisp    | 17 +++--------------
 src/interp/i-syscmd.boot |  2 +-
 src/interp/nlib.lisp     |  2 +-
 src/interp/sys-os.boot   |  5 ++++-
 src/interp/util.lisp     |  2 +-
 6 files changed, 16 insertions(+), 18 deletions(-)

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index 3a3cf20a..37f33f56 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+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.
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 "")  
-- 
cgit v1.2.3