(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)))))
\f
;;;; errors and DEBUG-SIGNAL
(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)
(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
;; 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.
(%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))
(: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).
#!-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
#!+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
#!-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
#!+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
(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))))))))
;;; 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
(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
;;; 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)
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
;;; 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:
;;; 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))
(: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))
(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)))))
\f
;;;; ACTIVATE-BREAKPOINT
projects / sbcl.git / blobdiff