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 (file)
--- 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 (file)
--- 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 (file)
--- 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*))
 \f
 ;;;; 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 (file)
--- 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 (file)
--- 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 (file)
--- 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))))
 \f
 ;;;; multiple values