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 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(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
;;; be C.
;;; be C. Also contains various high-level initialization stuff: loading init
;;; files and parsing environment variables.
;;;
;;; Written by William Lott.
;;;
......@@ -50,6 +51,48 @@
(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
(purify t)
(root-structures ())
......@@ -58,6 +101,7 @@
#'(lambda ()
(throw 'top-level-catcher nil)))
(load-init-file t)
(site-init "library:site-init")
(enable-gc t)
(print-herald t)
(process-command-line t))
......@@ -86,14 +130,19 @@
:load-init-file
If true, then look for an init.lisp or init.fasl file when the core
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
If true, print out the lisp system herald when starting.
:enable-gc
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
(purify :root-structures root-structures :constants constants)
(gc))
......@@ -101,15 +150,8 @@
(dolist (f *before-save-initializations*) (funcall f))
(dolist (f *after-save-initializations*) (funcall f))
(reinit)
(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:") (setup-path-search-list))
(environment-init)
(when site-init (load site-init :if-does-not-exist nil))
(when process-command-line (ext::process-command-strings))
(setf *editor-lisp-p* nil)
(macrolet ((find-switch (name)
......@@ -123,13 +165,14 @@
(when (and load-init-file
(not (and process-command-line (find-switch "noinit"))))
(let* ((cl-switch (find-switch "init"))
(name (or (and cl-switch
(or (cmd-switch-value cl-switch)
(car (cmd-switch-words cl-switch))
"init"))
"init")))
(load (merge-pathnames name (user-homedir-pathname))
:if-does-not-exist nil))))
(name (and cl-switch
(or (cmd-switch-value cl-switch)
(car (cmd-switch-words cl-switch))))))
(if name
(load (merge-pathnames name (user-homedir-pathname))
: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
(gc-on))
(when print-herald
......@@ -157,7 +200,7 @@
(write-string ", target ")
(write-string (c:backend-version c:*backend*)))
(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))
......@@ -170,4 +213,3 @@
(defun initial-init-function ()
(gc-on)
(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