Newer
Older
;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.1.1.1 1990/06/17 02:08:50 wlott Exp $
;;;
;;; Dump the current lisp image into a core file. All the real work is done
;;; be C.
(export '(print-herald save-lisp *before-save-initializations*
*after-save-initializations* *environment-list* *editor-lisp-p*))
(defvar *before-save-initializations* nil
"This is a list of functions which are called before creating a saved core
image. These functions are executed in the child process which has no ports,
so they cannot do anything that tries to talk to the outside world.")
(defvar *after-save-initializations* nil
"This is a list of functions which are called when a saved core image starts
up. The system itself should be initialized at this point, but applications
might not be.")
(defvar *environment-list* nil
"An alist mapping environment variables (as keywords) to either values")
(defvar *editor-lisp-p* nil
"This is true if and only if the lisp was started with the -edit switch.")
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
(def-c-routine "save" (boolean)
(file (pointer simple-string)))
(defun save-lisp (core-file-name &key
(purify t)
(root-structures ())
(init-function
#'(lambda ()
(throw 'top-level-catcher nil)))
(load-init-file t)
(print-herald t)
(process-command-line t))
"Saves a CMU Common Lisp core image in the file of the specified name. The
following keywords are defined:
:purify
If true, do a purifying GC which moves all dynamically allocated
objects into static space so that they stay pure. This takes somewhat
longer than the normal GC which is otherwise done, but GC's will done
less often and take less time in the resulting core file.
:root-structures
This should be a list of the main entry points in any newly loaded
systems. This need not be supplied, but locality will be better if it
is. This is meaningless if :purify is Nil.
:init-function
This is a function which is called when the created core file is
resumed. The default function simply aborts to the top level
read-eval-print loop. If the function returns it will be the value
of Save-Lisp.
:load-init-file
If true, then look for an init.lisp or init.fasl file when the core
file is resumed.
:print-herald
If true, print out the lisp system herald when starting."
(declare (ignore purify root-structures))
#+nil
(if purify
(purify :root-structures root-structures)
(gc))
(unless (save (namestring core-file-name))
(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))
(when process-command-line (ext::process-command-strings))
(setf *editor-lisp-p* nil)
(macrolet ((find-switch (name)
`(find ,name *command-line-switches*
:key #'cmd-switch-name
:test #'(lambda (x y)
(declare (simple-string x y))
(string-equal x y)))))
(when (and process-command-line (find-switch "edit"))
(setf *editor-lisp-p* t))
(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))))
(when print-herald
(print-herald))
(when process-command-line
(ext::invoke-switch-demons *command-line-switches*
*command-switch-demons*))
(funcall init-function)))
(defun print-herald ()
(write-string "CMU Common Lisp ")
(write-line (lisp-implementation-version))
(write-string "Hemlock ")
(write-string *hemlock-version*)
(write-string ", Compiler ")
(write-line #+nil compiler-version #-nil "What compiler?")
(write-line "Send bug reports and questions to Gripe.")
(values))