X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdebug-int.lisp;h=83c7872284cf2a1f1550a49d36342342c6b8c437;hb=c713eb2b521b048ff2c927ec52b861787d289f85;hp=071a476058eb2e0be6c081e288622f9fd6d4649b;hpb=8b89077f2d8c3aec140ded650d95d7869f6a7f28;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 071a476..83c7872 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -394,15 +394,15 @@
 	    (breakpoint-data-offset obj))))
 
 (defstruct (breakpoint (:constructor %make-breakpoint
-				     (hook-function what kind %info))
+				     (hook-fun 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 :FUN-END breakpoints
-  ;; as values to return for the function containing the breakpoint.
-  ;; :FUN-END breakpoint hook-functions also take a cookie
-  ;; argument. See COOKIE-FUN slot.
-  (hook-function nil :type function)
+  ;; list of values. Values are supplied for :FUN-END breakpoints as
+  ;; values to return for the function containing the breakpoint.
+  ;; :FUN-END breakpoint hook functions also take a cookie argument.
+  ;; See the COOKIE-FUN slot.
+  (hook-fun (required-arg) :type function)
   ;; CODE-LOCATION or DEBUG-FUN
   (what nil :type (or code-location debug-fun))
   ;; :CODE-LOCATION, :FUN-START, or :FUN-END for that kind
@@ -431,7 +431,7 @@
   ;; for identifying :FUN-END breakpoint executions. That is, if
   ;; there is one :FUN-END breakpoint, but there may be multiple
   ;; pending calls of its function on the stack. This function takes
-  ;; the cookie, and the hook-function takes the cookie too.
+  ;; the cookie, and the hook function takes the cookie too.
   (cookie-fun nil :type (or null function))
   ;; This slot users can set with whatever information they find useful.
   %info)
@@ -1123,8 +1123,7 @@
 ;;; nil). This may iterate over only some of DEBUG-FUN's variables or
 ;;; none depending on debug policy; for example, possibly the
 ;;; compilation only preserved argument information.
-(defmacro do-debug-fun-variables ((var debug-fun &optional result)
-				       &body body)
+(defmacro do-debug-fun-vars ((var debug-fun &optional result) &body body)
   (let ((vars (gensym))
 	(i (gensym)))
     `(let ((,vars (debug-fun-debug-vars ,debug-fun)))
@@ -1227,7 +1226,7 @@
 ;;; as symbol. The result of this function is limited to the
 ;;; availability of variable information in DEBUG-FUN; for
 ;;; example, possibly DEBUG-FUN only knows about its arguments.
-(defun debug-fun-symbol-variables (debug-fun symbol)
+(defun debug-fun-symbol-vars (debug-fun symbol)
   (let ((vars (ambiguous-debug-vars debug-fun (symbol-name symbol)))
 	(package (and (symbol-package symbol)
 		      (package-name (symbol-package symbol)))))
@@ -1252,7 +1251,7 @@
     (if variables
 	(let* ((len (length variables))
 	       (prefix-len (length name-prefix-string))
-	       (pos (find-variable name-prefix-string variables len))
+	       (pos (find-var name-prefix-string variables len))
 	       (res nil))
 	  (when pos
 	    ;; Find names from pos to variable's len that contain prefix.
@@ -1271,19 +1270,19 @@
 	    (setq res (nreverse res)))
 	  res))))
 
-;;; This returns a position in variables for one containing name as an
-;;; initial substring. End is the length of variables if supplied.
-(defun find-variable (name variables &optional end)
+;;; This returns a position in VARIABLES for one containing NAME as an
+;;; initial substring. END is the length of VARIABLES if supplied.
+(defun find-var (name variables &optional end)
   (declare (simple-vector variables)
 	   (simple-string name))
   (let ((name-len (length name)))
     (position name variables
-	      :test #'(lambda (x y)
-			(let* ((y (debug-var-symbol-name y))
-			       (y-len (length y)))
-			  (declare (simple-string y))
-			  (and (>= y-len name-len)
-			       (string= x y :end1 name-len :end2 name-len))))
+	      :test (lambda (x y)
+		      (let* ((y (debug-var-symbol-name y))
+			     (y-len (length y)))
+			(declare (simple-string y))
+			(and (>= y-len name-len)
+			     (string= x y :end1 name-len :end2 name-len))))
 	      :end (or end (length variables)))))
 
 ;;; Return a list representing the lambda-list for DEBUG-FUN. The
@@ -1596,7 +1595,7 @@
 (defun parse-compiled-debug-vars (debug-fun)
   (let* ((cdebug-fun (compiled-debug-fun-compiler-debug-fun
 		      debug-fun))
-	 (packed-vars (sb!c::compiled-debug-fun-variables cdebug-fun))
+	 (packed-vars (sb!c::compiled-debug-fun-vars cdebug-fun))
 	 (args-minimal (eq (sb!c::compiled-debug-fun-arguments cdebug-fun)
 			   :minimal)))
     (when packed-vars
@@ -1746,7 +1745,7 @@
 	      (unless (fill-in-code-location code-location)
 		;; This check should be unnecessary. We're missing
 		;; debug info the compiler should have dumped.
-		(error "internal error: unknown code location"))
+		(bug "unknown code location"))
 	      (code-location-%tlf-offset code-location))
 	     ;; (There used to be more cases back before sbcl-0.7.0,,
 	     ;; when we did special tricks to debug the IR1
@@ -1767,7 +1766,7 @@
 	      (unless (fill-in-code-location code-location)
 		;; This check should be unnecessary. We're missing
 		;; debug info the compiler should have dumped.
-		(error "internal error: unknown code location"))
+		(bug "unknown code location"))
 	      (code-location-%form-number code-location))
 	     ;; (There used to be more cases back before sbcl-0.7.0,,
 	     ;; when we did special tricks to debug the IR1
@@ -1789,7 +1788,7 @@
 	     ((not (fill-in-code-location code-location))
 	      ;; This check should be unnecessary. We're missing
 	      ;; debug info the compiler should have dumped.
-	      (error "internal error: unknown code location"))
+	      (bug "unknown code location"))
 	     (t
 	      (compiled-code-location-kind code-location)))))
     ;; (There used to be more cases back before sbcl-0.7.0,,
@@ -1810,7 +1809,7 @@
 		 ;;
 		 ;; FIXME: This error and comment happen over and over again.
 		 ;; Make them a shared function.
-		 (error "internal error: unknown code location"))
+		 (bug "unknown code location"))
 	       (compiled-code-location-%live-set code-location))
 	      (t live-set)))))
 
@@ -2671,7 +2670,7 @@
       (debug-signal 'no-debug-vars :debug-fun fun))
     (sb!int:collect ((binds)
 		     (specs))
-      (do-debug-fun-variables (var fun)
+      (do-debug-fun-vars (var fun)
 	(let ((validity (debug-var-validity var loc)))
 	  (unless (eq validity :invalid)
 	    (let* ((sym (debug-var-symbol var))
@@ -2697,35 +2696,34 @@
 			    (declare (ignorable ,n-frame))
 			    (symbol-macrolet ,(specs) ,form))
 			 'function)))
-	#'(lambda (frame)
-	    ;; This prevents these functions from being used in any
-	    ;; location other than a function return location, so
-	    ;; maybe this should only check whether frame's
-	    ;; DEBUG-FUN is the same as loc's.
-	    (unless (code-location= (frame-code-location frame) loc)
-	      (debug-signal 'frame-fun-mismatch
-			    :code-location loc :form form :frame frame))
-	    (funcall res frame))))))
+	(lambda (frame)
+	  ;; This prevents these functions from being used in any
+	  ;; location other than a function return location, so maybe
+	  ;; this should only check whether FRAME's DEBUG-FUN is the
+	  ;; same as LOC's.
+	  (unless (code-location= (frame-code-location frame) loc)
+	    (debug-signal 'frame-fun-mismatch
+			  :code-location loc :form form :frame frame))
+	  (funcall res 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.
+;;; the breakpoint, the system calls HOOK-FUN. HOOK-FUN 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-FUN.
-;;; KIND is one of :CODE-LOCATION, :FUN-START, or :FUN-END.
-;;; Since the starts and ends of functions may not have code-locations
-;;; representing them, designate these places by supplying WHAT as a
-;;; DEBUG-FUN and KIND indicating the :FUN-START or
-;;; :FUN-END. When WHAT is a DEBUG-FUN and kind is
-;;; :FUN-END, then hook-function must take two additional
-;;; arguments, a list of values returned by the function and a
-;;; FUN-END-COOKIE.
+;;; HOOK-FUN. WHAT is either a code-location or a DEBUG-FUN. KIND is
+;;; one of :CODE-LOCATION, :FUN-START, or :FUN-END. Since the starts
+;;; and ends of functions may not have code-locations representing
+;;; them, designate these places by supplying WHAT as a DEBUG-FUN and
+;;; KIND indicating the :FUN-START or :FUN-END. When WHAT is a
+;;; DEBUG-FUN and kind is :FUN-END, then HOOK-FUN must take two
+;;; additional arguments, a list of values returned by the function
+;;; and a FUN-END-COOKIE.
 ;;;
 ;;; INFO is information supplied by and used by the user.
 ;;;
@@ -2740,7 +2738,7 @@
 ;;; function.
 ;;;
 ;;; Signal an error if WHAT is an unknown code-location.
-(defun make-breakpoint (hook-function what
+(defun make-breakpoint (hook-fun what
 			&key (kind :code-location) info fun-end-cookie)
   (etypecase what
     (code-location
@@ -2748,12 +2746,12 @@
        (error "cannot make a breakpoint at an unknown code location: ~S"
 	      what))
      (aver (eq kind :code-location))
-     (let ((bpt (%make-breakpoint hook-function what kind info)))
+     (let ((bpt (%make-breakpoint hook-fun what kind info)))
        (etypecase what
 	 (compiled-code-location
 	  ;; This slot is filled in due to calling CODE-LOCATION-UNKNOWN-P.
 	  (when (eq (compiled-code-location-kind what) :unknown-return)
-	    (let ((other-bpt (%make-breakpoint hook-function what
+	    (let ((other-bpt (%make-breakpoint hook-fun what
 					       :unknown-return-partner
 					       info)))
 	      (setf (breakpoint-unknown-return-partner bpt) other-bpt)
@@ -2766,7 +2764,7 @@
     (compiled-debug-fun
      (ecase kind
        (:fun-start
-	(%make-breakpoint hook-function what kind info))
+	(%make-breakpoint hook-fun what kind info))
        (:fun-end
 	(unless (eq (sb!c::compiled-debug-fun-returns
 		     (compiled-debug-fun-compiler-debug-fun what))
@@ -2774,11 +2772,11 @@
 	  (error ":FUN-END breakpoints are currently unsupported ~
 		  for the known return convention."))
 
-	(let* ((bpt (%make-breakpoint hook-function what kind info))
+	(let* ((bpt (%make-breakpoint hook-fun what kind info))
 	       (starter (compiled-debug-fun-end-starter what)))
 	  (unless starter
 	    (setf starter (%make-breakpoint #'list what :fun-start nil))
-	    (setf (breakpoint-hook-function starter)
+	    (setf (breakpoint-hook-fun starter)
 		  (fun-end-starter-hook starter what))
 	    (setf (compiled-debug-fun-end-starter what) starter))
 	  (setf (breakpoint-start-helper bpt) starter)
@@ -2816,31 +2814,31 @@
 (defun fun-end-starter-hook (starter-bpt debug-fun)
   (declare (type breakpoint starter-bpt)
 	   (type compiled-debug-fun debug-fun))
-  #'(lambda (frame breakpoint)
-      (declare (ignore breakpoint)
-	       (type frame frame))
-      (let ((lra-sc-offset
-	     (sb!c::compiled-debug-fun-return-pc
-	      (compiled-debug-fun-compiler-debug-fun debug-fun))))
-	(multiple-value-bind (lra component offset)
-	    (make-bogus-lra
-	     (get-context-value frame
-				lra-save-offset
-				lra-sc-offset))
-	  (setf (get-context-value frame
-				   lra-save-offset
-				   lra-sc-offset)
-		lra)
-	  (let ((end-bpts (breakpoint-%info starter-bpt)))
-	    (let ((data (breakpoint-data component offset)))
-	      (setf (breakpoint-data-breakpoints data) end-bpts)
-	      (dolist (bpt end-bpts)
-		(setf (breakpoint-internal-data bpt) data)))
-	    (let ((cookie (make-fun-end-cookie lra debug-fun)))
-	      (setf (gethash component *fun-end-cookies*) cookie)
-	      (dolist (bpt end-bpts)
-		(let ((fun (breakpoint-cookie-fun bpt)))
-		  (when fun (funcall fun frame cookie))))))))))
+  (lambda (frame breakpoint)
+    (declare (ignore breakpoint)
+	     (type frame frame))
+    (let ((lra-sc-offset
+	   (sb!c::compiled-debug-fun-return-pc
+	    (compiled-debug-fun-compiler-debug-fun debug-fun))))
+      (multiple-value-bind (lra component offset)
+	  (make-bogus-lra
+	   (get-context-value frame
+			      lra-save-offset
+			      lra-sc-offset))
+	(setf (get-context-value frame
+				 lra-save-offset
+				 lra-sc-offset)
+	      lra)
+	(let ((end-bpts (breakpoint-%info starter-bpt)))
+	  (let ((data (breakpoint-data component offset)))
+	    (setf (breakpoint-data-breakpoints data) end-bpts)
+	    (dolist (bpt end-bpts)
+	      (setf (breakpoint-internal-data bpt) data)))
+	  (let ((cookie (make-fun-end-cookie lra debug-fun)))
+	    (setf (gethash component *fun-end-cookies*) cookie)
+	    (dolist (bpt end-bpts)
+	      (let ((fun (breakpoint-cookie-fun bpt)))
+		(when fun (funcall fun frame cookie))))))))))
 
 ;;; This takes a FUN-END-COOKIE and a frame, and it returns
 ;;; whether the cookie is still valid. A cookie becomes invalid when
@@ -2867,7 +2865,7 @@
 
 ;;;; ACTIVATE-BREAKPOINT
 
-;;; Cause the system to invoke the breakpoint's hook-function until
+;;; 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.
@@ -2950,7 +2948,7 @@
 
 ;;;; DEACTIVATE-BREAKPOINT
 
-;;; Stop the system from invoking the breakpoint's hook-function.
+;;; Stop the system from invoking the breakpoint's hook function.
 (defun deactivate-breakpoint (breakpoint)
   (when (eq (breakpoint-status breakpoint) :active)
     (without-interrupts
@@ -2969,9 +2967,9 @@
 (defun deactivate-compiled-breakpoint (breakpoint)
   (if (eq (breakpoint-kind breakpoint) :fun-end)
       (let ((starter (breakpoint-start-helper breakpoint)))
-	(unless (find-if #'(lambda (bpt)
-			     (and (not (eq bpt breakpoint))
-				  (eq (breakpoint-status bpt) :active)))
+	(unless (find-if (lambda (bpt)
+			   (and (not (eq bpt breakpoint))
+				(eq (breakpoint-status bpt) :active)))
 			 (breakpoint-%info starter))
 	  (deactivate-compiled-breakpoint starter)))
       (let* ((data (breakpoint-internal-data breakpoint))
@@ -3037,21 +3035,21 @@
 ;;; returns the overwritten bits. You must call this in a context in
 ;;; which GC is disabled, so that Lisp doesn't move objects around
 ;;; that C is pointing to.
-(sb!alien:define-alien-routine "breakpoint_install" sb!c-call:unsigned-long
-  (code-obj sb!c-call:unsigned-long)
-  (pc-offset sb!c-call:int))
+(sb!alien:define-alien-routine "breakpoint_install" sb!alien:unsigned-long
+  (code-obj sb!alien:unsigned-long)
+  (pc-offset sb!alien:int))
 
 ;;; This removes the break instruction and replaces the original
 ;;; instruction. You must call this in a context in which GC is disabled
 ;;; so Lisp doesn't move objects around that C is pointing to.
-(sb!alien:define-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))
+(sb!alien:define-alien-routine "breakpoint_remove" sb!alien:void
+  (code-obj sb!alien:unsigned-long)
+  (pc-offset sb!alien:int)
+  (old-inst sb!alien:unsigned-long))
 
-(sb!alien:define-alien-routine "breakpoint_do_displaced_inst" sb!c-call:void
+(sb!alien:define-alien-routine "breakpoint_do_displaced_inst" sb!alien:void
   (scp (* os-context-t))
-  (orig-inst sb!c-call:unsigned-long))
+  (orig-inst sb!alien:unsigned-long))
 
 ;;;; breakpoint handlers (layer between C and exported interface)
 
@@ -3116,7 +3114,7 @@
 ;;; breakpoints.
 (defun handle-breakpoint-aux (breakpoints data offset component signal-context)
   (unless breakpoints
-    (error "internal error: breakpoint that nobody wants"))
+    (bug "breakpoint that nobody wants"))
   (unless (member data *executing-breakpoint-hooks*)
     (let ((*executing-breakpoint-hooks* (cons data
 					      *executing-breakpoint-hooks*)))
@@ -3148,7 +3146,7 @@
 	 (frame (do ((f (top-frame) (frame-down f)))
 		    ((eq debug-fun (frame-debug-fun f)) f))))
     (dolist (bpt breakpoints)
-      (funcall (breakpoint-hook-function bpt)
+      (funcall (breakpoint-hook-fun bpt)
 	       frame
 	       ;; If this is an :UNKNOWN-RETURN-PARTNER, then pass the
 	       ;; hook function the original breakpoint, so that users
@@ -3186,7 +3184,7 @@
 	 (cookie (gethash component *fun-end-cookies*)))
     (remhash component *fun-end-cookies*)
     (dolist (bpt breakpoints)
-      (funcall (breakpoint-hook-function bpt)
+      (funcall (breakpoint-hook-fun bpt)
 	       frame bpt
 	       (get-fun-end-breakpoint-values scp)
 	       cookie))))