;; *TYPE-SYSTEM-INITIALIZED-WHEN-BOUND* so that it doesn't need to
;; be explicitly set in order to be meaningful.
(setf *after-gc-hooks* nil
+ *in-without-gcing* nil
*gc-inhibit* t
*gc-pending* nil
#!+sb-thread *stop-for-gc-pending* #!+sb-thread nil
*allow-with-interrupts* t
+ sb!unix::*unblock-deferrables-on-enabling-interrupts-p* nil
*interrupts-enabled* t
*interrupt-pending* nil
*break-on-signals* nil
;; forms run.
(show-and-call !type-class-cold-init)
(show-and-call !typedefs-cold-init)
+ (show-and-call !world-lock-cold-init)
(show-and-call !classes-cold-init)
(show-and-call !early-type-cold-init)
(show-and-call !late-type-cold-init)
(setf (svref *!load-time-values* (third toplevel-thing))
(funcall (second toplevel-thing))))
(:load-time-value-fixup
- (setf (sap-ref-word (second toplevel-thing) 0)
+ (setf (sap-ref-word (int-sap (get-lisp-obj-address (second toplevel-thing)))
+ (third toplevel-thing))
(get-lisp-obj-address
- (svref *!load-time-values* (third toplevel-thing)))))
- #!+(and (or x86 x86-64) gencgc)
- (:load-time-code-fixup
- (sb!vm::!envector-load-time-code-fixup (second toplevel-thing)
- (third toplevel-thing)
- (fourth toplevel-thing)
- (fifth toplevel-thing)))
+ (svref *!load-time-values* (fourth toplevel-thing)))))
(t
(!cold-lose "bogus fixup code in *!REVERSED-COLD-TOPLEVELS*"))))
(t (!cold-lose "bogus function in *!REVERSED-COLD-TOPLEVELS*")))))
;; The reader and printer are initialized very late, so that they
;; can do hairy things like invoking the compiler as part of their
;; initialization.
- (show-and-call !reader-cold-init)
- (let ((*readtable* *standard-readtable*))
+ (let ((*readtable* (make-readtable)))
+ (show-and-call !reader-cold-init)
(show-and-call !sharpm-cold-init)
- (show-and-call !backq-cold-init))
+ (show-and-call !backq-cold-init)
+ ;; The *STANDARD-READTABLE* is assigned at last because the above
+ ;; functions would operate on the standard readtable otherwise---
+ ;; which would result in an error.
+ (setf *standard-readtable* *readtable*))
(setf *readtable* (copy-readtable *standard-readtable*))
(setf sb!debug:*debug-readtable* (copy-readtable *standard-readtable*))
(sb!pretty:!pprint-cold-init)
(/show0 "done initializing, setting *COLD-INIT-COMPLETE-P*")
(setf *cold-init-complete-p* t)
+ ; hppa heap is segmented, lisp and c uses a stub to call eachother
+ #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub)
;; The system is finally ready for GC.
(/show0 "enabling GC")
- (gc-on)
+ (setq *gc-inhibit* nil)
(/show0 "doing first GC")
(gc :full t)
(/show0 "back from first GC")
#!+sb-show
(defun cold-print (x)
- (typecase x
- (simple-string (sb!sys:%primitive print x))
- (symbol (sb!sys:%primitive print (symbol-name x)))
- (list (let ((count 0))
- (sb!sys:%primitive print "list:")
- (dolist (i x)
- (when (>= (incf count) 4)
- (sb!sys:%primitive print "...")
- (return))
- (cold-print i))))
- (t (sb!sys:%primitive print (hexstr x)))))
+ (labels ((%cold-print (obj depthoid)
+ (if (> depthoid 4)
+ (sb!sys:%primitive print "...")
+ (typecase obj
+ (simple-string
+ (sb!sys:%primitive print obj))
+ (symbol
+ (sb!sys:%primitive print (symbol-name obj)))
+ (cons
+ (sb!sys:%primitive print "cons:")
+ (let ((d (1+ depthoid)))
+ (%cold-print (car obj) d)
+ (%cold-print (cdr obj) d)))
+ (t
+ (sb!sys:%primitive print (hexstr x)))))))
+ (%cold-print x 0))
+ (values))
\ No newline at end of file