From ac1b09498edd42d62275022a7cdcb6d1bc9aeb21 Mon Sep 17 00:00:00 2001
From: fgilham <fgilham>
Date: Sat, 20 Jan 2007 02:01:48 +0000
Subject: [PATCH] Hacked default-directory function to avoid calling
 concatenate.  See source comment associated with change.

---
 code/filesys.lisp | 42 ++++++++++++++++++++++++++++++++++++++----
 1 file changed, 38 insertions(+), 4 deletions(-)

diff --git a/code/filesys.lisp b/code/filesys.lisp
index ea18878b4..b6771a333 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.101 2007/01/16 17:28:22 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.102 2007/01/20 02:01:48 fgilham Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1353,6 +1353,37 @@ optionally keeping some of the most recent old versions."
 
 ;;; Default-Directory  --  Public
 ;;;
+#||
+(defun default-directory ()
+  "Returns the pathname for the default directory.  This is the place where
+  a file will be written if no directory is specified.  This may be changed
+  with setf."
+  (multiple-value-bind (gr dir-or-error)
+                       (unix:unix-current-directory)
+    (if gr
+        (let ((*ignore-wildcards* t))
+          (values
+           (parse-namestring (concatenate 'simple-string dir-or-error "/")
+                             *unix-host*)))
+        (error dir-or-error))))
+||#
+;;;
+;;; XXXX This code was modified by me (fmg) to avoid calling
+;;; concatenate.  The reason for this is that there have been
+;;; intermittent instabilities (segv on startup) when the function
+;;; environment-init (in save.lisp) is called.  Apparently the type
+;;; system is not completely sorted out at the time this function is
+;;; first called.  As a result, strange, not completely reproducable
+;;; things happen, related to something in the state of the
+;;; environment (e.g. the paths or the user environment variables or
+;;; something).  These errors occur in the course of calling
+;;; default-directory and the backtrace indicates they occur in the
+;;; context of the type system.  Since I haven't been able to figure
+;;; out why they happen, I decided to punt.
+;;;
+;;; Hopefully someone will really fix the problem someday.
+;;;
+
 (defun default-directory ()
   "Returns the pathname for the default directory.  This is the place where
   a file will be written if no directory is specified.  This may be changed
@@ -1360,12 +1391,15 @@ optionally keeping some of the most recent old versions."
   (multiple-value-bind (gr dir-or-error)
 		       (unix:unix-current-directory)
     (if gr
-	(let ((*ignore-wildcards* t))
+	(let ((*ignore-wildcards* t)
+	      (string (make-string (1+ (length dir-or-error)) :initial-element #\/)))
 	  (values
-	   (parse-namestring (concatenate 'simple-string dir-or-error "/")
-			     *unix-host*)))
+	   (parse-namestring (replace string dir-or-error) *unix-host*)))
 	(error dir-or-error))))
 
+
+
+
 ;;; %Set-Default-Directory  --  Internal
 ;;; 
 (defun %set-default-directory (new-val)
-- 
GitLab