/[cmucl]/src/code/save.lisp
ViewVC logotype

Diff of /src/code/save.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.44 by toy, Wed Jul 10 16:40:43 2002 UTC revision 1.45 by toy, Wed Jan 29 19:47:47 2003 UTC
# Line 43  Line 43 
43    
44  ;;; Filled in by the startup code.  ;;; Filled in by the startup code.
45  (defvar lisp-environment-list)  (defvar lisp-environment-list)
46    (defvar *cmucl-lib*)                    ; Essentially the envvar CMUCLLIB, where available
47    (defvar *cmucl-core-path*)              ; Path to where the Lisp core file was found.
48    
49    
50  ;;; PARSE-UNIX-SEARCH-LIST  --  Internal  ;;; PARSE-UNIX-SEARCH-LIST  --  Internal
# Line 50  Line 52 
52  ;;; Returns a list of the directories that are in the specified Unix  ;;; Returns a list of the directories that are in the specified Unix
53  ;;; environment variable.  Return NIL if the variable is undefined.  ;;; environment variable.  Return NIL if the variable is undefined.
54  ;;;  ;;;
55    (defun parse-unix-search-path (path)
56      (do* ((i 0 (1+ p))
57            (p (position #\: path :start i)
58               (position #\: path :start i))
59            (pl ()))
60           ((null p)
61            (let ((s (subseq path i)))
62              (if (string= s "")
63                  (push "default:" pl)
64                  (push (concatenate 'simple-string s "/") pl)))
65            (nreverse pl))
66        (let ((s (subseq path i p)))
67          (if (string= s "")
68              (push "default:" pl)
69              (push (concatenate 'simple-string s "/") pl)))))
70    
71  (defun parse-unix-search-list (var)  (defun parse-unix-search-list (var)
72    (let ((path (cdr (assoc var ext::*environment-list*))))    (let ((path (cdr (assoc var ext::*environment-list*))))
73      (when path      (when path
74        (do* ((i 0 (1+ p))        (parse-unix-search-path path))))
             (p (position #\: path :start i)  
                (position #\: path :start i))  
             (pl ()))  
            ((null p)  
             (let ((s (subseq path i)))  
               (if (string= s "")  
                   (push "default:" pl)  
                   (push (concatenate 'simple-string s "/") pl)))  
             (nreverse pl))  
         (let ((s (subseq path i p)))  
           (if (string= s "")  
               (push "default:" pl)  
               (push (concatenate 'simple-string s "/") pl)))))))  
75    
76    
77  ;;; ENVIRONMENT-INIT  --  Internal  ;;; ENVIRONMENT-INIT  --  Internal
# Line 90  Line 95 
95              (list (default-directory))))              (list (default-directory))))
96    
97    (setf (search-list "library:")    (setf (search-list "library:")
98          (or (parse-unix-search-list :cmucllib)          (if (boundp '*cmucl-lib*)
99                (parse-unix-search-path *cmucl-lib*)
100              '("/usr/local/lib/cmucl/lib/")))              '("/usr/local/lib/cmucl/lib/")))
101    (setf (search-list "modules:") '("library:subsystems/")))    (setf (search-list "modules:") '("library:subsystems/")))
102    
# Line 119  Line 125 
125        If true (the default), do a purifying GC which moves all dynamically        If true (the default), do a purifying GC which moves all dynamically
126    allocated objects into static space so that they stay pure.  This takes    allocated objects into static space so that they stay pure.  This takes
127    somewhat longer than the normal GC which is otherwise done, but GC's will    somewhat longer than the normal GC which is otherwise done, but GC's will
128    done less often and take less time in the resulting core file.  See    be done less often and take less time in the resulting core file.  See
129    EXT:PURIFY.    EXT:PURIFY.
130    
131    :root-structures    :root-structures
# Line 246  Line 252 
252          ,#'(lambda (stream)          ,#'(lambda (stream)
253               (write-string (lisp-implementation-version) stream))               (write-string (lisp-implementation-version) stream))
254          ", running on "          ", running on "
255          ,#'(lambda (stream) (write-string (machine-instance) stream))))          ,#'(lambda (stream) (write-string (machine-instance) stream))
256            terpri
257            ,#'(lambda (stream)
258                 (let ((core (if (boundp '*cmucl-core-path*)
259                                 (truename *cmucl-core-path*)
260                                 nil)))
261                   (when core
262                     (write-string "With core: " stream)
263                     (write-string (namestring core) stream))))
264            terpri
265            ))
266    
267  (setf (getf *herald-items* :bugs)  (setf (getf *herald-items* :bugs)
268        '("Send questions to cmucl-help@cons.org. and bug reports to cmucl-imp@cons.org."        '("Send questions to cmucl-help@cons.org. and bug reports to cmucl-imp@cons.org."

Legend:
Removed from v.1.44  
changed lines
  Added in v.1.45

  ViewVC Help
Powered by ViewVC 1.1.5