Skip to content
Snippets Groups Projects
Commit 81a1a078 authored by ram's avatar ram
Browse files

Added support for the CMUCLLIB/library: search list. Added load of

library:site-init.  Moved path: initialization here from lispinit.
Only call EVAL:FLUSH-INTERPRETED-FUNCTION-CACHE if it is fbound.
parent a775a8b6
No related branches found
No related tags found
No related merge requests found
...@@ -7,12 +7,13 @@ ...@@ -7,12 +7,13 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.7 1991/06/05 14:00:25 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.8 1991/08/30 15:40:53 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; Dump the current lisp image into a core file. All the real work is done ;;; Dump the current lisp image into a core file. All the real work is done
;;; be C. ;;; be C. Also contains various high-level initialization stuff: loading init
;;; files and parsing environment variables.
;;; ;;;
;;; Written by William Lott. ;;; Written by William Lott.
;;; ;;;
...@@ -50,6 +51,48 @@ ...@@ -50,6 +51,48 @@
(file null-terminated-string)) (file null-terminated-string))
;;; PARSE-UNIX-SEARCH-LIST -- Internal
;;;
;;; Returns a list of the directories that are in the specified Unix
;;; environment variable. Return NIL if the variable is undefined.
;;;
(defun parse-unix-search-list (var)
(let ((path (cdr (assoc var ext::*environment-list*))))
(when path
(do* ((i 0 (1+ p))
(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)))))))
;;; ENVIRONMENT-INIT -- Internal
;;;
;;; Parse the LISP-ENVIRONMENT-LIST into a keyword alist. Set up default
;;; search lists.
;;;
(defun environment-init ()
(dolist (ele lisp-environment-list)
(let ((=pos (position #\= (the simple-string ele))))
(when =pos
(push (cons (intern (string-upcase (subseq ele 0 =pos))
*keyword-package*)
(subseq ele (1+ =pos)))
*environment-list*))))
(setf (search-list "default:") (list (default-directory)))
(setf (search-list "path:") (parse-unix-search-list :path))
(setf (search-list "library:") (parse-unix-search-list :cmucllib)))
(defun save-lisp (core-file-name &key (defun save-lisp (core-file-name &key
(purify t) (purify t)
(root-structures ()) (root-structures ())
...@@ -58,6 +101,7 @@ ...@@ -58,6 +101,7 @@
#'(lambda () #'(lambda ()
(throw 'top-level-catcher nil))) (throw 'top-level-catcher nil)))
(load-init-file t) (load-init-file t)
(site-init "library:site-init")
(enable-gc t) (enable-gc t)
(print-herald t) (print-herald t)
(process-command-line t)) (process-command-line t))
...@@ -86,14 +130,19 @@ ...@@ -86,14 +130,19 @@
:load-init-file :load-init-file
If true, then look for an init.lisp or init.fasl file when the core If true, then look for an init.lisp or init.fasl file when the core
file is resumed. file is resumed.
:site-init
If true, then the name of the site init file to load. The default is
library:site-init. No error if this does not exist.
:print-herald :print-herald
If true, print out the lisp system herald when starting. If true, print out the lisp system herald when starting.
:enable-gc :enable-gc
If true, turn GC on if it was off." If true, turn GC on if it was off."
(eval:flush-interpreted-function-cache) (when (fboundp 'eval:flush-interpreted-function-cache)
(eval:flush-interpreted-function-cache))
(if purify (if purify
(purify :root-structures root-structures :constants constants) (purify :root-structures root-structures :constants constants)
(gc)) (gc))
...@@ -101,15 +150,8 @@ ...@@ -101,15 +150,8 @@
(dolist (f *before-save-initializations*) (funcall f)) (dolist (f *before-save-initializations*) (funcall f))
(dolist (f *after-save-initializations*) (funcall f)) (dolist (f *after-save-initializations*) (funcall f))
(reinit) (reinit)
(dolist (ele lisp-environment-list) (environment-init)
(let ((=pos (position #\= (the simple-string ele)))) (when site-init (load site-init :if-does-not-exist nil))
(when =pos
(push (cons (intern (string-upcase (subseq ele 0 =pos))
*keyword-package*)
(subseq ele (1+ =pos)))
*environment-list*))))
(setf (search-list "default:") (list (default-directory)))
(setf (search-list "path:") (setup-path-search-list))
(when process-command-line (ext::process-command-strings)) (when process-command-line (ext::process-command-strings))
(setf *editor-lisp-p* nil) (setf *editor-lisp-p* nil)
(macrolet ((find-switch (name) (macrolet ((find-switch (name)
...@@ -123,13 +165,14 @@ ...@@ -123,13 +165,14 @@
(when (and load-init-file (when (and load-init-file
(not (and process-command-line (find-switch "noinit")))) (not (and process-command-line (find-switch "noinit"))))
(let* ((cl-switch (find-switch "init")) (let* ((cl-switch (find-switch "init"))
(name (or (and cl-switch (name (and cl-switch
(or (cmd-switch-value cl-switch) (or (cmd-switch-value cl-switch)
(car (cmd-switch-words cl-switch)) (car (cmd-switch-words cl-switch))))))
"init")) (if name
"init"))) (load (merge-pathnames name (user-homedir-pathname))
(load (merge-pathnames name (user-homedir-pathname)) :if-does-not-exist nil)
:if-does-not-exist nil)))) (or (load "home:init" :if-does-not-exist nil)
(load "home:.cmucl-init" :if-does-not-exist nil))))))
(when enable-gc (when enable-gc
(gc-on)) (gc-on))
(when print-herald (when print-herald
...@@ -157,7 +200,7 @@ ...@@ -157,7 +200,7 @@
(write-string ", target ") (write-string ", target ")
(write-string (c:backend-version c:*backend*))) (write-string (c:backend-version c:*backend*)))
(terpri) (terpri)
(write-line "Send bug reports and questions to cmucl-bugs+@cs.cmu.edu.")) (write-line "Send bug reports and questions to cmucl-bugs@cs.cmu.edu."))
(values)) (values))
...@@ -170,4 +213,3 @@ ...@@ -170,4 +213,3 @@
(defun initial-init-function () (defun initial-init-function ()
(gc-on) (gc-on)
(throw 'top-level-catcher nil)) (throw 'top-level-catcher nil))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment