X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=7335c682fd0cb1cdda8d12ece643b1b147fc1725;hb=0b5610d8a220a4b20cbeac958953ca4d67c00038;hp=96d064ce75856aa6ec08b42c1785a8dbd4bd4606;hpb=6d9ecc45cb21a1208deb8c4d128adc04aa289c9d;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 96d064c..7335c68 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -12,9 +12,6 @@
 
 (in-package "SB!DI")
 
-(file-comment
-  "$Header$")
-
 ;;; FIXME: There are an awful lot of package prefixes in this code.
 ;;; Couldn't we have SB-DI use the SB-C and SB-VM packages?
 
@@ -41,24 +38,27 @@
   ()
   #!+sb-doc
   (:documentation
-   "All debug-conditions inherit from this type. These are serious conditions
+   "All DEBUG-CONDITIONs inherit from this type. These are serious conditions
     that must be handled, but they are not programmer errors."))
 
 (define-condition no-debug-info (debug-condition)
-  ()
+  ((code-component :reader no-debug-info-code-component
+		   :initarg :code-component))
   #!+sb-doc
-  (:documentation "There is absolutely no debugging information available.")
+  (:documentation "There is no usable debugging information available.")
   (:report (lambda (condition stream)
 	     (declare (ignore condition))
 	     (fresh-line stream)
-	     (write-line "No debugging information available." stream))))
+	     (format stream
+		     "no debug information available for ~S~%"
+		     (no-debug-info-code-component condition)))))
 
 (define-condition no-debug-function-returns (debug-condition)
   ((debug-function :reader no-debug-function-returns-debug-function
 		   :initarg :debug-function))
   #!+sb-doc
   (:documentation
-   "The system could not return values from a frame with debug-function since
+   "The system could not return values from a frame with DEBUG-FUNCTION since
     it lacked information about returning values.")
   (:report (lambda (condition stream)
 	     (let ((fun (debug-function-function
@@ -130,11 +130,11 @@
    "All programmer errors from using the interface for building debugging
     tools inherit from this type."))
 
-(define-condition unhandled-condition (debug-error)
-  ((condition :reader unhandled-condition-condition :initarg :condition))
+(define-condition unhandled-debug-condition (debug-error)
+  ((condition :reader unhandled-debug-condition-condition :initarg :condition))
   (:report (lambda (condition stream)
 	     (format stream "~&unhandled DEBUG-CONDITION:~%~A"
-		     (unhandled-condition-condition condition)))))
+		     (unhandled-debug-condition-condition condition)))))
 
 (define-condition unknown-code-location (debug-error)
   ((code-location :reader unknown-code-location-code-location
@@ -165,20 +165,21 @@
    (frame :reader frame-function-mismatch-frame :initarg :frame)
    (form :reader frame-function-mismatch-form :initarg :form))
   (:report (lambda (condition stream)
-	     (format stream
-		     "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
-		     (frame-function-mismatch-code-location condition)
-		     (frame-function-mismatch-frame condition)
-		     (frame-function-mismatch-form condition)))))
-
-;;; This signals debug-conditions. If they go unhandled, then signal an
-;;; unhandled-condition error.
+	     (format
+	      stream
+	      "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
+	      (frame-function-mismatch-code-location condition)
+	      (frame-function-mismatch-frame condition)
+	      (frame-function-mismatch-form condition)))))
+
+;;; This signals debug-conditions. If they go unhandled, then signal
+;;; an UNHANDLED-DEBUG-CONDITION error.
 ;;;
 ;;; ??? Get SIGNAL in the right package!
 (defmacro debug-signal (datum &rest arguments)
   `(let ((condition (make-condition ,datum ,@arguments)))
      (signal condition)
-     (error 'unhandled-condition :condition condition)))
+     (error 'unhandled-debug-condition :condition condition)))
 
 ;;;; structures
 ;;;;
@@ -192,7 +193,8 @@
 
 ;;; 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
@@ -215,7 +217,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.
@@ -223,14 +226,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
@@ -272,7 +277,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
@@ -295,7 +301,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.
@@ -313,7 +320,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.
@@ -333,7 +340,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).
@@ -359,7 +367,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))
 
@@ -367,7 +376,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))
@@ -381,8 +391,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
@@ -407,14 +418,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.
@@ -465,7 +478,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.
@@ -483,7 +497,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
@@ -550,7 +565,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
@@ -586,7 +602,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
@@ -601,7 +618,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))
 
@@ -674,18 +692,15 @@
 #!-sb-fluid (declaim (inline cstack-pointer-valid-p))
 (defun cstack-pointer-valid-p (x)
   (declare (type system-area-pointer x))
-  #!-x86
+  #!-x86 ; stack grows toward high address values
   (and (sap< x (current-sp))
-       (sap<= #!-gengc (sb!alien:alien-sap
-			(sb!alien:extern-alien "control_stack" (* t)))
+       (sap<= #!-gengc (int-sap control-stack-start)
 	      #!+gengc (mutator-control-stack-base)
 	      x)
        (zerop (logand (sap-int x) #b11)))
-  #!+x86 ;; stack grows to low address values
+  #!+x86 ; stack grows toward low address values
   (and (sap>= x (current-sp))
-       (sap> (sb!alien:alien-sap (sb!alien:extern-alien "control_stack_end"
-							(* t)))
-	     x)
+       (sap> (int-sap control-stack-end) x)
        (zerop (logand (sap-int x) #b11))))
 
 #!+(or gengc x86)
@@ -729,9 +744,7 @@
    ;; Not the first page which is unmapped.
    (>= (sap-int ra) 4096)
    ;; Not a Lisp stack pointer.
-   (or (sap< ra (current-sp))
-       (sap>= ra (sb!alien:alien-sap
-		  (sb!alien:extern-alien "control_stack_end" (* t)))))))
+   (not (cstack-pointer-valid-p ra))))
 
 ;;; Try to find a valid previous stack. This is complex on the x86 as
 ;;; it can jump between C and Lisp frames. To help find a valid frame
@@ -740,9 +753,9 @@
 ;;; 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.
-(defun x86-call-context (fp &key (depth 8))
+;;; 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))
   ;;(format t "*CC ~S ~S~%" fp depth)
@@ -766,15 +779,20 @@
 			   lisp-ocfp lisp-ra c-ocfp c-ra)
 	     ;; Look forward another step to check their validity.
 	     (let ((lisp-path-fp (x86-call-context lisp-ocfp
-						   :depth (- depth 1)))
-		   (c-path-fp (x86-call-context c-ocfp :depth (- depth 1))))
+						   :depth (1+ depth)))
+		   (c-path-fp (x86-call-context c-ocfp :depth (1+ depth))))
 	       (cond ((and lisp-path-fp c-path-fp)
-		      ;; Both still seem valid - choose the smallest.
-		      #+nil (format t "debug: both still valid ~S ~S ~S ~S~%"
-				    lisp-ocfp lisp-ra c-ocfp c-ra)
-		      (if (sap< lisp-ocfp c-ocfp)
-			  (values lisp-ra lisp-ocfp)
-			(values c-ra c-ocfp)))
+                       ;; Both still seem valid - choose the lisp frame.
+                       #+nil (when (zerop depth)
+                               (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)
+                        (values lisp-ra lisp-ocfp)
+			(values c-ra c-ocfp))
+                       #-freebsd
+                       (values lisp-ra lisp-ocfp))
 		     (lisp-path-fp
 		      ;; The lisp convention is looking good.
 		      #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra)
@@ -1116,9 +1134,8 @@
 	  (without-gcing
 	   (let* ((component-ptr (component-ptr-from-pc
 				  (sb!vm:context-pc context)))
-		  (code (if (sap= component-ptr (int-sap #x0))
-			    nil ; FIXME: UNLESS might be clearer than IF.
-			    (component-from-component-ptr component-ptr))))
+		  (code (unless (sap= component-ptr (int-sap #x0))
+			  (component-from-component-ptr component-ptr))))
 	     (when (null code)
 	       (return (values code 0 context)))
 	     (let* ((code-header-len (* (get-header-data code)
@@ -1131,8 +1148,10 @@
 	       (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.
+		 ;; We were in an assembly routine. Therefore, use the
+		 ;; LRA as the pc.
+		 ;;
+		 ;; FIXME: Should this be WARN or ERROR or what?
 		 (format t "** pc-offset ~S not in code obj ~S?~%"
 			 pc-offset code))
 	       (return
@@ -1195,7 +1214,7 @@
   (let ((info (%code-debug-info component)))
     (cond
      ((not info)
-      (debug-signal 'no-debug-info))
+      (debug-signal 'no-debug-info :code-component component))
      ((eq info :bogus-lra)
       (make-bogus-debug-function "function end breakpoint"))
      (t
@@ -1208,8 +1227,7 @@
 		  (elsewhere-p
 		   (>= pc (sb!c::compiled-debug-function-elsewhere-pc
 			   (svref function-map 0)))))
-	      ;; FIXME: I don't think SB!C is the home package of INDEX.
-	      (declare (type sb!c::index i))
+	      (declare (type sb!int:index i))
 	      (loop
 		(when (or (= i len)
 			  (< pc (if elsewhere-p
@@ -1817,7 +1835,7 @@
 	      (let* ((locations
 		      (dotimes (k (sb!c::read-var-integer blocks i)
 				  (result locations-buffer))
-			(let ((kind (svref sb!c::compiled-code-location-kinds
+			(let ((kind (svref sb!c::*compiled-code-location-kinds*
 					   (aref+ blocks i)))
 			      (pc (+ last-pc
 				     (sb!c::read-var-integer blocks i)))
@@ -2007,7 +2025,7 @@
       (if (logtest flags sb!c::minimal-debug-function-setf-bit)
 	  `(setf ,base)
 	  base))
-    :kind (svref sb!c::minimal-debug-function-kinds
+    :kind (svref sb!c::*minimal-debug-function-kinds*
 		 (ldb sb!c::minimal-debug-function-kind-byte options))
     :variables
     (when vars-p
@@ -2071,14 +2089,14 @@
 
       (coerce (cdr (res)) 'simple-vector))))
 
-;;; This variable maps minimal debug-info function maps to an unpacked
-;;; version thereof.
+;;; a map from minimal DEBUG-INFO function maps to unpacked
+;;; versions thereof
 (defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
 
-;;; Return a function-map for a given compiled-debug-info object. If
+;;; Return a FUNCTION-MAP for a given COMPILED-DEBUG-info object. If
 ;;; the info is minimal, and has not been parsed, then parse it.
 ;;;
-;;; FIXME: Now that we no longer use the minimal-debug-function
+;;; FIXME: Now that we no longer use the MINIMAL-DEBUG-FUNCTION
 ;;; representation, calls to this function can be replaced by calls to
 ;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
 ;;; and this function and everything it calls become dead code which
@@ -2094,17 +2112,14 @@
 
 ;;;; CODE-LOCATIONs
 
-;;; If we're sure of whether code-location is known, return t or nil.
-;;; If we're :unsure, then try to fill in the code-location's slots.
+;;; If we're sure of whether code-location is known, return T or NIL.
+;;; If we're :UNSURE, then try to fill in the code-location's slots.
 ;;; This determines whether there is any debug-block information, and
 ;;; if code-location is known.
 ;;;
 ;;; ??? IF this conses closures every time it's called, then break off the
-;;; :unsure part to get the HANDLER-CASE into another function.
+;;; :UNSURE part to get the HANDLER-CASE into another function.
 (defun code-location-unknown-p (basic-code-location)
-  #!+sb-doc
-  "Returns whether basic-code-location is unknown. It returns nil when the
-   code-location is known."
   (ecase (code-location-%unknown-p basic-code-location)
     ((t) t)
     ((nil) nil)
@@ -2113,11 +2128,10 @@
 	   (handler-case (not (fill-in-code-location basic-code-location))
 	     (no-debug-blocks () t))))))
 
+;;; Return the DEBUG-BLOCK containing code-location if it is available.
+;;; Some debug policies inhibit debug-block information, and if none
+;;; is available, then this signals a NO-DEBUG-BLOCKS condition.
 (defun code-location-debug-block (basic-code-location)
-  #!+sb-doc
-  "Returns the debug-block containing code-location if it is available. Some
-   debug policies inhibit debug-block information, and if none is available,
-   then this signals a no-debug-blocks condition."
   (let ((block (code-location-%debug-block basic-code-location)))
     (if (eq block :unparsed)
 	(etypecase basic-code-location
@@ -2130,10 +2144,10 @@
 		   (interpreted-code-location-ir1-node basic-code-location))))))
 	block)))
 
-;;; This stores and returns BASIC-CODE-LOCATION's debug-block. It
-;;; determines the correct one using the code-location's pc. This uses
+;;; Store and return BASIC-CODE-LOCATION's debug-block. We determines
+;;; the correct one using the code-location's pc. We use
 ;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information
-;;; or signal a 'no-debug-blocks condition. The blocks are sorted by
+;;; or signal a NO-DEBUG-BLOCKS condition. The blocks are sorted by
 ;;; their first code-location's pc, in ascending order. Therefore, as
 ;;; soon as we find a block that starts with a pc greater than
 ;;; basic-code-location's pc, we know the previous block contains the
@@ -2284,8 +2298,8 @@
       (let ((live-set (compiled-code-location-%live-set code-location)))
 	(cond ((eq live-set :unparsed)
 	       (unless (fill-in-code-location code-location)
-		 ;; This check should be unnecessary. We're missing debug info
-		 ;; the compiler should have dumped.
+		 ;; This check should be unnecessary. We're missing
+		 ;; debug info the compiler should have dumped.
 		 ;;
 		 ;; FIXME: This error and comment happen over and over again.
 		 ;; Make them a shared function.
@@ -2293,9 +2307,8 @@
 	       (compiled-code-location-%live-set code-location))
 	      (t live-set)))))
 
+;;; true if OBJ1 and OBJ2 are the same place in the code
 (defun code-location= (obj1 obj2)
-  #!+sb-doc
-  "Returns whether obj1 and obj2 are the same place in the code."
   (etypecase obj1
     (compiled-code-location
      (etypecase obj2
@@ -2316,7 +2329,7 @@
   (= (compiled-code-location-pc obj1)
      (compiled-code-location-pc obj2)))
 
-;;; This fills in CODE-LOCATION's :unparsed slots. It returns t or nil
+;;; Fill in CODE-LOCATION's :UNPARSED slots, returning T or NIL
 ;;; depending on whether the code-location was known in its
 ;;; debug-function's debug-block information. This may signal a
 ;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUNCTION-DEBUG-BLOCKS, and
@@ -2474,13 +2487,13 @@
 	    ;; Check that the pointer is valid. XXX Could do a better
 	    ;; job. FIXME: e.g. by calling out to an is_valid_pointer
 	    ;; routine in the C runtime support code
-	    (or (< (sb!impl::read-only-space-start) val
-		   (* sb!impl::*read-only-space-free-pointer*
+	    (or (< sb!vm:read-only-space-start val
+		   (* sb!vm:*read-only-space-free-pointer*
 		      sb!vm:word-bytes))
-		(< (sb!impl::static-space-start) val
-		   (* sb!impl::*static-space-free-pointer*
+		(< sb!vm:static-space-start val
+		   (* sb!vm:*static-space-free-pointer*
 		      sb!vm:word-bytes))
-		(< (sb!impl::current-dynamic-space-start) val
+		(< sb!vm:dynamic-space-start val
 		   (sap-int (dynamic-space-free-pointer))))))
       (make-lisp-obj val)
       :invalid-object))
@@ -3125,43 +3138,47 @@
 			    :code-location loc :form form :frame frame))
 	    (funcall res frame))))))
 
+;;; Evaluate FORM in the lexical context of FRAME's current code
+;;; location, returning the results of the evaluation.
 (defun eval-in-frame (frame form)
   (declare (type frame frame))
-  #!+sb-doc
-  "Evaluate Form in the lexical context of Frame's current code location,
-   returning the results of the evaluation."
   (funcall (preprocess-for-eval form (frame-code-location frame)) frame))
 
 ;;;; breakpoints
 
 ;;;; user-visible interface
 
+;;; Create and return a breakpoint. When program execution encounters
+;;; the breakpoint, the system calls HOOK-FUNCTION. HOOK-FUNCTION takes the
+;;; current frame for the function in which the program is running and the
+;;; breakpoint object.
+;;;
+;;; WHAT and KIND determine where in a function the system invokes
+;;; HOOK-FUNCTION. WHAT is either a code-location or a debug-function.
+;;; KIND is one of :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END.
+;;; Since the starts and ends of functions may not have code-locations
+;;; representing them, designate these places by supplying WHAT as a
+;;; debug-function and KIND indicating the :FUNCTION-START or
+;;; :FUNCTION-END. When WHAT is a debug-function and kind is
+;;; :FUNCTION-END, then hook-function must take two additional
+;;; arguments, a list of values returned by the function and a
+;;; FUNCTION-END-COOKIE.
+;;;
+;;; INFO is information supplied by and used by the user.
+;;;
+;;; FUNCTION-END-COOKIE is a function. To implement :FUNCTION-END
+;;; breakpoints, the system uses starter breakpoints to establish the
+;;; :FUNCTION-END breakpoint for each invocation of the function. Upon
+;;; each entry, the system creates a unique cookie to identify the
+;;; invocation, and when the user supplies a function for this
+;;; argument, the system invokes it on the frame and the cookie. The
+;;; system later invokes the :FUNCTION-END breakpoint hook on the same
+;;; cookie. The user may save the cookie for comparison in the hook
+;;; function.
+;;;
+;;; Signal an error if WHAT is an unknown code-location.
 (defun make-breakpoint (hook-function what
 			&key (kind :code-location) info function-end-cookie)
-  #!+sb-doc
-  "This creates and returns a breakpoint. When program execution encounters
-   the breakpoint, the system calls hook-function. Hook-function takes the
-   current frame for the function in which the program is running and the
-   breakpoint object.
-      What and kind determine where in a function the system invokes
-   hook-function. What is either a code-location or a debug-function. Kind is
-   one of :code-location, :function-start, or :function-end. Since the starts
-   and ends of functions may not have code-locations representing them,
-   designate these places by supplying what as a debug-function and kind
-   indicating the :function-start or :function-end. When what is a
-   debug-function and kind is :function-end, then hook-function must take two
-   additional arguments, a list of values returned by the function and a
-   function-end-cookie.
-      Info is information supplied by and used by the user.
-      Function-end-cookie is a function. To implement :function-end breakpoints,
-   the system uses starter breakpoints to establish the :function-end breakpoint
-   for each invocation of the function. Upon each entry, the system creates a
-   unique cookie to identify the invocation, and when the user supplies a
-   function for this argument, the system invokes it on the frame and the
-   cookie. The system later invokes the :function-end breakpoint hook on the
-   same cookie. The user may save the cookie for comparison in the hook
-   function.
-      This signals an error if what is an unknown code-location."
   (etypecase what
     (code-location
      (when (code-location-unknown-p what)
@@ -3215,13 +3232,14 @@
 (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
+;;; This maps bogus-lra-components to cookies, so that
 ;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the
 ;;; breakpoint hook.
 (defvar *function-end-cookies* (make-hash-table :test 'eq))
@@ -3264,16 +3282,17 @@
 		(let ((fun (breakpoint-cookie-fun bpt)))
 		  (when fun (funcall fun frame cookie))))))))))
 
+;;; This takes a FUNCTION-END-COOKIE and a frame, and it returns
+;;; whether the cookie is still valid. A cookie becomes invalid when
+;;; the frame that established the cookie has exited. Sometimes cookie
+;;; holders are unaware of cookie invalidation because their
+;;; :FUNCTION-END breakpoint hooks didn't run due to THROW'ing.
+;;;
+;;; This takes a frame as an efficiency hack since the user probably
+;;; has a frame object in hand when using this routine, and it saves
+;;; repeated parsing of the stack and consing when asking whether a
+;;; series of cookies is valid.
 (defun function-end-cookie-valid-p (frame cookie)
-  #!+sb-doc
-  "This takes a function-end-cookie and a frame, and it returns whether the
-   cookie is still valid. A cookie becomes invalid when the frame that
-   established the cookie has exited. Sometimes cookie holders are unaware
-   of cookie invalidation because their :function-end breakpoint hooks didn't
-   run due to THROW'ing. This takes a frame as an efficiency hack since the
-   user probably has a frame object in hand when using this routine, and it
-   saves repeated parsing of the stack and consing when asking whether a
-   series of cookies is valid."
   (let ((lra (function-end-cookie-bogus-lra cookie))
 	(lra-sc-offset (sb!c::compiled-debug-function-return-pc
 			(compiled-debug-function-compiler-debug-fun
@@ -3287,14 +3306,14 @@
 					#!+gengc sb!vm::ra-save-offset
 					lra-sc-offset)))
 	(return t)))))
-
+
 ;;;; ACTIVATE-BREAKPOINT
 
+;;; Cause the system to invoke the breakpoint's hook-function until
+;;; the next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The
+;;; system invokes breakpoint hook functions in the opposite order
+;;; that you activate them.
 (defun activate-breakpoint (breakpoint)
-  #!+sb-doc
-  "This causes the system to invoke the breakpoint's hook-function until the
-   next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The system invokes
-   breakpoint hook functions in the opposite order that you activate them."
   (when (eq (breakpoint-status breakpoint) :deleted)
     (error "cannot activate a deleted breakpoint: ~S" breakpoint))
   (unless (eq (breakpoint-status breakpoint) :active)
@@ -3321,7 +3340,7 @@
 	 (compiled-debug-function
 	  (let ((starter (breakpoint-start-helper breakpoint)))
 	    (unless (eq (breakpoint-status starter) :active)
-	      ;; May already be active by some other :function-end breakpoint.
+	      ;; may already be active by some other :FUNCTION-END breakpoint
 	      (activate-compiled-function-start-breakpoint starter)))
 	  (setf (breakpoint-status breakpoint) :active))
 	 (interpreted-debug-function
@@ -3369,7 +3388,7 @@
    (setf (breakpoint-data-breakpoints data)
 	 (append (breakpoint-data-breakpoints data) (list breakpoint)))
    (setf (breakpoint-internal-data breakpoint) data)))
-
+
 ;;;; DEACTIVATE-BREAKPOINT
 
 (defun deactivate-breakpoint (breakpoint)
@@ -3410,7 +3429,7 @@
 	  (delete-breakpoint-data data))))
   (setf (breakpoint-status breakpoint) :inactive)
   breakpoint)
-
+
 ;;;; BREAKPOINT-INFO
 
 (defun breakpoint-info (breakpoint)
@@ -3423,7 +3442,7 @@
   (let ((other (breakpoint-unknown-return-partner breakpoint)))
     (when other
       (setf (breakpoint-%info other) value))))
-
+
 ;;;; BREAKPOINT-ACTIVE-P and DELETE-BREAKPOINT
 
 (defun breakpoint-active-p (breakpoint)
@@ -3457,7 +3476,7 @@
 		   (breakpoint-what breakpoint))
 		  nil))))))
   breakpoint)
-
+
 ;;;; C call out stubs
 
 ;;; This actually installs the break instruction in the component. It
@@ -3518,6 +3537,7 @@
 ;;; 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"
@@ -3541,6 +3561,7 @@
 ;;; This handles code-location and debug-function :FUNCTION-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*)
@@ -3583,6 +3604,7 @@
 		   bpt)))))
 
 (defun handle-function-end-breakpoint (offset component context)
+  (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT")
   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "unknown breakpoint in ~S at offset ~S"
@@ -3597,6 +3619,7 @@
 ;;; [old C code] or HANDLE-FUNCTION-END-BREAKPOINT calls this directly
 ;;; [new C code].
 (defun handle-function-end-breakpoint-aux (breakpoints data signal-context)
+  (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT-AUX")
   (delete-breakpoint-data data)
   (let* ((scp
 	  (locally
@@ -3622,7 +3645,7 @@
 			#!+x86 sb!vm::ebx-offset)))
 	(nargs (make-lisp-obj
 		(sb!vm:context-register scp sb!vm::nargs-offset)))
- 	(reg-arg-offsets '#.sb!vm::register-arg-offsets)
+ 	(reg-arg-offsets '#.sb!vm::*register-arg-offsets*)
 	(results nil))
     (without-gcing
      (dotimes (arg-num nargs)
@@ -3632,8 +3655,8 @@
 	       (stack-ref ocfp arg-num))
 	     results)))
     (nreverse results)))
-
-;;;; MAKE-BOGUS-LRA (used for :function-end breakpoints)
+
+;;;; MAKE-BOGUS-LRA (used for :FUNCTION-END breakpoints)
 
 (defconstant
   bogus-lra-constants