Optimize (SETF SCHAR).
[sbcl.git] / make-target-2-load.lisp
blob4e2c1d337647d4c0c28f669c38503d762d2e2019
1 ;;; Do warm init without compiling files.
2 (defvar *compile-files-p* nil)
3 "about to LOAD warm.lisp (with *compile-files-p* = NIL)"
4 (let ((*print-length* 10)
5 (*print-level* 5)
6 (*print-circle* t))
7 (load "src/cold/warm.lisp"))
9 (sb-disassem::!compile-inst-printers)
11 ;;; Unintern no-longer-needed stuff before the possible PURIFY in
12 ;;; SAVE-LISP-AND-DIE.
13 #-sb-fluid (sb-impl::!unintern-init-only-stuff)
15 ;;; A symbol whose INFO slot underwent any kind of manipulation
16 ;;; such that it now has neither properties nor globaldb info,
17 ;;; can have the slot set back to NIL if it wasn't already.
18 (do-all-symbols (symbol)
19 (when (and (sb-kernel:symbol-info symbol)
20 (null (sb-kernel:symbol-info-vector symbol))
21 (null (symbol-plist symbol)))
22 (setf (sb-kernel:symbol-info symbol) nil)))
24 "done with warm.lisp, about to GC :FULL T"
25 (sb-ext:gc :full t)
27 ;;; resetting compilation policy to neutral values in preparation for
28 ;;; SAVE-LISP-AND-DIE as final SBCL core (not in warm.lisp because
29 ;;; SB-C::*POLICY* has file scope)
30 (setq sb-c::*policy* (copy-structure sb-c::**baseline-policy**))
32 ;;; Lock internal packages
33 #+sb-package-locks
34 (dolist (p (list-all-packages))
35 (unless (member p (mapcar #'find-package '("KEYWORD" "CL-USER")))
36 (sb-ext:lock-package p)))
38 "done with warm.lisp, about to SAVE-LISP-AND-DIE"
39 ;;; Even if /SHOW output was wanted during build, it's probably
40 ;;; not wanted by default after build is complete. (And if it's
41 ;;; wanted, it can easily be turned back on.)
42 #+sb-show (setf sb-int:*/show* nil)
43 ;;; The system is complete now, all standard functions are
44 ;;; defined.
45 ;;; The call to CTYPE-OF-CACHE-CLEAR is probably redundant.
46 ;;; SAVE-LISP-AND-DIE calls DEINIT which calls DROP-ALL-HASH-CACHES.
47 (sb-kernel::ctype-of-cache-clear)
48 (setq sb-c::*flame-on-necessarily-undefined-thing* t)
50 ;;; Clean up stray symbols from the CL-USER package.
51 (with-package-iterator (iter "CL-USER" :internal :external)
52 (loop (multiple-value-bind (winp symbol) (iter)
53 (if winp (unintern symbol "CL-USER") (return)))))
55 #+sb-fasteval (setq sb-ext:*evaluator-mode* :interpret)
56 (sb-ext:save-lisp-and-die "output/sbcl.core")