X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=c61ab787849464e83eed6122436de0d38a1b114e;hb=3b45a7b66afe95080562d266dd447b1286abece0;hp=465887f735c2a26579c198b29ad0d4e59dc881ae;hpb=099d6dd1f6a5ac2ffec5c14d07a4b905322ef968;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 465887f..c61ab78 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -47,7 +47,6 @@
   #!+sb-doc
   (:documentation "There is no usable debugging information available.")
   (:report (lambda (condition stream)
-	     (declare (ignore condition))
 	     (fresh-line stream)
 	     (format stream
 		     "no debug information available for ~S~%"
@@ -187,13 +186,14 @@
 ;;;; data structures created by the compiler. Whenever comments
 ;;;; preface an object or type with "compiler", they refer to the
 ;;;; internal compiler thing, not to the object or type with the same
-;;;; name in the "DI" package.
+;;;; name in the "SB-DI" package.
 
 ;;;; DEBUG-VARs
 
 ;;; These exist for caching data stored in packed binary form in
 ;;; compiler debug-functions. Debug-functions store these.
-(defstruct (debug-var (:constructor nil))
+(defstruct (debug-var (:constructor nil)
+		      (:copier nil))
   ;; the name of the variable
   (symbol (required-argument) :type symbol)
   ;; a unique integer identification relative to other variables with the same
@@ -216,7 +216,8 @@
 (defstruct (compiled-debug-var
 	    (:include debug-var)
 	    (:constructor make-compiled-debug-var
-			  (symbol id alive-p sc-offset save-sc-offset)))
+			  (symbol id alive-p sc-offset save-sc-offset))
+	    (:copier nil))
   ;; Storage class and offset. (unexported).
   (sc-offset nil :type sb!c::sc-offset)
   ;; Storage class and offset when saved somewhere.
@@ -224,14 +225,16 @@
 
 (defstruct (interpreted-debug-var
 	    (:include debug-var (alive-p t))
-	    (:constructor make-interpreted-debug-var (symbol ir1-var)))
+	    (:constructor make-interpreted-debug-var (symbol ir1-var))
+	    (:copier nil))
   ;; This is the IR1 structure that holds information about interpreted vars.
   (ir1-var nil :type sb!c::lambda-var))
 
 ;;;; frames
 
 ;;; These represent call-frames on the stack.
-(defstruct (frame (:constructor nil))
+(defstruct (frame (:constructor nil)
+		  (:copier nil))
   ;; the next frame up, or NIL when top frame
   (up nil :type (or frame null))
   ;; the previous frame down, or NIL when the bottom frame. Before
@@ -273,7 +276,8 @@
 	    (:constructor make-compiled-frame
 			  (pointer up debug-function code-location number
 				   #!+gengc saved-state-chain
-				   &optional escaped)))
+				   &optional escaped))
+	    (:copier nil))
   ;; This indicates whether someone interrupted the frame.
   ;; (unexported). If escaped, this is a pointer to the state that was
   ;; saved when we were interrupted. On the non-gengc system, this is
@@ -296,7 +300,8 @@
 	    (:include frame)
 	    (:constructor make-interpreted-frame
 			  (pointer up debug-function code-location number
-			   real-frame closure)))
+			   real-frame closure))
+	    (:copier nil))
   ;; This points to the compiled-frame for SB!EVAL:INTERNAL-APPLY-LOOP.
   (real-frame nil :type compiled-frame)
   ;; This is the closed over data used by the interpreter.
@@ -314,7 +319,7 @@
 ;;; code-locations and other objects that reference DEBUG-FUNCTIONs
 ;;; point to unique objects. This is due to the overhead in cached
 ;;; information.
-(defstruct debug-function
+(defstruct (debug-function (:copier nil))
   ;; Some representation of the function arguments. See
   ;; DEBUG-FUNCTION-LAMBDA-LIST.
   ;; NOTE: must parse vars before parsing arg list stuff.
@@ -334,7 +339,8 @@
 (defstruct (compiled-debug-function
 	    (:include debug-function)
 	    (:constructor %make-compiled-debug-function
-			  (compiler-debug-fun component)))
+			  (compiler-debug-fun component))
+	    (:copier nil))
   ;; Compiler's dumped debug-function information. (unexported).
   (compiler-debug-fun nil :type sb!c::compiled-debug-function)
   ;; Code object. (unexported).
@@ -360,7 +366,8 @@
 
 (defstruct (interpreted-debug-function
 	    (:include debug-function)
-	    (:constructor %make-interpreted-debug-function (ir1-lambda)))
+	    (:constructor %make-interpreted-debug-function (ir1-lambda))
+	    (:copier nil))
   ;; This is the IR1 lambda that this debug-function represents.
   (ir1-lambda nil :type sb!c::clambda))
 
@@ -368,7 +375,8 @@
 	    (:include debug-function)
 	    (:constructor make-bogus-debug-function
 			  (%name &aux (%lambda-list nil) (%debug-vars nil)
-				 (blocks nil) (%function nil))))
+				 (blocks nil) (%function nil)))
+	    (:copier nil))
   %name)
 
 (defvar *ir1-lambda-debug-function* (make-hash-table :test 'eq))
@@ -382,8 +390,9 @@
 ;;;; DEBUG-BLOCKs
 
 ;;; These exist for caching data stored in packed binary form in compiler
-;;; debug-blocks.
-(defstruct (debug-block (:constructor nil))
+;;; DEBUG-BLOCKs.
+(defstruct (debug-block (:constructor nil)
+			(:copier nil))
   ;; Code-locations where execution continues after this block.
   (successors nil :type list)
   ;; This indicates whether the block is a special glob of code shared by
@@ -408,14 +417,16 @@
 (defstruct (compiled-debug-block (:include debug-block)
 				 (:constructor
 				  make-compiled-debug-block
-				  (code-locations successors elsewhere-p)))
-  ;; Code-location information for the block.
+				  (code-locations successors elsewhere-p))
+				 (:copier nil))
+  ;; code-location information for the block
   (code-locations nil :type simple-vector))
 
 (defstruct (interpreted-debug-block (:include debug-block
 					      (elsewhere-p nil))
 				    (:constructor %make-interpreted-debug-block
-						  (ir1-block)))
+						  (ir1-block))
+				    (:copier nil))
   ;; This is the IR1 block this debug-block represents.
   (ir1-block nil :type sb!c::cblock)
   ;; Code-location information for the block.
@@ -434,7 +445,7 @@
 ;;; lists of DEBUG-BLOCKs. Then look up our argument IR1-BLOCK to find
 ;;; its DEBUG-BLOCK since we know we have it now.
 (defun make-interpreted-debug-block (ir1-block)
-  (check-type ir1-block sb!c::cblock)
+  (declare (type sb!c::cblock ir1-block))
   (let ((res (gethash ir1-block *ir1-block-debug-block*)))
     (or res
 	(let ((lambda (sb!c::block-home-lambda ir1-block)))
@@ -466,7 +477,8 @@
 ;;; This is an internal structure that manages information about a
 ;;; breakpoint locations. See *COMPONENT-BREAKPOINT-OFFSETS*.
 (defstruct (breakpoint-data (:constructor make-breakpoint-data
-					  (component offset)))
+					  (component offset))
+			    (:copier nil))
   ;; This is the component in which the breakpoint lies.
   component
   ;; This is the byte offset into the component.
@@ -484,7 +496,8 @@
 	    (breakpoint-data-offset obj))))
 
 (defstruct (breakpoint (:constructor %make-breakpoint
-				     (hook-function what kind %info)))
+				     (hook-function what kind %info))
+		       (:copier nil))
   ;; This is the function invoked when execution encounters the
   ;; breakpoint. It takes a frame, the breakpoint, and optionally a
   ;; list of values. Values are supplied for :FUNCTION-END breakpoints
@@ -551,7 +564,8 @@
 
 ;;;; CODE-LOCATIONs
 
-(defstruct (code-location (:constructor nil))
+(defstruct (code-location (:constructor nil)
+			  (:copier nil))
   ;; This is the debug-function containing code-location.
   (debug-function nil :type debug-function)
   ;; This is initially :UNSURE. Upon first trying to access an
@@ -587,7 +601,8 @@
 	    (:constructor make-known-code-location
 			  (pc debug-function %tlf-offset %form-number
 			      %live-set kind &aux (%unknown-p nil)))
-	    (:constructor make-compiled-code-location (pc debug-function)))
+	    (:constructor make-compiled-code-location (pc debug-function))
+	    (:copier nil))
   ;; This is an index into debug-function's component slot.
   (pc nil :type sb!c::index)
   ;; This is a bit-vector indexed by a variable's position in
@@ -602,7 +617,8 @@
 	    (:include code-location
 		      (%unknown-p nil))
 	    (:constructor make-interpreted-code-location
-			  (ir1-node debug-function)))
+			  (ir1-node debug-function))
+	    (:copier nil))
   ;; This is an index into debug-function's component slot.
   (ir1-node nil :type sb!c::node))
 
@@ -736,17 +752,8 @@
 ;;; XXX Should probably check whether it has reached the bottom of the
 ;;; stack.
 ;;;
-;;; XXX Should handle interrupted frames, both Lisp and C. At present it
-;;; manages to find a fp trail, see linux hack below.
-
-;;; MNA: cmucl-commit: Mon, 6 Nov 2000 10:08:39 -0800 (PST)
-;;; Upon a stack trace ambiguity in x86-call-context, choose the lisp
-;;; frame in preference to the C frame as this is frame of interest.
-
-;;; MNA: cmucl-commit: Mon, 6 Nov 2000 09:48:00 -0800 (PST)
-;;; Limit the stack trace failure warning in x86-call-context to fails for the
-;;; immediate frame rather failures deeper within the search.
-
+;;; XXX Should handle interrupted frames, both Lisp and C. At present
+;;; it manages to find a fp trail, see linux hack below.
 (defun x86-call-context (fp &key (depth 0))
   (declare (type system-area-pointer fp)
 	   (fixnum depth))
@@ -776,7 +783,8 @@
 	       (cond ((and lisp-path-fp c-path-fp)
                        ;; Both still seem valid - choose the lisp frame.
                        #+nil (when (zerop depth)
-                               (format t "debug: both still valid ~S ~S ~S ~S~%"
+                               (format t
+				       "debug: both still valid ~S ~S ~S ~S~%"
                                        lisp-ocfp lisp-ra c-ocfp c-ra))
 		      #+freebsd
 		      (if (sap> lisp-ocfp c-ocfp)
@@ -959,6 +967,7 @@
 ;;; to replace FRAME. The interpreted frame points to FRAME.
 (defun possibly-an-interpreted-frame (frame up-frame)
   (if (or (not frame)
+	  #!+sb-interpreter
 	  (not (eq (debug-function-name (frame-debug-function frame))
 		   'sb!eval::internal-apply-loop))
 	  *debugging-interpreter*
@@ -1069,7 +1078,7 @@
 				  code (1+ real-lra-slot)))
 		 (setq code (code-header-ref code real-lra-slot))
 ;		 (format t "ccf3 :bogus-lra ~S ~S~%" code pc-offset)
-		 (assert code)))
+		 (aver code)))
 	      (t
 	       ;; Not escaped
 	       (multiple-value-setq (pc-offset code)
@@ -1098,24 +1107,10 @@
 			       (if up-frame (1+ (frame-number up-frame)) 0)
 			       escaped)))))
 
-#!-(or gengc x86)
-;;; FIXME: The original CMU CL code had support for this case, but it
-;;; must have been fairly stale even in CMU CL, since it had
-;;; references to the MIPS package, and there have been enough
-;;; relevant changes in SBCL (particularly using
-;;; POSIX/SIGACTION0-style signal context instead of BSD-style
-;;; sigcontext) that this code is unmaintainable (since as of
-;;; sbcl-0.6.7, and for the foreseeable future, we can't test it,
-;;; since we only support X86 and its gencgc).
-;;;
-;;; If we restore this case, the best approach would be to go back to
-;;; the original CMU CL code and start from there.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
 #!+x86
 (defun find-escaped-frame (frame-pointer)
   (declare (type system-area-pointer frame-pointer))
-  (dotimes (index sb!impl::*free-interrupt-context-index* (values nil 0 nil))
+  (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
     (sb!alien:with-alien
 	((lisp-interrupt-contexts (array (* os-context-t) nil)
 				  :extern))
@@ -1148,6 +1143,50 @@
 	       (return
 		(values code pc-offset context))))))))))
 
+#!-x86
+(defun find-escaped-frame (frame-pointer)
+  (declare (type system-area-pointer frame-pointer))
+  (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
+    (sb!alien:with-alien
+     ((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
+     (let ((scp (sb!alien:deref lisp-interrupt-contexts index)))
+       (when (= (sap-int frame-pointer)
+                (sb!vm:context-register scp sb!vm::cfp-offset))
+         (without-gcing
+          (let ((code (code-object-from-bits
+                       (sb!vm:context-register scp sb!vm::code-offset))))
+            (when (symbolp code)
+              (return (values code 0 scp)))
+            (let* ((code-header-len (* (get-header-data code)
+                                       sb!vm:word-bytes))
+                   (pc-offset
+                    (- (sap-int (sb!vm:context-pc scp))
+                       (- (get-lisp-obj-address code)
+                          sb!vm:other-pointer-type)
+                       code-header-len)))
+              ;; Check to see whether we were executing in a branch
+              ;; delay slot.
+              #!+(or pmax sgi) ; pmax only (and broken anyway)
+              (when (logbitp 31 (sb!alien:slot scp '%mips::sc-cause))
+                (incf pc-offset sb!vm:word-bytes))
+              (unless (<= 0 pc-offset
+                          (* (code-header-ref code sb!vm:code-code-size-slot)
+                             sb!vm:word-bytes))
+                ;; We were in an assembly routine. Therefore, use the
+                ;; LRA as the pc.
+                (setf pc-offset
+                      (- (sb!vm:context-register scp sb!vm::lra-offset)
+                         (get-lisp-obj-address code)
+                         code-header-len)))
+               (return
+                (if (eq (%code-debug-info code) :bogus-lra)
+                    (let ((real-lra (code-header-ref code
+                                                     real-lra-slot)))
+                      (values (lra-code-header real-lra)
+                              (get-header-data real-lra)
+                              nil))
+                  (values code pc-offset scp)))))))))))
+
 ;;; Find the code object corresponding to the object represented by
 ;;; bits and return it. We assume bogus functions correspond to the
 ;;; undefined-function.
@@ -1254,7 +1293,7 @@
    code-locations at which execution would continue with frame as the top
    frame if someone threw to the corresponding tag."
   (let ((catch
-	 #!-gengc (descriptor-sap sb!impl::*current-catch-block*)
+	 #!-gengc (descriptor-sap *current-catch-block*)
 	 #!+gengc (mutator-current-catch-block))
 	(res nil)
 	(fp (frame-pointer (frame-real-frame frame))))
@@ -1411,7 +1450,8 @@
     (#.sb!vm:closure-header-type
      (function-debug-function (%closure-function fun)))
     (#.sb!vm:funcallable-instance-header-type
-     (cond ((sb!eval:interpreted-function-p fun)
+     (cond #!+sb-interpreter
+	   ((sb!eval:interpreted-function-p fun)
 	    (make-interpreted-debug-function
 	     (or (sb!eval::interpreted-function-definition fun)
 		 (sb!eval::convert-interpreted-fun fun))))
@@ -1590,7 +1630,7 @@
 				(push (frob final-arg debug-vars) res))
 			       (:keyword
 				(push (list :keyword
-					    (sb!c::arg-info-keyword info)
+					    (sb!c::arg-info-key info)
 					    (frob final-arg debug-vars))
 				      res))
 			       (:rest
@@ -1691,11 +1731,11 @@
 		       res))
 		(sb!c::more-arg
 		 ;; Just ignore the fact that the next two args are
-		 ;; the more arg context and count, and act like they
+		 ;; the &MORE arg context and count, and act like they
 		 ;; are regular arguments.
 		 nil)
 		(t
-		 ;; keyword arg
+		 ;; &KEY arg
 		 (push (list :keyword
 			     ele
 			     (compiled-debug-function-lambda-list-var
@@ -1985,7 +2025,7 @@
 			 0))
 		 (sc-offset (if deleted 0 (geti)))
 		 (save-sc-offset (if save (geti) nil)))
-	    (assert (not (and args-minimal (not minimal))))
+	    (aver (not (and args-minimal (not minimal))))
 	    (vector-push-extend (make-compiled-debug-var symbol
 							 id
 							 live
@@ -2428,13 +2468,14 @@
    invalid. This is SETF'able."
   (etypecase debug-var
     (compiled-debug-var
-     (check-type frame compiled-frame)
+     (aver (typep frame 'compiled-frame))
      (let ((res (access-compiled-debug-var-slot debug-var frame)))
        (if (indirect-value-cell-p res)
 	   (sb!c:value-cell-ref res)
 	   res)))
+    #!+sb-interpreter
     (interpreted-debug-var
-     (check-type frame interpreted-frame)
+     (aver (typep frame 'interpreted-frame))
      (sb!eval::leaf-value-lambda-var
       (interpreted-code-location-ir1-node (frame-code-location frame))
       (interpreted-debug-var-ir1-var debug-var)
@@ -2445,16 +2486,17 @@
 ;;; DEBUG-VAR relative to the FRAME. This may be an indirect value
 ;;; cell if the variable is both closed over and set.
 (defun access-compiled-debug-var-slot (debug-var frame)
+  (declare (optimize (speed 1)))
   (let ((escaped (compiled-frame-escaped frame)))
     (if escaped
-	(sub-access-debug-var-slot
-	 (frame-pointer frame)
-	 (compiled-debug-var-sc-offset debug-var)
-	 escaped)
-	(sub-access-debug-var-slot
-	 (frame-pointer frame)
-	 (or (compiled-debug-var-save-sc-offset debug-var)
-	     (compiled-debug-var-sc-offset debug-var))))))
+        (sub-access-debug-var-slot
+         (frame-pointer frame)
+         (compiled-debug-var-sc-offset debug-var)
+         escaped)
+      (sub-access-debug-var-slot
+       (frame-pointer frame)
+       (or (compiled-debug-var-save-sc-offset debug-var)
+           (compiled-debug-var-sc-offset debug-var))))))
 
 ;;; a helper function for working with possibly-invalid values:
 ;;; Do (MAKE-LISP-OBJ VAL) only if the value looks valid.
@@ -2464,7 +2506,7 @@
 ;;; those variables are invalid.)
 (defun make-valid-lisp-obj (val)
   (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")
-  #!+sb-show (%primitive print (sb!impl::hexstr val))
+  #!+sb-show (/hexstr val)
   (if (or
        ;; fixnum
        (zerop (logand val 3))
@@ -2489,27 +2531,161 @@
       (make-lisp-obj val)
       :invalid-object))
 
-;;; CMU CL had
-;;;   (DEFUN SUB-ACCESS-DEBUG-VAR-SLOT (FP SC-OFFSET &OPTIONAL ESCAPED) ..)
-;;; code for this case.
 #!-x86
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
+(defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
+  (macrolet ((with-escaped-value ((var) &body forms)
+               `(if escaped
+                    (let ((,var (sb!vm:context-register
+                                 escaped
+                                 (sb!c:sc-offset-offset sc-offset))))
+                      ,@forms)
+                    :invalid-value-for-unescaped-register-storage))
+             (escaped-float-value (format)
+               `(if escaped
+                    (sb!vm:context-float-register
+                     escaped
+                     (sb!c:sc-offset-offset sc-offset)
+                     ',format)
+                    :invalid-value-for-unescaped-register-storage))
+             (with-nfp ((var) &body body)
+               `(let ((,var (if escaped
+                                (sb!sys:int-sap
+                                 (sb!vm:context-register escaped
+                                                         sb!vm::nfp-offset))
+                                #!-alpha
+                                (sb!sys:sap-ref-sap fp (* sb!vm::nfp-save-offset
+                                                          sb!vm:word-bytes))
+                                #!+alpha
+                                (sb!vm::make-number-stack-pointer
+                                 (sb!sys:sap-ref-32 fp (* sb!vm::nfp-save-offset
+                                                          sb!vm:word-bytes))))))
+                  ,@body)))
+    (ecase (sb!c:sc-offset-scn sc-offset)
+      ((#.sb!vm:any-reg-sc-number
+        #.sb!vm:descriptor-reg-sc-number
+        #!+rt #.sb!vm:word-pointer-reg-sc-number)
+       (sb!sys:without-gcing
+        (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
+                            
+      (#.sb!vm:base-char-reg-sc-number
+       (with-escaped-value (val)
+         (code-char val)))
+      (#.sb!vm:sap-reg-sc-number
+       (with-escaped-value (val)
+         (sb!sys:int-sap val)))
+      (#.sb!vm:signed-reg-sc-number
+       (with-escaped-value (val)
+         (if (logbitp (1- sb!vm:word-bits) val)
+             (logior val (ash -1 sb!vm:word-bits))
+             val)))
+      (#.sb!vm:unsigned-reg-sc-number
+       (with-escaped-value (val)
+         val))
+      (#.sb!vm:non-descriptor-reg-sc-number
+       (error "Local non-descriptor register access?"))
+      (#.sb!vm:interior-reg-sc-number
+       (error "Local interior register access?"))
+      (#.sb!vm:single-reg-sc-number
+       (escaped-float-value single-float))
+      (#.sb!vm:double-reg-sc-number
+       (escaped-float-value double-float))
+      #!+long-float
+      (#.sb!vm:long-reg-sc-number
+       (escaped-float-value long-float))
+      (#.sb!vm:complex-single-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'single-float)
+            (sb!vm:context-float-register
+             escaped (1+ (sb!c:sc-offset-offset sc-offset)) 'single-float))
+           :invalid-value-for-unescaped-register-storage))
+      (#.sb!vm:complex-double-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'double-float)
+            (sb!vm:context-float-register
+             escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #-sparc 1)
+             'double-float))
+           :invalid-value-for-unescaped-register-storage))
+      #!+long-float
+      (#.sb!vm:complex-long-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'long-float)
+            (sb!vm:context-float-register
+             escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
+             'long-float))
+           :invalid-value-for-unescaped-register-storage))
+      (#.sb!vm:single-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+                                       sb!vm:word-bytes))))
+      (#.sb!vm:double-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+                                       sb!vm:word-bytes))))
+      #!+long-float
+      (#.sb!vm:long-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+                                     sb!vm:word-bytes))))
+      (#.sb!vm:complex-single-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+                                        sb!vm:word-bytes))
+          (sb!sys:sap-ref-single nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
+                                        sb!vm:word-bytes)))))
+      (#.sb!vm:complex-double-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+                                        sb!vm:word-bytes))
+          (sb!sys:sap-ref-double nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
+                                        sb!vm:word-bytes)))))
+      #!+long-float
+      (#.sb!vm:complex-long-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+                                      sb!vm:word-bytes))
+          (sb!sys:sap-ref-long nfp (* (+ (sb!c:sc-offset-offset sc-offset)
+                                         #!+sparc 4)
+                                      sb!vm:word-bytes)))))
+      (#.sb!vm:control-stack-sc-number
+       (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
+      (#.sb!vm:base-char-stack-sc-number
+       (with-nfp (nfp)
+         (code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                              sb!vm:word-bytes)))))
+      (#.sb!vm:unsigned-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                   sb!vm:word-bytes))))
+      (#.sb!vm:signed-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                          sb!vm:word-bytes))))
+      (#.sb!vm:sap-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
+                                    sb!vm:word-bytes)))))))
 
 #!+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=..")
-  #!+sb-show (%primitive print (sb!impl::hexstr fp))
-  #!+sb-show (%primitive print (sb!impl::hexstr sc-offset))
-  #!+sb-show (%primitive print (sb!impl::hexstr 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=..")
-		      #!+sb-show (%primitive print (sb!impl::hexstr ,var))
+		      (/hexstr ,var)
 		      ,@forms)
 		    :invalid-value-for-unescaped-register-storage))
 	     (escaped-float-value (format)
@@ -2531,7 +2707,7 @@
        (without-gcing
 	(with-escaped-value (val)
 	  (/show0 "VAL=..")
-	  #!+sb-show (%primitive print (sb!impl::hexstr val))
+	  (/hexstr val)
 	  (make-valid-lisp-obj val))))
       (#.sb!vm:base-char-reg-sc-number
        (/show0 "case of BASE-CHAR-REG-SC-NUMBER")
@@ -2636,13 +2812,14 @@
 (defun %set-debug-var-value (debug-var frame value)
   (etypecase debug-var
     (compiled-debug-var
-     (check-type frame compiled-frame)
+     (aver (typep frame 'compiled-frame))
      (let ((current-value (access-compiled-debug-var-slot debug-var frame)))
        (if (indirect-value-cell-p current-value)
 	   (sb!c:value-cell-set current-value value)
 	   (set-compiled-debug-var-slot debug-var frame value))))
+    #!+sb-interpreter
     (interpreted-debug-var
-     (check-type frame interpreted-frame)
+     (aver (typep frame 'interpreted-frame))
      (sb!eval::set-leaf-value-lambda-var
       (interpreted-code-location-ir1-node (frame-code-location frame))
       (interpreted-debug-var-ir1-var debug-var)
@@ -2691,13 +2868,13 @@
 							 sb!vm::nfp-offset))
 				#!-alpha
 				(sap-ref-sap fp
-						    (* sb!vm::nfp-save-offset
-						       sb!vm:word-bytes))
+					     (* sb!vm::nfp-save-offset
+						sb!vm:word-bytes))
 				#!+alpha
-				(%alpha::make-number-stack-pointer
+				(sb!vm::make-number-stack-pointer
 				 (sap-ref-32 fp
-						    (* sb!vm::nfp-save-offset
-						       sb!vm:word-bytes))))))
+					     (* sb!vm::nfp-save-offset
+						sb!vm:word-bytes))))))
 		  ,@body)))
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number
@@ -2943,7 +3120,7 @@
     (compiled-debug-var
      (compiled-debug-var-validity debug-var basic-code-location))
     (interpreted-debug-var
-     (check-type basic-code-location interpreted-code-location)
+     (aver (typep basic-code-location 'interpreted-code-location))
      (let ((validp (rassoc (interpreted-debug-var-ir1-var debug-var)
 			   (sb!c::lexenv-variables
 			    (sb!c::node-lexenv
@@ -2954,7 +3131,7 @@
 ;;; This is the method for DEBUG-VAR-VALIDITY for COMPILED-DEBUG-VARs.
 ;;; For safety, make sure basic-code-location is what we think.
 (defun compiled-debug-var-validity (debug-var basic-code-location)
-  (check-type basic-code-location compiled-code-location)
+  (declare (type compiled-code-location basic-code-location))
   (cond ((debug-var-alive-p debug-var)
 	 (let ((debug-fun (code-location-debug-function basic-code-location)))
 	   (if (>= (compiled-code-location-pc basic-code-location)
@@ -2966,14 +3143,16 @@
 	(t
 	 (let ((pos (position debug-var
 			      (debug-function-debug-vars
-			       (code-location-debug-function basic-code-location)))))
+			       (code-location-debug-function
+				basic-code-location)))))
 	   (unless pos
 	     (error 'unknown-debug-var
 		    :debug-var debug-var
 		    :debug-function
 		    (code-location-debug-function basic-code-location)))
 	   ;; There must be live-set info since basic-code-location is known.
-	   (if (zerop (sbit (compiled-code-location-live-set basic-code-location)
+	   (if (zerop (sbit (compiled-code-location-live-set
+			     basic-code-location)
 			    pos))
 	       :invalid
 	       :valid)))))
@@ -2997,21 +3176,21 @@
 ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
 ;;; gets the first binding, and 1 gets the AREF form.
 
-;;; Temporary buffer used to build form-number => source-path translation in
-;;; FORM-NUMBER-TRANSLATIONS.
+;;; temporary buffer used to build form-number => source-path translation in
+;;; FORM-NUMBER-TRANSLATIONS
 (defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t))
 
-;;; Table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS.
+;;; table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS
 (defvar *form-number-circularity-table* (make-hash-table :test 'eq))
 
+;;; This returns a table mapping form numbers to source-paths. A source-path
+;;; indicates a descent into the top-level-form form, going directly to the
+;;; subform corressponding to the form number.
+;;;
 ;;; The vector elements are in the same format as the compiler's
-;;; NODE-SOUCE-PATH; that is, the first element is the form number and the last
-;;; is the top-level-form number.
+;;; NODE-SOURCE-PATH; that is, the first element is the form number and
+;;; the last is the top-level-form number.
 (defun form-number-translations (form tlf-number)
-  #!+sb-doc
-  "This returns a table mapping form numbers to source-paths. A source-path
-   indicates a descent into the top-level-form form, going directly to the
-   subform corressponding to the form number."
   (clrhash *form-number-circularity-table*)
   (setf (fill-pointer *form-number-temp*) 0)
   (sub-translate-form-numbers form (list tlf-number))
@@ -3039,13 +3218,13 @@
 	  (frob)
 	  (setq trail (cdr trail)))))))
 
+;;; FORM is a top-level form, and path is a source-path into it. This
+;;; returns the form indicated by the source-path. Context is the
+;;; number of enclosing forms to return instead of directly returning
+;;; the source-path form. When context is non-zero, the form returned
+;;; contains a marker, #:****HERE****, immediately before the form
+;;; indicated by path.
 (defun source-path-context (form path context)
-  #!+sb-doc
-  "Form is a top-level form, and path is a source-path into it. This returns
-   the form indicated by the source-path. Context is the number of enclosing
-   forms to return instead of directly returning the source-path form. When
-   context is non-zero, the form returned contains a marker, #:****HERE****,
-   immediately before the form indicated by path."
   (declare (type unsigned-byte context))
   ;; Get to the form indicated by path or the enclosing form indicated
   ;; by context and path.
@@ -3077,17 +3256,15 @@
 
 ;;;; PREPROCESS-FOR-EVAL and EVAL-IN-FRAME
 
-;;; Create a SYMBOL-MACROLET for each variable valid at the location which
-;;; accesses that variable from the frame argument.
+;;; Return a function of one argument that evaluates form in the
+;;; lexical context of the basic-code-location loc.
+;;; PREPROCESS-FOR-EVAL signals a no-debug-vars condition when the
+;;; loc's debug-function has no debug-var information available. The
+;;; returned function takes the frame to get values from as its
+;;; argument, and it returns the values of form. The returned function
+;;; signals the following conditions: invalid-value,
+;;; ambiguous-variable-name, and frame-function-mismatch.
 (defun preprocess-for-eval (form loc)
-  #!+sb-doc
-  "Return a function of one argument that evaluates form in the lexical
-   context of the basic-code-location loc. PREPROCESS-FOR-EVAL signals a
-   no-debug-vars condition when the loc's debug-function has no
-   debug-var information available. The returned function takes the frame
-   to get values from as its argument, and it returns the values of form.
-   The returned function signals the following conditions: invalid-value,
-   ambiguous-variable-name, and frame-function-mismatch"
   (declare (type code-location loc))
   (let ((n-frame (gensym))
 	(fun (code-location-debug-function loc)))
@@ -3175,7 +3352,7 @@
      (when (code-location-unknown-p what)
        (error "cannot make a breakpoint at an unknown code location: ~S"
 	      what))
-     (assert (eq kind :code-location))
+     (aver (eq kind :code-location))
      (let ((bpt (%make-breakpoint hook-function what kind info)))
        (etypecase what
 	 (interpreted-code-location
@@ -3223,10 +3400,11 @@
 (defstruct (function-end-cookie
 	    (:print-object (lambda (obj str)
 			     (print-unreadable-object (obj str :type t))))
-	    (:constructor make-function-end-cookie (bogus-lra debug-fun)))
-  ;; This is a pointer to the bogus-lra created for :function-end bpts.
+	    (:constructor make-function-end-cookie (bogus-lra debug-fun))
+	    (:copier nil))
+  ;; a pointer to the bogus-lra created for :FUNCTION-END breakpoints
   bogus-lra
-  ;; This is the debug-function associated with the cookie.
+  ;; the debug-function associated with the cookie
   debug-fun)
 
 ;;; This maps bogus-lra-components to cookies, so that
@@ -3574,8 +3752,10 @@
       ;; so we just leave it up to the C code.
       (breakpoint-do-displaced-inst signal-context
 				    (breakpoint-data-instruction data))
-      ; Under HPUX we can't sigreturn so bp-do-disp-i has to return.
-      #!-(or hpux irix x86)
+      ;; Some platforms have no usable sigreturn() call.  If your
+      ;; implementation of arch_do_displaced_inst() doesn't sigreturn(),
+      ;; add it to this list.
+      #!-(or hpux irix x86 alpha)
       (error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
 
 (defun invoke-breakpoint-hooks (breakpoints component offset)
@@ -3602,7 +3782,7 @@
 	      offset))
     (let ((breakpoints (breakpoint-data-breakpoints data)))
       (when breakpoints
-	(assert (eq (breakpoint-kind (car breakpoints)) :function-end))
+	(aver (eq (breakpoint-kind (car breakpoints)) :function-end))
 	(handle-function-end-breakpoint-aux breakpoints data context)))))
 
 ;;; Either HANDLE-BREAKPOINT calls this for :FUNCTION-END breakpoints