remove misplaced AVER

[sbcl.git] / src / code / cold-init.lisp

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index df0c1ce..808224e 100644 (file)
--- 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)
 
@@ -274,17 +276,15 @@
     (toplevel-init)
     (critically-unreachable "after TOPLEVEL-INIT")))
 
-(defun quit (&key recklessly-p (unix-status 0))
-  #!+sb-doc
-  "Deprecated. See: SB-EXT:EXIT, SB-THREAD:RETURN-FROM-THREAD,
-SB-THREAD:ABORT-THREAD."
+(define-deprecated-function :early "1.0.56.55" quit (exit sb!thread:abort-thread)
+    (&key recklessly-p (unix-status 0))
   (if (or recklessly-p (sb!thread:main-thread-p))
       (exit :code unix-status :abort recklessly-p)
       (sb!thread:abort-thread))
   (critically-unreachable "after trying to die in QUIT"))
 
 (declaim (ftype (sfunction (&key (:code (or null exit-code))
-                                (:timeout (or null real))
+                                 (:timeout (or null real))
                                  (:abort t))
                            nil)
                 exit))
@@ -295,13 +295,13 @@ defaults to 0 when ABORT is false, and 1 when it is true.
 
 When ABORT is false (the default), current thread is first unwound,
 *EXIT-HOOKS* are run, other threads are terminated, and standard
-output streams are flushed before SBCL calls exit(2) -- at which point
+output streams are flushed before SBCL calls exit(3) -- at which point
 atexit(3) functions will run. If multiple threads call EXIT with ABORT
 being false, the first one to call it will complete the protocol.
 
 When ABORT is true, SBCL exits immediately by calling _exit(2) without
 unwinding stack, or calling exit hooks. Note that _exit(2) does not
-call atexit(3) functions unlike exit(2).
+call atexit(3) functions unlike exit(3).
 
 Recursive calls to EXIT cause EXIT to behave as it ABORT was true.
 
@@ -309,10 +309,11 @@ TIMEOUT controls waiting for other threads to terminate when ABORT is
 NIL. Once current thread has been unwound and *EXIT-HOOKS* have been
 run, spawning new threads is prevented and all other threads are
 terminated by calling TERMINATE-THREAD on them. The system then waits
-for them to finish using JOIN-THREAD with the specified TIMEOUT. If a
-thread does not finish in TIMEOUT seconds, it is left to its own
-devices while the exit protocol continues. TIMEOUT defaults to
-*EXIT-TIMEOUT*, which in turn defaults to 60.
+for them to finish using JOIN-THREAD, waiting at most a total TIMEOUT
+seconds for all threads to join. Those threads that do not finish
+in time are simply ignored while the exit protocol continues. TIMEOUT
+defaults to *EXIT-TIMEOUT*, which in turn defaults to 60. TIMEOUT NIL
+means to wait indefinitely.
 
 Note that TIMEOUT applies only to JOIN-THREAD, not *EXIT-HOOKS*. Since
 TERMINATE-THREAD is asynchronous, getting multithreaded application
@@ -348,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))
@@ -372,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))
 
@@ -405,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))