0.pre7.86.flaky7.22:

	removed various /SHOW-ish cruft
	about that debugger/restart/QUIT problem...
	...revived SB-DI:FRAME-CATCHES enough that (BREAK), F 4,
		(SB-DI::FRAME-CATCHES SB-DEBUG::*CURRENT-FRAME*)
		shows %END-OF-THE-WORLD
	...exported SB-VM:*CURRENT-CATCH-BLOCK* to support this

diff --git a/BUGS b/BUGS
index e905d42..2f5f538 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1300,6 +1300,21 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   internal compiler error. (This error occurs in sbcl-0.6.13 and in
   0.pre7.86.flaky7.14.)
 
+133:
+  Trying to compile something like 
+    (sb!alien:def-alien-routine "breakpoint_remove" sb!c-call:void
+      (code-obj sb!c-call:unsigned-long)
+      (pc-offset sb!c-call:int)
+      (old-inst sb!c-call:unsigned-long))
+  in SBCL-0.pre7.86.flaky7.22 after warm init fails with an error
+    cannot use values types here
+  probably because the SB-C-CALL:VOID type gets translated to (VALUES).
+  It should be valid to use VOID for a function return type, so perhaps
+  instead of calling SPECIFIER-TYPE (which excludes all VALUES types
+  automatically) we should call VALUES-SPECIFIER-TYPE and handle VALUES
+  types manually, allowing the special case (VALUES) but still excluding
+  all more-complex VALUES types.
+
 KNOWN BUGS RELATED TO THE IR1 INTERPRETER
 
 (Now that the IR1 interpreter has gone away, these should be 

diff --git a/make.sh b/make.sh
index 756d173..9d48783 100755 (executable)
--- a/make.sh
+++ b/make.sh
@@ -1,3 +1,4 @@
+
 #!/bin/sh
 
 # "When we build software, it's a good idea to have a reliable method

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 94d7d43..881f3f0 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -372,8 +372,9 @@ like *STACK-TOP-HINT*"
              "DELETE-BREAKPOINT" "DO-BLOCKS"
              "DO-DEBUG-BLOCK-LOCATIONS" "DO-DEBUG-FUN-BLOCKS"
              "DO-DEBUG-FUN-VARIABLES"
-             "FORM-NUMBER-TRANSLATIONS" "FRAME" "FRAME-CATCHES"
-             "FRAME-CODE-LOCATION" "FRAME-DEBUG-FUN" "FRAME-DOWN"
+             "FORM-NUMBER-TRANSLATIONS"
+            "FRAME" "FRAME-CATCHES" "FRAME-CODE-LOCATION"
+            "FRAME-DEBUG-FUN" "FRAME-DOWN"
              "FRAME-FUN-MISMATCH" "FRAME-NUMBER" "FRAME-P" "FRAME-UP"
              "FUN-DEBUG-FUN" "FUN-END-COOKIE-VALID-P"
              "INVALID-CONTROL-STACK-POINTER" "INVALID-VALUE"
@@ -1706,6 +1707,7 @@ structure representations"
              "CONTEXT-FLOATING-POINT-MODES" "CONTEXT-FLOAT-REGISTER"
              "CONTEXT-PC" "CONTEXT-REGISTER"
              "CONTROL-STACK-SC-NUMBER" "COUNT-NO-OPS"
+            "*CURRENT-CATCH-BLOCK*"
              "CURRENT-DYNAMIC-SPACE-START"
              "CURRENT-FLOAT-TRAP" "DEFINE-FOR-EACH-PRIMITIVE-OBJECT"
              "DESCRIPTOR-REG-SC-NUMBER" "DESCRIPTOR-VS-NON-DESCRIPTOR-STORAGE"

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 0a911ff..6f70874 100644 (file)
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -214,13 +214,6 @@
 
   ;; the ANSI-specified initial value of *PACKAGE*
   (setf *package* (find-package "COMMON-LISP-USER"))
-  ;; FIXME: I'm not sure where it should be done, but CL-USER really
-  ;; ought to USE-PACKAGE publicly accessible packages like SB-DEBUG
-  ;; (for ARG and VAR), SB-EXT, SB-EXT-C-CALL, and SB-EXT-ALIEN so
-  ;; that the user has a hint about which symbols we consider public.
-  ;; (Perhaps SB-DEBUG wouldn't need to be in the list if ARG and VAR
-  ;; could be typed directly, with no parentheses, at the debug prompt
-  ;; the way that e.g. F or BACKTRACE can be?)
 
   (/show0 "done initializing, setting *COLD-INIT-COMPLETE-P*")
   (setf *cold-init-complete-p* t)

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index db79162..134cd9a 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -666,7 +666,7 @@
 ;;; Return the top frame of the control stack as it was before calling
 ;;; this function.
 (defun top-frame ()
-  (/show0 "entering TOP-FRAME")
+  (/noshow0 "entering TOP-FRAME")
   (multiple-value-bind (fp pc) (%caller-frame-and-pc)
     (compute-calling-frame (descriptor-sap fp) pc nil)))
 
@@ -682,13 +682,13 @@
 ;;; Return the frame immediately below FRAME on the stack; or when
 ;;; FRAME is the bottom of the stack, return NIL.
 (defun frame-down (frame)
-  (/show0 "entering FRAME-DOWN")
+  (/noshow0 "entering FRAME-DOWN")
   ;; We have to access the old-fp and return-pc out of frame and pass
   ;; them to COMPUTE-CALLING-FRAME.
   (let ((down (frame-%down frame)))
     (if (eq down :unparsed)
        (let ((debug-fun (frame-debug-fun frame)))
-         (/show0 "in DOWN :UNPARSED case")
+         (/noshow0 "in DOWN :UNPARSED case")
          (setf (frame-%down frame)
                (etypecase debug-fun
                  (compiled-debug-fun
@@ -834,14 +834,14 @@
 #!+x86
 (defun compute-calling-frame (caller ra up-frame)
   (declare (type system-area-pointer caller ra))
-  (/show0 "entering COMPUTE-CALLING-FRAME")
+  (/noshow0 "entering COMPUTE-CALLING-FRAME")
   (when (cstack-pointer-valid-p caller)
-    (/show0 "in WHEN")
+    (/noshow0 "in WHEN")
     ;; First check for an escaped frame.
     (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
-      (/show0 "at COND")
+      (/noshow0 "at COND")
       (cond (code
-            (/show0 "in CODE clause")
+            (/noshow0 "in CODE clause")
             ;; If it's escaped it may be a function end breakpoint trap.
             (when (and (code-component-p code)
                        (eq (%code-debug-info code) :bogus-lra))
@@ -851,7 +851,7 @@
               (setq code (code-header-ref code real-lra-slot))
               (aver code)))
            (t
-            (/show0 "in T clause")
+            (/noshow0 "in T clause")
             ;; not escaped
             (multiple-value-setq (pc-offset code)
               (compute-lra-data-from-pc ra))
@@ -872,7 +872,7 @@
                       "bogus stack frame"))
                     (t
                      (debug-fun-from-pc code pc-offset)))))
-       (/show0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
+       (/noshow0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
        (make-compiled-frame caller up-frame d-fun
                             (code-location-from-pc d-fun pc-offset
                                                    escaped)
@@ -882,22 +882,22 @@
 #!+x86
 (defun find-escaped-frame (frame-pointer)
   (declare (type system-area-pointer frame-pointer))
-  (/show0 "entering FIND-ESCAPED-FRAME")
+  (/noshow0 "entering FIND-ESCAPED-FRAME")
   (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
     (sb!alien:with-alien
        ((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
-      (/show0 "at head of WITH-ALIEN")
+      (/noshow0 "at head of WITH-ALIEN")
       (let ((context (sb!alien:deref lisp-interrupt-contexts index)))
-       (/show0 "got CONTEXT")
+       (/noshow0 "got CONTEXT")
        (when (= (sap-int frame-pointer)
                 (sb!vm:context-register context sb!vm::cfp-offset))
          (without-gcing
-          (/show0 "in WITHOUT-GCING")
+          (/noshow0 "in WITHOUT-GCING")
           (let* ((component-ptr (component-ptr-from-pc
                                  (sb!vm:context-pc context)))
                  (code (unless (sap= component-ptr (int-sap #x0))
                          (component-from-component-ptr component-ptr))))
-            (/show0 "got CODE")
+            (/noshow0 "got CODE")
             (when (null code)
               (return (values code 0 context)))
             (let* ((code-header-len (* (get-header-data code)
@@ -907,7 +907,7 @@
                        (- (get-lisp-obj-address code)
                           sb!vm:other-pointer-lowtag)
                        code-header-len)))
-              (/show "got PC-OFFSET")
+              (/noshow "got PC-OFFSET")
               (unless (<= 0 pc-offset
                           (* (code-header-ref code sb!vm:code-code-size-slot)
                              sb!vm:n-word-bytes))
@@ -917,7 +917,7 @@
                 ;; FIXME: Should this be WARN or ERROR or what?
                 (format t "** pc-offset ~S not in code obj ~S?~%"
                         pc-offset code))
-              (/show0 "returning from FIND-ESCAPED-FRAME")
+              (/noshow0 "returning from FIND-ESCAPED-FRAME")
               (return
                (values code pc-offset context))))))))))
 
@@ -1042,62 +1042,63 @@
 ;;; CODE-LOCATIONs at which execution would continue with frame as the
 ;;; top frame if someone threw to the corresponding tag.
 (defun frame-catches (frame)
-  (let ((catch (descriptor-sap *current-catch-block*))
-       (res nil)
+  (let ((catch (descriptor-sap sb!vm:*current-catch-block*))
+       (reversed-result nil)
        (fp (frame-pointer frame)))
-    (loop
-      (when (zerop (sap-int catch)) (return (nreverse res)))
-      (when (sap= fp
-                 #!-alpha
-                 (sap-ref-sap catch
-                                     (* sb!vm:catch-block-current-cont-slot
-                                        sb!vm:n-word-bytes))
-                 #!+alpha
-                 (:int-sap
-                  (sap-ref-32 catch
-                                     (* sb!vm:catch-block-current-cont-slot
-                                        sb!vm:n-word-bytes))))
-       (let* (#!-x86
-              (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
-              #!+x86
-              (ra (sap-ref-sap
-                   catch (* sb!vm:catch-block-entry-pc-slot
-                            sb!vm:n-word-bytes)))
-              #!-x86
-              (component
-               (stack-ref catch sb!vm:catch-block-current-code-slot))
-              #!+x86
-              (component (component-from-component-ptr
-                          (component-ptr-from-pc ra)))
-              (offset
-               #!-x86
-               (* (- (1+ (get-header-data lra))
-                     (get-header-data component))
-                  sb!vm:n-word-bytes)
-               #!+x86
-               (- (sap-int ra)
-                  (- (get-lisp-obj-address component)
-                     sb!vm:other-pointer-lowtag)
-                  (* (get-header-data component) sb!vm:n-word-bytes))))
-         (push (cons #!-x86
-                     (stack-ref catch sb!vm:catch-block-tag-slot)
-                     #!+x86
-                     (make-lisp-obj
-                      (sap-ref-32 catch (* sb!vm:catch-block-tag-slot
-                                                  sb!vm:n-word-bytes)))
-                     (make-compiled-code-location
-                      offset (frame-debug-fun frame)))
-               res)))
-      (setf catch
-           #!-alpha
-           (sap-ref-sap catch
-                               (* sb!vm:catch-block-previous-catch-slot
-                                  sb!vm:n-word-bytes))
-           #!+alpha
-           (:int-sap
-            (sap-ref-32 catch
-                               (* sb!vm:catch-block-previous-catch-slot
-                                  sb!vm:n-word-bytes)))))))
+    (loop until (zerop (sap-int catch))
+         finally (return (nreverse reversed-result))
+         do
+         (when (sap= fp
+                     #!-alpha
+                     (sap-ref-sap catch
+                                  (* sb!vm:catch-block-current-cont-slot
+                                     sb!vm:n-word-bytes))
+                     #!+alpha
+                     (int-sap
+                      (sap-ref-32 catch
+                                  (* sb!vm:catch-block-current-cont-slot
+                                     sb!vm:n-word-bytes))))
+           (let* (#!-x86
+                  (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
+                  #!+x86
+                  (ra (sap-ref-sap
+                       catch (* sb!vm:catch-block-entry-pc-slot
+                                sb!vm:n-word-bytes)))
+                  #!-x86
+                  (component
+                   (stack-ref catch sb!vm:catch-block-current-code-slot))
+                  #!+x86
+                  (component (component-from-component-ptr
+                              (component-ptr-from-pc ra)))
+                  (offset
+                   #!-x86
+                   (* (- (1+ (get-header-data lra))
+                         (get-header-data component))
+                      sb!vm:n-word-bytes)
+                   #!+x86
+                   (- (sap-int ra)
+                      (- (get-lisp-obj-address component)
+                         sb!vm:other-pointer-lowtag)
+                      (* (get-header-data component) sb!vm:n-word-bytes))))
+             (push (cons #!-x86
+                         (stack-ref catch sb!vm:catch-block-tag-slot)
+                         #!+x86
+                         (make-lisp-obj
+                          (sap-ref-32 catch (* sb!vm:catch-block-tag-slot
+                                               sb!vm:n-word-bytes)))
+                         (make-compiled-code-location
+                          offset (frame-debug-fun frame)))
+                   reversed-result)))
+         (setf catch
+               #!-alpha
+               (sap-ref-sap catch
+                            (* sb!vm:catch-block-previous-catch-slot
+                               sb!vm:n-word-bytes))
+               #!+alpha
+               (int-sap
+                (sap-ref-32 catch
+                            (* sb!vm:catch-block-previous-catch-slot
+                               sb!vm:n-word-bytes)))))))
 \f
 ;;;; operations on DEBUG-FUNs
 
@@ -1961,8 +1962,6 @@
 ;;; GC, and might also arise in debug variable locations when
 ;;; those variables are invalid.)
 (defun make-valid-lisp-obj (val)
-  (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")
-  #!+sb-show (/hexstr val)
   (if (or
        ;; fixnum
        (zerop (logand val 3))
@@ -2133,15 +2132,11 @@
 #!+x86
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (declare (type system-area-pointer fp))
-  (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..")
-  (/hexstr fp) (/hexstr sc-offset) (/hexstr escaped)
   (macrolet ((with-escaped-value ((var) &body forms)
               `(if escaped
                    (let ((,var (sb!vm:context-register
                                 escaped
                                 (sb!c:sc-offset-offset sc-offset))))
-                     (/show0 "in escaped case, ,VAR value=..")
-                     (/hexstr ,var)
                      ,@forms)
                    :invalid-value-for-unescaped-register-storage))
             (escaped-float-value (format)
@@ -2159,72 +2154,54 @@
                    :invalid-value-for-unescaped-register-storage)))
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)
-       (/show0 "case of ANY-REG-SC-NUMBER or DESCRIPTOR-REG-SC-NUMBER")
        (without-gcing
        (with-escaped-value (val)
-         (/show0 "VAL=..")
-         (/hexstr val)
          (make-valid-lisp-obj val))))
       (#.sb!vm:base-char-reg-sc-number
-       (/show0 "case of BASE-CHAR-REG-SC-NUMBER")
        (with-escaped-value (val)
         (code-char val)))
       (#.sb!vm:sap-reg-sc-number
-       (/show0 "case of SAP-REG-SC-NUMBER")
        (with-escaped-value (val)
         (int-sap val)))
       (#.sb!vm:signed-reg-sc-number
-       (/show0 "case of SIGNED-REG-SC-NUMBER")
        (with-escaped-value (val)
         (if (logbitp (1- sb!vm:n-word-bits) val)
             (logior val (ash -1 sb!vm:n-word-bits))
             val)))
       (#.sb!vm:unsigned-reg-sc-number
-       (/show0 "case of UNSIGNED-REG-SC-NUMBER")
        (with-escaped-value (val)
         val))
       (#.sb!vm:single-reg-sc-number
-       (/show0 "case of SINGLE-REG-SC-NUMBER")
        (escaped-float-value single-float))
       (#.sb!vm:double-reg-sc-number
-       (/show0 "case of DOUBLE-REG-SC-NUMBER")
        (escaped-float-value double-float))
       #!+long-float
       (#.sb!vm:long-reg-sc-number
-       (/show0 "case of LONG-REG-SC-NUMBER")
        (escaped-float-value long-float))
       (#.sb!vm:complex-single-reg-sc-number
-       (/show0 "case of COMPLEX-SINGLE-REG-SC-NUMBER")
        (escaped-complex-float-value single-float))
       (#.sb!vm:complex-double-reg-sc-number
-       (/show0 "case of COMPLEX-DOUBLE-REG-SC-NUMBER")
        (escaped-complex-float-value double-float))
       #!+long-float
       (#.sb!vm:complex-long-reg-sc-number
-       (/show0 "case of COMPLEX-LONG-REG-SC-NUMBER")
        (escaped-complex-float-value long-float))
       (#.sb!vm:single-stack-sc-number
-       (/show0 "case of SINGLE-STACK-SC-NUMBER")
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                sb!vm:n-word-bytes))))
       (#.sb!vm:double-stack-sc-number
-       (/show0 "case of DOUBLE-STACK-SC-NUMBER")
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                sb!vm:n-word-bytes))))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
-       (/show0 "case of LONG-STACK-SC-NUMBER")
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
                              sb!vm:n-word-bytes))))
       (#.sb!vm:complex-single-stack-sc-number
-       (/show0 "case of COMPLEX-STACK-SC-NUMBER")
        (complex
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                 sb!vm:n-word-bytes)))
        (sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                 sb!vm:n-word-bytes)))))
       (#.sb!vm:complex-double-stack-sc-number
-       (/show0 "case of COMPLEX-DOUBLE-STACK-SC-NUMBER")
        (complex
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                 sb!vm:n-word-bytes)))
@@ -2232,30 +2209,24 @@
                                 sb!vm:n-word-bytes)))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
-       (/show0 "case of COMPLEX-LONG-STACK-SC-NUMBER")
        (complex
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
                               sb!vm:n-word-bytes)))
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
                               sb!vm:n-word-bytes)))))
       (#.sb!vm:control-stack-sc-number
-       (/show0 "case of CONTROL-STACK-SC-NUMBER")
        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
       (#.sb!vm:base-char-stack-sc-number
-       (/show0 "case of BASE-CHAR-STACK-SC-NUMBER")
        (code-char
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                             sb!vm:n-word-bytes)))))
       (#.sb!vm:unsigned-stack-sc-number
-       (/show0 "case of UNSIGNED-STACK-SC-NUMBER")
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                            sb!vm:n-word-bytes))))
       (#.sb!vm:signed-stack-sc-number
-       (/show0 "case of SIGNED-STACK-SC-NUMBER")
        (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                   sb!vm:n-word-bytes))))
       (#.sb!vm:sap-stack-sc-number
-       (/show0 "case of SAP-STACK-SC-NUMBER")
        (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                             sb!vm:n-word-bytes)))))))
 
@@ -3096,10 +3067,10 @@
 
 ;;;; breakpoint handlers (layer between C and exported interface)
 
-;;; This maps components to a mapping of offsets to breakpoint-datas.
+;;; This maps components to a mapping of offsets to BREAKPOINT-DATAs.
 (defvar *component-breakpoint-offsets* (make-hash-table :test 'eq))
 
-;;; This returns the breakpoint-data associated with component cross
+;;; This returns the BREAKPOINT-DATA object associated with component cross
 ;;; offset. If none exists, this makes one, installs it, and returns it.
 (defun breakpoint-data (component offset &optional (create t))
   (flet ((install-breakpoint-data ()
@@ -3117,7 +3088,7 @@
          (install-breakpoint-data)))))
 
 ;;; We use this when there are no longer any active breakpoints
-;;; corresponding to data.
+;;; corresponding to DATA.
 (defun delete-breakpoint-data (data)
   (let* ((component (breakpoint-data-component data))
         (offsets (delete (breakpoint-data-offset data)
@@ -3129,10 +3100,10 @@
   (values))
 
 ;;; The C handler for interrupts calls this when it has a
-;;; debugging-tool break instruction. This does NOT handle all breaks;
-;;; for example, it does not handle breaks for internal errors.
+;;; debugging-tool break instruction. This does *not* handle all
+;;; breaks; for example, it does not handle breaks for internal
+;;; errors.
 (defun handle-breakpoint (offset component signal-context)
-  (/show0 "entering HANDLE-BREAKPOINT")
   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "unknown breakpoint in ~S at offset ~S"
@@ -3156,7 +3127,6 @@
 ;;; This handles code-location and DEBUG-FUN :FUN-START
 ;;; breakpoints.
 (defun handle-breakpoint-aux (breakpoints data offset component signal-context)
-  (/show0 "entering HANDLE-BREAKPOINT-AUX")
   (unless breakpoints
     (error "internal error: breakpoint that nobody wants"))
   (unless (member data *executing-breakpoint-hooks*)
@@ -3201,7 +3171,6 @@
                   bpt)))))
 
 (defun handle-fun-end-breakpoint (offset component context)
-  (/show0 "entering HANDLE-FUN-END-BREAKPOINT")
   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "unknown breakpoint in ~S at offset ~S"
@@ -3216,7 +3185,6 @@
 ;;; [old C code] or HANDLE-FUN-END-BREAKPOINT calls this directly
 ;;; [new C code].
 (defun handle-fun-end-breakpoint-aux (breakpoints data signal-context)
-  (/show0 "entering HANDLE-FUN-END-BREAKPOINT-AUX")
   (delete-breakpoint-data data)
   (let* ((scp
          (locally

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 31cb86c..4569837 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -655,8 +655,7 @@
          (t
           (/noshow0 "default case")
           (let ((file (concatenate 'string directory name)))
-            (/noshow0 "computed basic FILE=..")
-            (/primitive-print file)
+            (/noshow "computed basic FILE")
             (unless (or (null type) (eq type :unspecific))
               (/noshow0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
               (setf file (concatenate 'string file "." type)))
@@ -664,8 +663,7 @@
               (/noshow0 "tweaking FILE for more-or-less-:WILD case")
               (setf file (concatenate 'string file "."
                                       (quick-integer-to-string version))))
-            (/noshow0 "finished possibly tweaking FILE=..")
-            (/primitive-print file)
+            (/noshow0 "finished possibly tweaking FILE")
             (when (or (not verify-existence)
                       (sb!unix:unix-file-kind file t))
               (/noshow0 "calling FUNCTION on FILE")
@@ -787,13 +785,9 @@
         (namestring (unix-namestring defaulted-pathname t)))
     (when (and namestring (sb!unix:unix-file-kind namestring t))
       (let ((trueishname (sb!unix:unix-resolve-links namestring)))
-       (/show0 "back from UNIX-RESOLVE-LINKS in PROBE-FILE")
        (when trueishname
          (let ((*ignore-wildcards* t))
-           (/show0 "calling UNIX-SIMPLIFY-PATHNAME in PROBE-FILE")
-           (prog1
-               (pathname (sb!unix:unix-simplify-pathname trueishname))
-             (/show0 "back from UNIX-SIMPLIFY-PATHNAME in PROBE-FILE"))))))))
+           (pathname (sb!unix:unix-simplify-pathname trueishname))))))))
 \f
 ;;;; miscellaneous other operations
 

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index cd9463c..b8fc243 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -409,8 +409,6 @@
                                                   'string
                                                   user-home
                                                   "/.sbclrc"))))
-       (/show0 "assigned SYSINIT-TRUENAME and USERINIT-TRUENAME")
-
 
        ;; We wrap all the pre-REPL user/system customized startup code 
        ;; in a restart.
@@ -484,20 +482,14 @@
      ;; way we can convince the GC to just ignore dead areas of the
      ;; control stack, so that we don't need to rely on this
      ;; half-measure?
-     (/show0 "at head of LOOP")
      (scrub-control-stack)
-     (/show0 "back from SCRUB-CONTROL-STACK")
      (unless noprint
        (fresh-line)
-       (/show0 "back from FRESH-LINE")
        (princ (if (functionp *prompt*)
                  (funcall *prompt*)
                  *prompt*))
-       (/show0 "back from PRINC")
-       (flush-standard-output-streams)
-       (/show0 "back from FLUSH-STANDARD-OUTPUT-STREAMS"))
+       (flush-standard-output-streams))
      (let ((form (read *standard-input* nil eof-marker)))
-       (/show0 "back from READ")
        (if (eq form eof-marker)
           (quit)
           (let ((results (multiple-value-list (interactive-eval form))))

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 626a24a..eace65c 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -697,7 +697,7 @@
 (defun unix-resolve-links (pathname)
   (declare (type simple-string pathname))
   (aver (not (relative-unix-pathname? pathname)))
-  (/show "entering UNIX-RESOLVE-LINKS")
+  (/noshow "entering UNIX-RESOLVE-LINKS")
   (loop with previous-pathnames = nil do
        (/noshow pathname previous-pathnames)
        (let ((link (unix-readlink pathname)))

diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp
index 654105c..0578a94 100644 (file)
--- a/src/compiler/alpha/nlx.lisp
+++ b/src/compiler/alpha/nlx.lisp
@@ -1,4 +1,4 @@
-;;;; the definitions of VOPs used for non-local exit (throw, lexical
+;;;; the definitions of VOPs used for non-local exit (THROW, lexical
 ;;;; exit, etc.)
 
 ;;;; This software is part of the SBCL system. See the README file for

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 405ebba..4960357 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1136,13 +1136,17 @@
 ;;; intern it.
 (defun finish-symbols ()
 
-  ;; FIXME: Why use SETQ (setting symbol value) instead of just using
-  ;; the function values for these things?? I.e. why do we need this
-  ;; section at all? Is it because all the FDEFINITION stuff gets in
-  ;; the way of reading function values and is too hairy to rely on at
-  ;; cold boot? FIXME: Most of these are in *STATIC-SYMBOLS* in
-  ;; parms.lisp, but %HANDLE-FUN-END-BREAKPOINT is not. Why?
-  ;; Explain.
+  ;; I think the point of setting these functions into SYMBOL-VALUEs
+  ;; here, instead of using SYMBOL-FUNCTION, is that in CMU CL
+  ;; SYMBOL-FUNCTION reduces to FDEFINITION, which is a pretty
+  ;; hairy operation (involving globaldb.lisp etc.) which we don't
+  ;; want to invoke early in cold init. -- WHN 2001-12-05
+  ;;
+  ;; FIXME: So OK, that's a reasonable reason to do something weird like
+  ;; this, but this is still a weird thing to do, and we should change
+  ;; the names to highlight that something weird is going on. Perhaps
+  ;; *MAYBE-GC-FUN*, *INTERNAL-ERROR-FUN*, *HANDLE-BREAKPOINT-FUN*,
+  ;; and *HANDLE-FUN-END-BREAKPOINT-FUN*...
   (macrolet ((frob (symbol)
               `(cold-set ',symbol
                          (cold-fdefinition-object (cold-intern ',symbol)))))

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 3bd5223..b7fff6f 100644 (file)
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1330,7 +1330,6 @@
            (ir2-continuation-locs (continuation-info (second args)))
            nil))
          (nil)))
-
   (move-continuation-result node block () (node-cont node))
   (values))
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 87437f6..1796a28 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.86.flaky7.21"
+"0.pre7.86.flaky7.22"