Re: [Axiom-developer] Current directory at startup

[Waldek Hebisch]

Gregory Vanuxem wrote:
> Some (?) other issues:
> 
> (1) -> )cd temp
>    The current AXIOM default directory
> is /home/greg/wh-axiom/axiom/target/x86_64-unknown-linux/ 
> (1) -> )cd
>    The current AXIOM default directory is /home/greg/ 
> (1) -> )cd temp
>  
>    >> System error:
>    #p"/home/greg/" is not of type SEQUENCE.
> 
> the /home/greg/temp directory exists.
> 
> Greg
> 

I belive that following patch (applied to wh-sandbox) fixes this problem.
The patch may be somewhat controversial -- I removed code for ancient
systems (because this code is clearly broken by later changes) and
decided to consistently apply convention that directory names have
no extra directory separator at the end.  The changes may works or
not on Windows depending how Windows Lisps handle namestrings,
since I can not test what happens on Windows I did not try to add
special code.  AFAIK Windows kernel happily works with pathnames
containing slashes and many portable programs internally exclusively
use slashes in pathnames (converting from backslashes on input),
so the code _may_ work.  

Anyway, patch follows (note that this patch will probably do
no good without other pathname changes from wh-sandbox):

Index: src/interp/vmlisp.lisp.pamphlet
===================================================================
--- src/interp/vmlisp.lisp.pamphlet     (wersja 440)
+++ src/interp/vmlisp.lisp.pamphlet     (wersja 441)
@@ -97,13 +97,18 @@
 \section{The get-current-directory function}
 Contributed by Juergen Weiss.
 <<getCD>>=
+(defun trim-directory-name (name)
+    #+:unix
+    (if (char= (char name (1- (length name))) #\/)
+        (setf name (subseq name 0 (1- (length name)))))
+    name)
 #+:cmu
 (defun get-current-directory ()
   (namestring (extensions::default-directory)))
 
 #+(or :akcl :gcl)
 (defun get-current-directory ()
-  (namestring (truename "")))
+    (trim-directory-name (namestring (truename ""))))
 
 @
 \section{License}
@@ -2015,13 +2020,14 @@
 (defun MAKE-BVEC (n)
  (make-array (list n) :element-type 'bit :initial-element 0))
 
+<<getCD>>
+
 (in-package 'boot)
 
 <<manexp>>
 <<acot>>
 <<cot>>
 <<asec>>
-<<getCD>>
 <<Missing DFLOAT Transcendental functions>>
 
 
Index: src/interp/bootlex.lisp.pamphlet
===================================================================
--- src/interp/bootlex.lisp.pamphlet    (wersja 440)
+++ src/interp/bootlex.lisp.pamphlet    (wersja 441)
@@ -184,7 +184,6 @@
           (OPTIONLIST nil)
           (*EOF* NIL)
           (File-Closed NIL)
-        ;;  ($current-directory "/spad/libraries/")
           (/editfile *spad-input-file*)
           (|$noSubsumption| |$noSubsumption|)
           in-stream out-stream)
Index: src/interp/util.lisp.pamphlet
===================================================================
--- src/interp/util.lisp.pamphlet       (wersja 440)
+++ src/interp/util.lisp.pamphlet       (wersja 441)
@@ -760,36 +760,6 @@
       (mapcar #'load files)))
 
 @
-\subsubsection{interp-make-directory}
-This is used by the ")cd" system command.
-<<interp-make-directory>>=
-(defun interp-make-directory (direc)
-  (setq direc (namestring direc))
-  (if (string= direc "")  $current-directory
-   (if (or (memq :unix *features*)
-          (memq 'unix *features*))
-    (progn
-      (if (char/= (char $current-directory (1-(length $current-directory))) 
#\/)
-         (setq $current-directory (concat $current-directory "/")))
-      (if (char/= (char direc 0) #\/)
-         (setq direc (concat $current-directory direc)))
-      (if (char/= (char direc (1- (length direc))) #\/)
-         (setq direc (concat direc "/")))
-      direc)
-    (progn ;; Assume Windows conventions
-      (if (not (or (char= (char $current-directory (1- (length 
$current-directory))) #\/)
-                   (char= (char $current-directory (1- (length 
$current-directory))) #\\ )))
-         (setq $current-directory (concat $current-directory "\\")))
-      (if (not (or (char= (char direc 0) #\/)
-                   (char= (char direc 0) #\\)
-                   (find #\: direc)))
-          (setq direc (concat $current-directory direc)))
-      (if (not (or (char= (char direc (1- (length direc))) #\/)
-                   (char= (char direc (1- (length direc))) #\\ )))
-         (setq direc (concat direc "\\")))
-      direc))))
-
-@
 \subsubsection{make-directory}
 Make a directory relative to the {\bf \$spadroot} variable.
 <<make-directory>>=
@@ -1448,12 +1418,11 @@
 <<license>>
 
 (in-package "BOOT")
-(export '($spadroot $directory-list $current-directory reroot
+(export '($spadroot $directory-list reroot
          make-absolute-filename |$msgDatabaseName| |$defaultMsgDatabaseName|))
 
 <<our-write-date>>
 <<make-directory>>
-<<interp-make-directory>>
 <<bin-path>>
 <<load-directory>>
 <<compspadfiles>>
Index: src/interp/patches.lisp.pamphlet
===================================================================
--- src/interp/patches.lisp.pamphlet    (wersja 440)
+++ src/interp/patches.lisp.pamphlet    (wersja 441)
@@ -114,15 +114,11 @@
     ))
 
 (defun |cd| (args)
-  (cond ((null args)
-#+(and :lucid :ibm/370)
-         (setq $current-directory "")
-#-(and :lucid :ibm/370)
-         (setq $current-directory (truename (user-homedir-pathname))) )
-        ((eql (|directoryp| (interp-make-directory (car args))) 1)
-         (setq $current-directory (namestring (truename (interp-make-directory 
(car args)))))))
-#+(or :kcl :ibcl :CCL) (system:CHDIR $current-directory)
-  (|sayKeyedMsg| 'S2IZ0070 (list (namestring $current-directory))))
+    (let ((dname (if (null args)
+                     (trim-directory-name (namestring (user-homedir-pathname)))
+                     (car args))))
+         #+(or :kcl :ibcl :CCL) (system:CHDIR dname))
+  (|sayKeyedMsg| 'S2IZ0070 (list (get-current-directory))))
 
 <<toplevel>>
 (define-function 'top-level #'toplevel)
@@ -285,10 +281,6 @@
 (setq |$consistencyCheck| ()) ;; prevents wasting time checking consistency
 
 
-#+(or :CCL (and :lucid :ibm/370))
-(setq vmlisp::$current-directory (truename "."))
-#-(or :CCL (and :lucid :ibm/370))
-(setq vmlisp::$current-directory (make-directory *default-pathname-defaults*))
 
 (defvar *msghash* nil "hash table keyed by msg number")
 
@@ -328,8 +320,6 @@
 (|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|)
 
 #+:dos
-(setq vmlisp::$current-directory (truename "."))
-#+:dos
 (setq vmlisp::$spadroot "/spad/mnt/dos")
 #+:dos
 (defun user-homedir-pathname ()
Index: src/interp/nlib.lisp.pamphlet
===================================================================
--- src/interp/nlib.lisp.pamphlet       (wersja 440)
+++ src/interp/nlib.lisp.pamphlet       (wersja 441)
@@ -435,7 +435,7 @@
 (defun make-full-namestring (filearg &optional (filetype nil))
   (namestring (merge-pathnames (make-filename filearg filetype))))
 
-(defun get-directory-list (ft &aux (cd (namestring $current-directory)))
+(defun get-directory-list (ft &aux (cd (get-current-directory)))
   (cond ((member ft '("NRLIB" "DAASE" "EXPOSED") :test #'string=)
           (if (eq BOOT::|$UserLevel| 'BOOT::|development|)
               (cons cd $library-directory-list)
Index: src/interp/bookvol5.pamphlet
===================================================================
--- src/interp/bookvol5.pamphlet        (wersja 440)
+++ src/interp/bookvol5.pamphlet        (wersja 441)
@@ -177,8 +177,6 @@
 coerceFailure                &                     & runspad \\
 curinstream                  & ncIntLoop           & \\
 curoutstream                 & ncIntLoop           & \\
-vmlisp::\$current-directory  & restart             & \\
-                             & reroot              & \\
 \$currentLine                & restart             & removeUndoLines \\
 \$dalymode                   &                     & intloopReadConsole \\
 \$defaultMsgDatabaseName     & reroot              & \\
@@ -275,28 +273,6 @@
 [[*standard-output*]] common lisp variable in [[ncIntLoop]].
 While not using the ``dollar'' convention this variable is still ``global''.
 
-\subsection{vmlisp::\$current-directory}
-When running in Lucid Common Lisp ([[:lucid]]) on an IBM/370 mainframe
-([[:ibm/370]]) this variable is used in place of the 
-[[*default-pathname-defaults*]] common lisp variable. 
-Otherwise this variable is
-set to the empty string in [[restart]]. 
-
-Notice that the variable [[*default-pathname-defaults*]] is a Common
-Lisp standard variable with implementation defined meaning.
-Typically, its value is an object that represents the directory from
-where the Lisp image has been started.
-
-The [[reroot]] function sets this variable to the value of
-[[$spadroot]] which itself has the value of the argument to the
-[[reroot]] function. Since the argument to the [[reroot]] function is
-an string which represents an absolute pathname pointing to AXIOM the
-net result is that the [[$current-directory]] is set to point to the
-shell [[AXIOM]] variable.
-
-So during execute both [[$current-directory]] and [[$spadroot]] reflect
-the value of the [[AXIOM]] shell variable.
-
 \subsection{\$currentLine}
 The [[$currentLine]] line is set to [[NIL]] in [[restart]].
 It is used in [[removeUndoLines]] in the undo mechanism.
@@ -708,11 +684,6 @@
   (setq |$IOindex| 1)
   (setq |$InteractiveFrame| (|makeInitialModemapFrame|))
   (setq |$printLoadMsgs| t)
-#+(and :lucid :ibm/370)
-  (setq vmlisp::$current-directory "")
-#-(and :lucid :ibm/370)
-  (setq vmlisp::$current-directory
-     (make-directory *default-pathname-defaults*))
   (|loadExposureGroupData|)
   (|statisticsInitialization|)
   (|initHist|)
@@ -1144,8 +1115,7 @@
    (mapcar #'make-absolute-filename $relative-library-directory-list))
   (setq |$defaultMsgDatabaseName|
        (pathname (make-absolute-filename "/share/msgs/s2-us.msgs")))
-  (setq |$msgDatabaseName| ())
-  (setq $current-directory $spadroot))
+  (setq |$msgDatabaseName| ()))
 
 @
 \subsection{defun statisticsInitialization}
Index: src/interp/sys-pkg.lisp.pamphlet
===================================================================
--- src/interp/sys-pkg.lisp.pamphlet    (wersja 440)
+++ src/interp/sys-pkg.lisp.pamphlet    (wersja 441)
@@ -427,7 +427,7 @@
         VMLISP::APPLX VMLISP::LASTNODE VMLISP::SUBSTQ VMLISP::TRUEFN
         VMLISP::|last| VMLISP::RPLACSTR VMLISP::SETQP VMLISP::QCADDR
         VMLISP::QCAADAR VMLISP::QCDDAAR VMLISP::|intersection|
-        VMLISP::HASHTABLE-CLASS VMLISP::$CURRENT-DIRECTORY
+        VMLISP::HASHTABLE-CLASS
         VMLISP::*COMP370-APPLY* VMLISP::QSETVELT VMLISP::MOVEVEC
         VMLISP::ID VMLISP::DEFINE-FUNCTION VMLISP::MSUBSTQ VMLISP::|nsubst|
         VMLISP::LISTOFFLUIDS VMLISP::SUB1 VMLISP::NUMBEROFARGS
@@ -449,7 +449,8 @@
         VMLISP::INTERSECTIONQ VMLISP::DSETQ VMLISP::FETCHCHAR
         VMLISP::STRCONC VMLISP::MACRO-MISSINGARGS VMLISP::RPACKFILE
         VMLISP::EXIT VMLISP::PLUS VMLISP::RKEYIDS
-        VMLISP::COMPILE-LIB-FILE VMLISP::RECOMPILE-LIB-FILE-IF-NECESSARY))
+        VMLISP::COMPILE-LIB-FILE VMLISP::RECOMPILE-LIB-FILE-IF-NECESSARY
+         VMLISP::GET-CURRENT-DIRECTORY VMLISP::TRIM-DIRECTORY-NAME))
 
 ;;; Definitions for package BOOT of type SHADOW
 (lisp:in-package "BOOT")
Index: ChangeLog.wh
===================================================================
--- ChangeLog.wh        (wersja 440)
+++ ChangeLog.wh        (wersja 441)
@@ -1,3 +1,22 @@
+2007-02-25  Waldek Hebisch  <address@hidden>
+
+       Fix current directory handling.  Remove $current-directory
+       variable and all referenctes to it.
+       * src/interp/vmlisp.lisp.pamphlet: trim-directory-name: new
+       function.
+       <getCD>: move to VMLISP package
+       * src/interp/sys-pkg.lisp.pamphlet: export get-current-directory
+       and trim-directory-name.
+       * src/interp/patches.lisp.pamphlet: |cd|: just change directory
+       (do not mess with $current-directory).
+       do not set $current-directory.
+       * src/interp/bookvol5.pamphlet: do not set $current-directory.
+       * src/interp/nlib.lisp.pamphlet: get-directory-list: use
+       get-current-directory.
+       * src/interp/util.lisp.pamphlet: interp-make-directory: remove.
+       * src/interp/bootlex.lisp.pamphlet: remove comment referencing
+       $current-directory.
+       
 2007-02-24  Waldek Hebisch  <address@hidden>
 
        Make the final image independent of cmpinclude.h


-- 
                              Waldek Hebisch
address@hidden