X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftoplevel.lisp;h=a36683ff3f2e38d84a9cb566173b1ac064cb7feb;hb=4f7211e1d005696dcd29d8322fa531992ea8fed4;hp=5e1e791934636524400bbc5dcefde52d7dd20046;hpb=d7f6139a91d7d9b0667a597584ae306d958bb2f4;p=sbcl.git

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 5e1e791..a36683f 100644
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -15,14 +15,16 @@
 
 (defconstant most-positive-fixnum #.sb!vm:*target-most-positive-fixnum*
   #!+sb-doc
-  "The fixnum closest in value to positive infinity.")
+  "the fixnum closest in value to positive infinity")
 
 (defconstant most-negative-fixnum #.sb!vm:*target-most-negative-fixnum*
   #!+sb-doc
-  "The fixnum closest in value to negative infinity.")
+  "the fixnum closest in value to negative infinity")
 
-;;;; magic specials initialized by genesis
+;;;; magic specials initialized by GENESIS
 
+;;; FIXME: The DEFVAR here is redundant with the (DECLAIM (SPECIAL ..))
+;;; of all static symbols in early-impl.lisp.
 #!-gengc
 (progn
   (defvar *current-catch-block*)
@@ -73,15 +75,20 @@
 
 ;;;; working with *CURRENT-ERROR-DEPTH* and *MAXIMUM-ERROR-DEPTH*
 
-;;; INFINITE-ERROR-PROTECT is used by ERROR and friends to keep us out of
-;;; hyperspace.
+;;; INFINITE-ERROR-PROTECT is used by ERROR and friends to keep us out
+;;; of hyperspace.
 (defmacro infinite-error-protect (&rest forms)
   `(unless (infinite-error-protector)
+     (/show0 "back from INFINITE-ERROR-PROTECTOR")
      (let ((*current-error-depth* (1+ *current-error-depth*)))
+       (/show0 "in INFINITE-ERROR-PROTECT, incremented error depth")
+       #+sb-show (sb-debug:backtrace)
        ,@forms)))
 
 ;;; a helper function for INFINITE-ERROR-PROTECT
 (defun infinite-error-protector ()
+  (/show0 "entering INFINITE-ERROR-PROTECTOR, *CURRENT-ERROR-DEPTH*=..")
+  (/hexstr *current-error-depth*)
   (cond ((not *cold-init-complete-p*)
 	 (%primitive print "Argh! error in cold init, halting")
 	 (%primitive sb!c:halt))
@@ -92,6 +99,8 @@
 	 (%primitive print "Argh! corrupted error depth, halting")
 	 (%primitive sb!c:halt))
 	((> *current-error-depth* *maximum-error-depth*)
+	 (/show0 "*MAXIMUM-ERROR-DEPTH*=..")
+	 (/hexstr *maximum-error-depth*)
 	 (/show0 "in INFINITE-ERROR-PROTECTOR, calling ERROR-ERROR")
 	 (error-error "Help! "
 		      *current-error-depth*
@@ -99,6 +108,7 @@
 		      "KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
 	 t)
 	(t
+	 (/show0 "returning normally from INFINITE-ERROR-PROTECTOR")
 	 nil)))
 
 ;;; FIXME: I had a badly broken version of INFINITE-ERROR-PROTECTOR at
@@ -155,16 +165,16 @@
 
 (defconstant bytes-per-scrub-unit 2048)
 
+;;; Zero the unused portion of the control stack so that old objects
+;;; are not kept alive because of uninitialized stack variables.
+;;;
+;;; FIXME: Why do we need to do this instead of just letting GC read
+;;; the stack pointer and avoid messing with the unused portion of
+;;; the control stack? (Is this a multithreading thing where there's
+;;; one control stack and stack pointer per thread, and it might not
+;;; be easy to tell what a thread's stack pointer value is when
+;;; looking in from another thread?)
 (defun scrub-control-stack ()
-  #!+sb-doc
-  "Zero the unused portion of the control stack so that old objects are not
-   kept alive because of uninitialized stack variables."
-  ;; FIXME: Why do we need to do this instead of just letting GC read
-  ;; the stack pointer and avoid messing with the unused portion of
-  ;; the control stack? (Is this a multithreading thing where there's
-  ;; one control stack and stack pointer per thread, and it might not
-  ;; be easy to tell what a thread's stack pointer value is when
-  ;; looking in from another thread?)
   (declare (optimize (speed 3) (safety 0))
 	   (values (unsigned-byte 20))) ; FIXME: DECLARE VALUES?
 
@@ -290,8 +300,6 @@
 (defun toplevel-init ()
 
   (/show0 "entering TOPLEVEL-INIT")
-  (%primitive print "//entering TOPLEVEL-INIT") ; REMOVEME
-
   
   (let ((sysinit nil)        ; value of --sysinit option
 	(userinit nil)       ; value of --userinit option