From: William Harold Newman Date: Sat, 24 Nov 2001 18:48:21 +0000 (+0000) Subject: 0.pre7.86.flaky7.9: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9a25385c551e986db84d31dff5f906327495177f;p=sbcl.git 0.pre7.86.flaky7.9: (can now do (SB!DI:TOP-FRAME) at cold toplevel prompt without crashing) fixed %DEFAULT-STRUCTURE-UGLY-PRINT call in DEFAULT-STRUCTURE-PRINT --- diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index a224a9a..0a911ff 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -246,7 +246,7 @@ "Terminate the current Lisp. Things are cleaned up (with UNWIND-PROTECT and so forth) unless RECKLESSLY-P is non-NIL. On UNIX-like systems, UNIX-STATUS is used as the status code." - (declare (type (signed-byte 32) unix-code)) + (declare (type (signed-byte 32) unix-status unix-code)) ;; FIXME: UNIX-CODE was deprecated in sbcl-0.6.8, after having been ;; around for less than a year. It should be safe to remove it after ;; a year. diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 94185f4..db79162 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -777,8 +777,8 @@ ;;; This returns a frame for the one existing in time immediately ;;; prior to the frame referenced by current-fp. This is current-fp's ;;; caller or the next frame down the control stack. If there is no -;;; down frame, this returns nil for the bottom of the stack. Up-frame -;;; is the up link for the resulting frame object, and it is nil when +;;; down frame, this returns NIL for the bottom of the stack. UP-FRAME +;;; is the up link for the resulting frame object, and it is null when ;;; we call this to get the top of the stack. ;;; ;;; The current frame contains the pointer to the temporally previous @@ -831,7 +831,6 @@ escaped) (if up-frame (1+ (frame-number up-frame)) 0) escaped)))))) - #!+x86 (defun compute-calling-frame (caller ra up-frame) (declare (type system-area-pointer caller ra)) diff --git a/src/code/print.lisp b/src/code/print.lisp index 9b1f551..5e8d6c3 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -463,6 +463,7 @@ (output-symbol object stream) (output-list object stream))) (instance + (/show0 "in PRINT-OBJECT case") (print-object object stream)) (function (unless (and (funcallable-instance-p object) @@ -1045,6 +1046,7 @@ ;;; use until CLOS is set up (at which time it will be replaced with ;;; the real generic function implementation) (defun print-object (instance stream) + (/show0 "in pre-CLOS PRINT-OBJECT placeholder") (default-structure-print instance stream *current-level*)) ;;;; integer, ratio, and complex printing (i.e. everything but floats) diff --git a/src/code/stubs.lisp b/src/code/stubs.lisp index e643439..61ef516 100644 --- a/src/code/stubs.lisp +++ b/src/code/stubs.lisp @@ -22,3 +22,6 @@ (def-frob %funcallable-instance-layout) (def-frob %funcallable-instance-lexenv) (def-frob %set-funcallable-instance-fun (fin new-val))) + +(defun %caller-frame-and-pc () + (%caller-frame-and-pc)) diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 1bec5ca..864a436 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -412,9 +412,11 @@ (write-char #\space stream) (pprint-newline :linear stream)))))))) (defun %default-structure-ugly-print (structure stream) + (/show0 "entering %DEFAULT-STRUCTURE-UGLY-PRINT") (let* ((layout (%instance-layout structure)) (name (sb!xc:class-name (layout-class layout))) (dd (layout-info layout))) + (/show0 "got LAYOUT, NAME, and DD") (descend-into (stream) (write-string "#S(" stream) (prin1 name stream) @@ -439,12 +441,16 @@ stream)))))) (defun default-structure-print (structure stream depth) (declare (ignore depth)) + (/show0 "entering DEFAULT-STRUCTURE-PRINT") (cond ((funcallable-instance-p structure) + (/show0 "in FUNCALLABLE-INSTANCE-P case") (print-unreadable-object (structure stream :identity t :type t))) (*print-pretty* + (/show0 "in *PRINT-PRETTY* case") (%default-structure-pretty-print structure stream)) (t - (%default-structure-ugly-print structure-stream)))) + (/show0 "in ugly-print case") + (%default-structure-ugly-print structure stream)))) (def!method print-object ((x structure-object) stream) (default-structure-print x stream *current-level*)) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 95b97fd..3bd5223 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -390,7 +390,7 @@ dest)) (values)) -;;; If necessary, emit coercion code needed to deliver the Results to +;;; If necessary, emit coercion code needed to deliver the RESULTS to ;;; the specified continuation. NODE and BLOCK provide context for ;;; emitting code. Although usually obtained from STANDARD-RESULT-TNs ;;; or CONTINUATION-RESULT-TNs, RESULTS my be a list of any type or @@ -1143,10 +1143,10 @@ ;;; stack. It returns the OLD-FP and RETURN-PC for the current ;;; function as multiple values. (defoptimizer (sb!kernel:%caller-frame-and-pc ir2-convert) (() node block) - (let ((env (physenv-info (node-physenv node)))) + (let ((ir2-physenv (physenv-info (node-physenv node)))) (move-continuation-result node block - (list (ir2-physenv-old-fp env) - (ir2-physenv-return-pc env)) + (list (ir2-physenv-old-fp ir2-physenv) + (ir2-physenv-return-pc ir2-physenv)) (node-cont node)))) ;;;; multiple values