X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcold-init.lisp;h=808224e2c4f871653099e0eb9b1f25ac46f8b54a;hb=18dc0069cd514c976042766ab9a785c970fe1603;hp=30f3eaafd04a411e449369f072d5d2b661909ec4;hpb=8a33054f6541596c61b091e2b77118deda1511e2;p=sbcl.git

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 30f3eaa..808224e 100644
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -101,6 +101,7 @@
         sb!unix::*unblock-deferrables-on-enabling-interrupts-p* nil
         *interrupts-enabled* t
         *interrupt-pending* nil
+        #!+sb-thruption #!+sb-thruption *thruption-pending* nil
         *break-on-signals* nil
         *maximum-error-depth* 10
         *current-error-depth* 0
@@ -229,7 +230,8 @@
   (show-and-call stream-cold-init-or-reset)
   (show-and-call !loader-cold-init)
   (show-and-call !foreign-cold-init)
-  #!-win32 (show-and-call signal-cold-init-or-reinit)
+  #!-(and win32 (not sb-thread))
+  (show-and-call signal-cold-init-or-reinit)
   (/show0 "enabling internal errors")
   (setf (sb!alien:extern-alien "internal_errors_enabled" boolean) t)
 
@@ -347,10 +349,11 @@ process to continue normally."
   (setf sb!alien::*default-c-string-external-format* nil)
   ;; WITHOUT-GCING implies WITHOUT-INTERRUPTS.
   (without-gcing
+    ;; Initialize streams first, so that any errors can be printed later
+    (stream-reinit t)
     (os-cold-init-or-reinit)
     (thread-init-or-reinit)
-    (stream-reinit t)
-    #!-win32
+    #!-(and win32 (not sb-thread))
     (signal-cold-init-or-reinit)
     (setf (sb!alien:extern-alien "internal_errors_enabled" boolean) t)
     (float-cold-init-or-reinit))
@@ -371,20 +374,21 @@ process to continue normally."
 #!+sb-show
 (defun hexstr (thing)
   (/noshow0 "entering HEXSTR")
-  (let ((addr (get-lisp-obj-address thing))
-        (str (make-string 10 :element-type 'base-char)))
+  (let* ((addr (get-lisp-obj-address thing))
+         (nchars (* sb!vm:n-word-bytes 2))
+         (str (make-string (+ nchars 2) :element-type 'base-char)))
     (/noshow0 "ADDR and STR calculated")
     (setf (char str 0) #\0
           (char str 1) #\x)
     (/noshow0 "CHARs 0 and 1 set")
-    (dotimes (i 8)
+    (dotimes (i nchars)
       (/noshow0 "at head of DOTIMES loop")
       (let* ((nibble (ldb (byte 4 0) addr))
              (chr (char "0123456789abcdef" nibble)))
         (declare (type (unsigned-byte 4) nibble)
                  (base-char chr))
         (/noshow0 "NIBBLE and CHR calculated")
-        (setf (char str (- 9 i)) chr
+        (setf (char str (- (1+ nchars) i)) chr
               addr (ash addr -4))))
     str))
 
@@ -404,6 +408,6 @@ process to continue normally."
                       (%cold-print (car obj) d)
                       (%cold-print (cdr obj) d)))
                    (t
-                    (sb!sys:%primitive print (hexstr x)))))))
+                    (sb!sys:%primitive print (hexstr obj)))))))
     (%cold-print x 0))
-  (values))
\ No newline at end of file
+  (values))