Forked from
cmucl / cmucl
6921 commits behind the upstream repository.
save.lisp 9.56 KiB
;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.33 1997/12/30 16:39:23 dtc Exp $")
;;;
;;; **********************************************************************
;;;
;;; Dump the current lisp image into a core file. All the real work is done
;;; be C. Also contains various high-level initialization stuff: loading init
;;; files and parsing environment variables.
;;;
;;; Written by William Lott.
;;;
;;;
(in-package "LISP")
(in-package "EXTENSIONS")
(export '(print-herald *herald-items* save-lisp *before-save-initializations*
*after-save-initializations* *environment-list* *editor-lisp-p*))
(in-package "LISP")
(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.")
;;; Filled in by the startup code.
(defvar lisp-environment-list)
;;; 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)))))))