From: William Harold Newman Date: Wed, 5 Dec 2001 18:12:06 +0000 (+0000) Subject: 0.pre7.86.flaky7.22: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=aa61c7571b33b86981301f34d3acdb66666f53a3;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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))))))) ;;;; 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 --- 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)))))))) ;;;; miscellaneous other operations diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index cd9463c..b8fc243 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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"