Commit 3eec27c6 authored by wlott's avatar wlott
Browse files

Added noise to support load-time-value and make-load-form in the kernel

parent 595dc48e
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.25 1991/12/15 10:21:38 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.26 1991/12/16 18:47:09 wlott Exp $")
;;; **********************************************************************
......@@ -470,7 +470,8 @@
;;; %End-Of-The-World. We quit this way so that all outstanding cleanup forms
;;; in Unwind-Protects will get executed.
(proclaim '(special *lisp-initialization-functions*))
(proclaim '(special *lisp-initialization-functions*
(eval-when (compile)
(defmacro print-and-call (name)
......@@ -499,12 +500,31 @@
;; Some of the random top-level forms call Make-Array, which calls Subtypep...
(print-and-call type-init)
(setf *lisp-initialization-functions*
(nreverse *lisp-initialization-functions*))
(%primitive print "Calling top-level forms.")
(dolist (fun *lisp-initialization-functions*)
(funcall fun))
(let ((funs (nreverse *lisp-initialization-functions*)))
(%primitive print "Calling top-level forms.")
(dolist (fun funs)
(typecase fun
(funcall fun))
(case (car fun)
(setf (svref *load-time-values* (third fun))
(funcall (second fun))))
(setf (sap-ref-32 (second fun) 0)
(svref *load-time-values* (third fun)))))
(%primitive print
"Bogus fixup in *lisp-initialization-functions*")
(%primitive print
"Bogus function in *lisp-initialization-functions*")
(makunbound '*lisp-initialization-functions*) ; So it gets GC'ed.
(makunbound '*load-time-values*)
;; Only do this after top level forms have run, 'cause thats where
;; deftypes are.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment