X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=5e7a1fc94d0d8e43169d5dcf4fb36d2fcbdb1048;hb=986ce2596822cc0871b609346aaf592348aca596;hp=bb1eb1f03fa495f9110240e0e0c0f1a5371edb0e;hpb=50305b602c3953440af716137a56f50cd204375d;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index bb1eb1f..5e7a1fc 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -105,13 +105,13 @@
 		     (invalid-value-debug-var condition)
 		     (invalid-value-frame condition)))))
 
-(define-condition ambiguous-variable-name (debug-condition)
-  ((name :reader ambiguous-variable-name-name :initarg :name)
-   (frame :reader ambiguous-variable-name-frame :initarg :frame))
+(define-condition ambiguous-var-name (debug-condition)
+  ((name :reader ambiguous-var-name-name :initarg :name)
+   (frame :reader ambiguous-var-name-frame :initarg :frame))
   (:report (lambda (condition stream)
 	     (format stream "~&~S names more than one valid variable in ~S."
-		     (ambiguous-variable-name-name condition)
-		     (ambiguous-variable-name-frame condition)))))
+		     (ambiguous-var-name-name condition)
+		     (ambiguous-var-name-frame condition)))))
 
 ;;;; errors and DEBUG-SIGNAL
 
@@ -195,10 +195,10 @@
 (defstruct (debug-var (:constructor nil)
 		      (:copier nil))
   ;; the name of the variable
-  (symbol (required-argument) :type symbol)
+  (symbol (missing-arg) :type symbol)
   ;; a unique integer identification relative to other variables with the same
   ;; symbol
-  (id 0 :type sb!c::index)
+  (id 0 :type index)
   ;; Does the variable always have a valid value?
   (alive-p nil :type boolean))
 (def!method print-object ((debug-var debug-var) stream)
@@ -219,9 +219,9 @@
 			  (symbol id alive-p sc-offset save-sc-offset))
 	    (:copier nil))
   ;; storage class and offset (unexported)
-  (sc-offset nil :type sb!c::sc-offset)
+  (sc-offset nil :type sb!c:sc-offset)
   ;; storage class and offset when saved somewhere
-  (save-sc-offset nil :type (or sb!c::sc-offset null)))
+  (save-sc-offset nil :type (or sb!c:sc-offset null)))
 
 ;;;; frames
 
@@ -349,7 +349,7 @@
   (elsewhere-p nil :type boolean))
 (def!method print-object ((obj debug-block) str)
   (print-unreadable-object (obj str :type t)
-    (prin1 (debug-block-function-name obj) str)))
+    (prin1 (debug-block-fun-name obj) str)))
 
 #!+sb-doc
 (setf (fdocumentation 'debug-block-successors 'function)
@@ -380,7 +380,7 @@
   ;; This is the component in which the breakpoint lies.
   component
   ;; This is the byte offset into the component.
-  (offset nil :type sb!c::index)
+  (offset nil :type index)
   ;; The original instruction replaced by the breakpoint.
   (instruction nil :type (or null (unsigned-byte 32)))
   ;; A list of user breakpoints at this location.
@@ -467,10 +467,10 @@
   (%debug-block :unparsed :type (or debug-block (member :unparsed)))
   ;; This is the number of forms processed by the compiler or loader
   ;; before the top-level form containing this code-location.
-  (%tlf-offset :unparsed :type (or sb!c::index (member :unparsed)))
+  (%tlf-offset :unparsed :type (or index (member :unparsed)))
   ;; This is the depth-first number of the node that begins
   ;; code-location within its top-level form.
-  (%form-number :unparsed :type (or sb!c::index (member :unparsed))))
+  (%form-number :unparsed :type (or index (member :unparsed))))
 (def!method print-object ((obj code-location) str)
   (print-unreadable-object (obj str :type t)
     (prin1 (debug-fun-name (code-location-debug-fun obj))
@@ -484,7 +484,7 @@
 	    (:constructor make-compiled-code-location (pc debug-fun))
 	    (:copier nil))
   ;; an index into DEBUG-FUN's component slot
-  (pc nil :type sb!c::index)
+  (pc nil :type index)
   ;; a bit-vector indexed by a variable's position in
   ;; DEBUG-FUN-DEBUG-VARS indicating whether the variable has a
   ;; valid value at this code-location. (unexported).
@@ -730,7 +730,7 @@
 #!-x86
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
-	   (type sb!c::sc-offset loc))
+	   (type sb!c:sc-offset loc))
   (let ((pointer (frame-pointer frame))
 	(escaped (compiled-frame-escaped frame)))
     (if escaped
@@ -739,7 +739,7 @@
 #!+x86
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
-	   (type sb!c::sc-offset loc))
+	   (type sb!c:sc-offset loc))
   (let ((pointer (frame-pointer frame))
 	(escaped (compiled-frame-escaped frame)))
     (if escaped
@@ -753,7 +753,7 @@
 #!-x86
 (defun (setf get-context-value) (value frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
-	   (type sb!c::sc-offset loc))
+	   (type sb!c:sc-offset loc))
   (let ((pointer (frame-pointer frame))
 	(escaped (compiled-frame-escaped frame)))
     (if escaped
@@ -763,7 +763,7 @@
 #!+x86
 (defun (setf get-context-value) (value frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
-	   (type sb!c::sc-offset loc))
+	   (type sb!c:sc-offset loc))
   (let ((pointer (frame-pointer frame))
 	(escaped (compiled-frame-escaped frame)))
     (if escaped
@@ -975,12 +975,12 @@
     (if (functionp object)
 	(or (fun-code-header object)
 	    :undefined-function)
-	(let ((lowtag (get-lowtag object)))
+	(let ((lowtag (lowtag-of object)))
 	  (if (= lowtag sb!vm:other-pointer-lowtag)
-	      (let ((type (get-type object)))
-		(cond ((= type sb!vm:code-header-widetag)
+	      (let ((widetag (widetag-of object)))
+		(cond ((= widetag sb!vm:code-header-widetag)
 		       object)
-		      ((= type sb!vm:return-pc-header-widetag)
+		      ((= widetag sb!vm:return-pc-header-widetag)
 		       (lra-code-header object))
 		      (t
 		       nil))))))))
@@ -1173,7 +1173,7 @@
 ;;; Return a DEBUG-FUN that represents debug information for FUN.
 (defun fun-debug-fun (fun)
   (declare (type function fun))
-  (ecase (get-type fun)
+  (ecase (widetag-of fun)
     (#.sb!vm:closure-header-widetag
      (fun-debug-fun (%closure-fun fun)))
     (#.sb!vm:funcallable-instance-header-widetag
@@ -1475,8 +1475,8 @@
 	   (debug-signal 'no-debug-blocks
 			 :debug-fun debug-fun)))))
 
-;;; This returns a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates
-;;; there was no basic block information.
+;;; Return a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates there
+;;; was no basic block information.
 (defun parse-debug-blocks (debug-fun)
   (etypecase debug-fun
     (compiled-debug-fun
@@ -1486,16 +1486,17 @@
 
 ;;; This does some of the work of PARSE-DEBUG-BLOCKS.
 (defun parse-compiled-debug-blocks (debug-fun)
-  (let* ((debug-fun (compiled-debug-fun-compiler-debug-fun
-		     debug-fun))
-	 (var-count (length (debug-fun-debug-vars debug-fun)))
-	 (blocks (sb!c::compiled-debug-fun-blocks debug-fun))
+  (let* ((var-count (length (debug-fun-debug-vars debug-fun)))
+	 (compiler-debug-fun (compiled-debug-fun-compiler-debug-fun
+			      debug-fun))
+	 (blocks (sb!c::compiled-debug-fun-blocks compiler-debug-fun))
 	 ;; KLUDGE: 8 is a hard-wired constant in the compiler for the
 	 ;; element size of the packed binary representation of the
 	 ;; blocks data.
 	 (live-set-len (ceiling var-count 8))
-	 (tlf-number (sb!c::compiled-debug-fun-tlf-number debug-fun)))
-    (unless blocks (return-from parse-compiled-debug-blocks nil))
+	 (tlf-number (sb!c::compiled-debug-fun-tlf-number compiler-debug-fun)))
+    (unless blocks
+      (return-from parse-compiled-debug-blocks nil))
     (macrolet ((aref+ (a i) `(prog1 (aref ,a ,i) (incf ,i))))
       (with-parsing-buffer (blocks-buffer locations-buffer)
 	(let ((i 0)
@@ -1710,7 +1711,7 @@
 				  0)))
 		       (svref blocks (1- end)))
 		      (t last))))
-		(declare (type sb!c::index i end))
+		(declare (type index i end))
 		(when (< pc
 			 (compiled-code-location-pc
 			  (svref (compiled-debug-block-code-locations
@@ -1889,7 +1890,7 @@
 
 ;;; Return the name of the function represented by DEBUG-FUN.
 ;;; This may be a string or a cons; do not assume it is a symbol.
-(defun debug-block-function-name (debug-block)
+(defun debug-block-fun-name (debug-block)
   (etypecase debug-block
     (compiled-debug-block
      (let ((code-locs (compiled-debug-block-code-locations debug-block)))
@@ -2546,8 +2547,8 @@
 ;;; this to determine if the value stored is the actual value or an
 ;;; indirection cell.
 (defun indirect-value-cell-p (x)
-  (and (= (get-lowtag x) sb!vm:other-pointer-lowtag)
-       (= (get-type x) sb!vm:value-cell-header-widetag)))
+  (and (= (lowtag-of x) sb!vm:other-pointer-lowtag)
+       (= (widetag-of x) sb!vm:value-cell-header-widetag)))
 
 ;;; Return three values reflecting the validity of DEBUG-VAR's value
 ;;; at BASIC-CODE-LOCATION:
@@ -2703,7 +2704,7 @@
 ;;; The returned function takes the frame to get values from as its
 ;;; argument, and it returns the values of FORM. The returned function
 ;;; can signal the following conditions: INVALID-VALUE,
-;;; AMBIGUOUS-VARIABLE-NAME, and FRAME-FUN-MISMATCH.
+;;; AMBIGUOUS-VAR-NAME, and FRAME-FUN-MISMATCH.
 (defun preprocess-for-eval (form loc)
   (declare (type code-location loc))
   (let ((n-frame (gensym))
@@ -2727,10 +2728,12 @@
 	    (:valid
 	     (specs `(,name (debug-var-value ',var ,n-frame))))
 	    (:unknown
-	     (specs `(,name (debug-signal 'invalid-value :debug-var ',var
+	     (specs `(,name (debug-signal 'invalid-value
+					  :debug-var ',var
 					  :frame ,n-frame))))
 	    (:ambiguous
-	     (specs `(,name (debug-signal 'ambiguous-variable-name :name ',name
+	     (specs `(,name (debug-signal 'ambiguous-var-name
+					  :name ',name
 					  :frame ,n-frame)))))))
       (let ((res (coerce `(lambda (,n-frame)
 			    (declare (ignorable ,n-frame))
@@ -2899,8 +2902,9 @@
     (do ((frame frame (frame-down frame)))
 	((not frame) nil)
       (when (and (compiled-frame-p frame)
-		 (eq lra
-		     (get-context-value frame lra-save-offset lra-sc-offset)))
+                 (#-x86 eq #+x86 sap=
+		  lra
+		  (get-context-value frame lra-save-offset lra-sc-offset)))
 	(return t)))))
 
 ;;;; ACTIVATE-BREAKPOINT