(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)
(print-unreadable-object (debug-var stream :type t :identity t)
(format stream
- "~S ~D"
+ "~S ~W"
(debug-var-symbol debug-var)
(debug-var-id debug-var))))
(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.
;; out and just find it in the blocks cache in DEBUG-FUN.
(%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)))
+ ;; before the top level form containing this code-location.
+ (%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))))
+ ;; code-location within its top level form.
+ (%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).
\f
;;;; DEBUG-SOURCEs
-;;; Return the number of top-level forms processed by the compiler
+;;; Return the number of top level forms processed by the compiler
;;; before compiling this source. If this source is uncompiled, this
;;; is zero. This may be zero even if the source is compiled since the
;;; first form in the first file compiled in one compilation, for
;;; example, must have a root number of zero -- the compiler saw no
-;;; other top-level forms before it.
+;;; other top level forms before it.
(defun debug-source-root-number (debug-source)
(sb!c::debug-source-source-root debug-source))
\f
;;; Return the top frame of the control stack as it was before calling
;;; this function.
(defun top-frame ()
- (/show0 "entering TOP-FRAME")
+ (/noshow0 "entering TOP-FRAME")
(multiple-value-bind (fp pc) (%caller-frame-and-pc)
(compute-calling-frame (descriptor-sap fp) pc nil)))
;;; Return the frame immediately below FRAME on the stack; or when
;;; FRAME is the bottom of the stack, return NIL.
(defun frame-down (frame)
- (/show0 "entering FRAME-DOWN")
+ (/noshow0 "entering FRAME-DOWN")
;; We have to access the old-fp and return-pc out of frame and pass
;; them to COMPUTE-CALLING-FRAME.
(let ((down (frame-%down frame)))
(if (eq down :unparsed)
(let ((debug-fun (frame-debug-fun frame)))
- (/show0 "in DOWN :UNPARSED case")
+ (/noshow0 "in DOWN :UNPARSED case")
(setf (frame-%down frame)
(etypecase debug-fun
(compiled-debug-fun
#!-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
;;; This returns a frame for the one existing in time immediately
;;; prior to the frame referenced by current-fp. This is current-fp's
;;; caller or the next frame down the control stack. If there is no
-;;; down frame, this returns nil for the bottom of the stack. Up-frame
-;;; is the up link for the resulting frame object, and it is nil when
+;;; down frame, this returns NIL for the bottom of the stack. UP-FRAME
+;;; is the up link for the resulting frame object, and it is null when
;;; we call this to get the top of the stack.
;;;
;;; The current frame contains the pointer to the temporally previous
escaped)
(if up-frame (1+ (frame-number up-frame)) 0)
escaped))))))
-
#!+x86
(defun compute-calling-frame (caller ra up-frame)
(declare (type system-area-pointer caller ra))
- (/show0 "entering COMPUTE-CALLING-FRAME")
+ (/noshow0 "entering COMPUTE-CALLING-FRAME")
(when (cstack-pointer-valid-p caller)
- (/show0 "in WHEN")
+ (/noshow0 "in WHEN")
;; First check for an escaped frame.
(multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
- (/show0 "at COND")
+ (/noshow0 "at COND")
(cond (code
- (/show0 "in CODE clause")
+ (/noshow0 "in CODE clause")
;; If it's escaped it may be a function end breakpoint trap.
(when (and (code-component-p code)
(eq (%code-debug-info code) :bogus-lra))
(setq code (code-header-ref code real-lra-slot))
(aver code)))
(t
- (/show0 "in T clause")
+ (/noshow0 "in T clause")
;; not escaped
(multiple-value-setq (pc-offset code)
(compute-lra-data-from-pc ra))
"bogus stack frame"))
(t
(debug-fun-from-pc code pc-offset)))))
- (/show0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
+ (/noshow0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
(make-compiled-frame caller up-frame d-fun
(code-location-from-pc d-fun pc-offset
escaped)
#!+x86
(defun find-escaped-frame (frame-pointer)
(declare (type system-area-pointer frame-pointer))
- (/show0 "entering FIND-ESCAPED-FRAME")
+ (/noshow0 "entering FIND-ESCAPED-FRAME")
(dotimes (index *free-interrupt-context-index* (values nil 0 nil))
(sb!alien:with-alien
((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
- (/show0 "at head of WITH-ALIEN")
+ (/noshow0 "at head of WITH-ALIEN")
(let ((context (sb!alien:deref lisp-interrupt-contexts index)))
- (/show0 "got CONTEXT")
+ (/noshow0 "got CONTEXT")
(when (= (sap-int frame-pointer)
(sb!vm:context-register context sb!vm::cfp-offset))
(without-gcing
- (/show0 "in WITHOUT-GCING")
+ (/noshow0 "in WITHOUT-GCING")
(let* ((component-ptr (component-ptr-from-pc
(sb!vm:context-pc context)))
(code (unless (sap= component-ptr (int-sap #x0))
(component-from-component-ptr component-ptr))))
- (/show0 "got CODE")
+ (/noshow0 "got CODE")
(when (null code)
(return (values code 0 context)))
(let* ((code-header-len (* (get-header-data code)
(- (get-lisp-obj-address code)
sb!vm:other-pointer-lowtag)
code-header-len)))
- (/show "got PC-OFFSET")
+ (/noshow "got PC-OFFSET")
(unless (<= 0 pc-offset
(* (code-header-ref code sb!vm:code-code-size-slot)
sb!vm:n-word-bytes))
;; FIXME: Should this be WARN or ERROR or what?
(format t "** pc-offset ~S not in code obj ~S?~%"
pc-offset code))
- (/show0 "returning from FIND-ESCAPED-FRAME")
+ (/noshow0 "returning from FIND-ESCAPED-FRAME")
(return
(values code pc-offset context))))))))))
(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))))))))
;;; CODE-LOCATIONs at which execution would continue with frame as the
;;; top frame if someone threw to the corresponding tag.
(defun frame-catches (frame)
- (let ((catch (descriptor-sap *current-catch-block*))
- (res nil)
+ (let ((catch (descriptor-sap sb!vm:*current-catch-block*))
+ (reversed-result nil)
(fp (frame-pointer frame)))
- (loop
- (when (zerop (sap-int catch)) (return (nreverse res)))
- (when (sap= fp
- #!-alpha
- (sap-ref-sap catch
- (* sb!vm:catch-block-current-cont-slot
- sb!vm:n-word-bytes))
- #!+alpha
- (:int-sap
- (sap-ref-32 catch
- (* sb!vm:catch-block-current-cont-slot
- sb!vm:n-word-bytes))))
- (let* (#!-x86
- (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
- #!+x86
- (ra (sap-ref-sap
- catch (* sb!vm:catch-block-entry-pc-slot
- sb!vm:n-word-bytes)))
- #!-x86
- (component
- (stack-ref catch sb!vm:catch-block-current-code-slot))
- #!+x86
- (component (component-from-component-ptr
- (component-ptr-from-pc ra)))
- (offset
- #!-x86
- (* (- (1+ (get-header-data lra))
- (get-header-data component))
- sb!vm:n-word-bytes)
- #!+x86
- (- (sap-int ra)
- (- (get-lisp-obj-address component)
- sb!vm:other-pointer-lowtag)
- (* (get-header-data component) sb!vm:n-word-bytes))))
- (push (cons #!-x86
- (stack-ref catch sb!vm:catch-block-tag-slot)
- #!+x86
- (make-lisp-obj
- (sap-ref-32 catch (* sb!vm:catch-block-tag-slot
- sb!vm:n-word-bytes)))
- (make-compiled-code-location
- offset (frame-debug-fun frame)))
- res)))
- (setf catch
- #!-alpha
- (sap-ref-sap catch
- (* sb!vm:catch-block-previous-catch-slot
- sb!vm:n-word-bytes))
- #!+alpha
- (:int-sap
- (sap-ref-32 catch
- (* sb!vm:catch-block-previous-catch-slot
- sb!vm:n-word-bytes)))))))
+ (loop until (zerop (sap-int catch))
+ finally (return (nreverse reversed-result))
+ do
+ (when (sap= fp
+ #!-alpha
+ (sap-ref-sap catch
+ (* sb!vm:catch-block-current-cont-slot
+ sb!vm:n-word-bytes))
+ #!+alpha
+ (int-sap
+ (sap-ref-32 catch
+ (* sb!vm:catch-block-current-cont-slot
+ sb!vm:n-word-bytes))))
+ (let* (#!-x86
+ (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
+ #!+x86
+ (ra (sap-ref-sap
+ catch (* sb!vm:catch-block-entry-pc-slot
+ sb!vm:n-word-bytes)))
+ #!-x86
+ (component
+ (stack-ref catch sb!vm:catch-block-current-code-slot))
+ #!+x86
+ (component (component-from-component-ptr
+ (component-ptr-from-pc ra)))
+ (offset
+ #!-x86
+ (* (- (1+ (get-header-data lra))
+ (get-header-data component))
+ sb!vm:n-word-bytes)
+ #!+x86
+ (- (sap-int ra)
+ (- (get-lisp-obj-address component)
+ sb!vm:other-pointer-lowtag)
+ (* (get-header-data component) sb!vm:n-word-bytes))))
+ (push (cons #!-x86
+ (stack-ref catch sb!vm:catch-block-tag-slot)
+ #!+x86
+ (make-lisp-obj
+ (sap-ref-32 catch (* sb!vm:catch-block-tag-slot
+ sb!vm:n-word-bytes)))
+ (make-compiled-code-location
+ offset (frame-debug-fun frame)))
+ reversed-result)))
+ (setf catch
+ #!-alpha
+ (sap-ref-sap catch
+ (* sb!vm:catch-block-previous-catch-slot
+ sb!vm:n-word-bytes))
+ #!+alpha
+ (int-sap
+ (sap-ref-32 catch
+ (* sb!vm:catch-block-previous-catch-slot
+ sb!vm:n-word-bytes)))))))
\f
;;;; operations on DEBUG-FUNs
;;; 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
sb!vm:n-word-bytes)))))))
;;; Return the kind of the function, which is one of :OPTIONAL,
-;;; :EXTERNAL, TOP-level, :CLEANUP, or NIL.
+;;; :EXTERNAL, :TOPLEVEL, :CLEANUP, or NIL.
(defun debug-fun-kind (debug-fun)
;; FIXME: This "is one of" information should become part of the function
;; declamation, not just a doc string
(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)
(defun assign-minimal-var-names (vars)
(declare (simple-vector vars))
(let* ((len (length vars))
- (width (length (format nil "~D" (1- len)))))
+ (width (length (format nil "~W" (1- len)))))
(dotimes (i len)
(setf (compiled-debug-var-symbol (svref vars i))
(intern (format nil "ARG-~V,'0D" width i)
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
(car sources)
(do ((prev sources src)
(src (cdr sources) (cdr src))
- (offset (code-location-top-level-form-offset code-location)))
+ (offset (code-location-toplevel-form-offset code-location)))
((null src) (car prev))
(when (< offset (sb!c::debug-source-source-root (car src)))
(return (car prev)))))))
;; did special tricks to debug the IR1 interpreter.)
))
-;;; Returns the number of top-level forms before the one containing
+;;; Returns the number of top level forms before the one containing
;;; CODE-LOCATION as seen by the compiler in some compilation unit. (A
;;; compilation unit is not necessarily a single file, see the section
;;; on debug-sources.)
-(defun code-location-top-level-form-offset (code-location)
+(defun code-location-toplevel-form-offset (code-location)
(when (code-location-unknown-p code-location)
(error 'unknown-code-location :code-location code-location))
(let ((tlf-offset (code-location-%tlf-offset code-location)))
(t tlf-offset))))
;;; Return the number of the form corresponding to CODE-LOCATION. The
-;;; form number is derived by a walking the subforms of a top-level
+;;; form number is derived by a walking the subforms of a top level
;;; form in depth-first order.
(defun code-location-form-number (code-location)
(when (code-location-unknown-p code-location)
;;; GC, and might also arise in debug variable locations when
;;; those variables are invalid.)
(defun make-valid-lisp-obj (val)
- (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")
- #!+sb-show (/hexstr val)
(if (or
;; fixnum
(zerop (logand val 3))
#!+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=..")
- (/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=..")
- (/hexstr ,var)
,@forms)
:invalid-value-for-unescaped-register-storage))
(escaped-float-value (format)
:invalid-value-for-unescaped-register-storage)))
(ecase (sb!c:sc-offset-scn sc-offset)
((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)
- (/show0 "case of ANY-REG-SC-NUMBER or DESCRIPTOR-REG-SC-NUMBER")
(without-gcing
(with-escaped-value (val)
- (/show0 "VAL=..")
- (/hexstr val)
(make-valid-lisp-obj val))))
(#.sb!vm:base-char-reg-sc-number
- (/show0 "case of BASE-CHAR-REG-SC-NUMBER")
(with-escaped-value (val)
(code-char val)))
(#.sb!vm:sap-reg-sc-number
- (/show0 "case of SAP-REG-SC-NUMBER")
(with-escaped-value (val)
(int-sap val)))
(#.sb!vm:signed-reg-sc-number
- (/show0 "case of SIGNED-REG-SC-NUMBER")
(with-escaped-value (val)
(if (logbitp (1- sb!vm:n-word-bits) val)
(logior val (ash -1 sb!vm:n-word-bits))
val)))
(#.sb!vm:unsigned-reg-sc-number
- (/show0 "case of UNSIGNED-REG-SC-NUMBER")
(with-escaped-value (val)
val))
(#.sb!vm:single-reg-sc-number
- (/show0 "case of SINGLE-REG-SC-NUMBER")
(escaped-float-value single-float))
(#.sb!vm:double-reg-sc-number
- (/show0 "case of DOUBLE-REG-SC-NUMBER")
(escaped-float-value double-float))
#!+long-float
(#.sb!vm:long-reg-sc-number
- (/show0 "case of LONG-REG-SC-NUMBER")
(escaped-float-value long-float))
(#.sb!vm:complex-single-reg-sc-number
- (/show0 "case of COMPLEX-SINGLE-REG-SC-NUMBER")
(escaped-complex-float-value single-float))
(#.sb!vm:complex-double-reg-sc-number
- (/show0 "case of COMPLEX-DOUBLE-REG-SC-NUMBER")
(escaped-complex-float-value double-float))
#!+long-float
(#.sb!vm:complex-long-reg-sc-number
- (/show0 "case of COMPLEX-LONG-REG-SC-NUMBER")
(escaped-complex-float-value long-float))
(#.sb!vm:single-stack-sc-number
- (/show0 "case of SINGLE-STACK-SC-NUMBER")
(sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes))))
(#.sb!vm:double-stack-sc-number
- (/show0 "case of DOUBLE-STACK-SC-NUMBER")
(sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
sb!vm:n-word-bytes))))
#!+long-float
(#.sb!vm:long-stack-sc-number
- (/show0 "case of LONG-STACK-SC-NUMBER")
(sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
sb!vm:n-word-bytes))))
(#.sb!vm:complex-single-stack-sc-number
- (/show0 "case of COMPLEX-STACK-SC-NUMBER")
(complex
(sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes)))
(sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
sb!vm:n-word-bytes)))))
(#.sb!vm:complex-double-stack-sc-number
- (/show0 "case of COMPLEX-DOUBLE-STACK-SC-NUMBER")
(complex
(sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
sb!vm:n-word-bytes)))
sb!vm:n-word-bytes)))))
#!+long-float
(#.sb!vm:complex-long-stack-sc-number
- (/show0 "case of COMPLEX-LONG-STACK-SC-NUMBER")
(complex
(sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
sb!vm:n-word-bytes)))
(sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
sb!vm:n-word-bytes)))))
(#.sb!vm:control-stack-sc-number
- (/show0 "case of CONTROL-STACK-SC-NUMBER")
(stack-ref fp (sb!c:sc-offset-offset sc-offset)))
(#.sb!vm:base-char-stack-sc-number
- (/show0 "case of BASE-CHAR-STACK-SC-NUMBER")
(code-char
(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes)))))
(#.sb!vm:unsigned-stack-sc-number
- (/show0 "case of UNSIGNED-STACK-SC-NUMBER")
(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes))))
(#.sb!vm:signed-stack-sc-number
- (/show0 "case of SIGNED-STACK-SC-NUMBER")
(signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes))))
(#.sb!vm:sap-stack-sc-number
- (/show0 "case of SAP-STACK-SC-NUMBER")
(sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes)))))))
;;; 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:
;;; This code produces and uses what we call source-paths. A
;;; source-path is a list whose first element is a form number as
;;; returned by CODE-LOCATION-FORM-NUMBER and whose last element is a
-;;; top-level-form number as returned by
-;;; CODE-LOCATION-TOP-LEVEL-FORM-NUMBER. The elements from the last to
+;;; top level form number as returned by
+;;; CODE-LOCATION-TOPLEVEL-FORM-NUMBER. The elements from the last to
;;; the first, exclusively, are the numbered subforms into which to
;;; descend. For example:
;;; (defun foo (x)
;;; (let ((a (aref x 3)))
;;; (cons a 3)))
;;; The call to AREF in this example is form number 5. Assuming this
-;;; DEFUN is the 11'th top-level-form, the source-path for the AREF
+;;; DEFUN is the 11'th top level form, the source-path for the AREF
;;; call is as follows:
;;; (5 1 0 1 3 11)
;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
;;; 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.
+;;; This returns a table mapping form numbers to source-paths. A
+;;; source-path indicates a descent into the TOPLEVEL-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-SOURCE-PATH; that is, the first element is the form number and
-;;; the last is the top-level-form number.
+;;; the last is the TOPLEVEL-FORM number.
(defun form-number-translations (form tlf-number)
(clrhash *form-number-circularity-table*)
(setf (fill-pointer *form-number-temp*) 0)
(frob)
(setq trail (cdr trail)))))))
-;;; FORM is a top-level form, and path is a source-path into it. This
+;;; 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
;;; 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
;;;; breakpoint handlers (layer between C and exported interface)
-;;; This maps components to a mapping of offsets to breakpoint-datas.
+;;; This maps components to a mapping of offsets to BREAKPOINT-DATAs.
(defvar *component-breakpoint-offsets* (make-hash-table :test 'eq))
-;;; This returns the breakpoint-data associated with component cross
+;;; This returns the BREAKPOINT-DATA object associated with component cross
;;; offset. If none exists, this makes one, installs it, and returns it.
(defun breakpoint-data (component offset &optional (create t))
(flet ((install-breakpoint-data ()
(install-breakpoint-data)))))
;;; We use this when there are no longer any active breakpoints
-;;; corresponding to data.
+;;; corresponding to DATA.
(defun delete-breakpoint-data (data)
(let* ((component (breakpoint-data-component data))
(offsets (delete (breakpoint-data-offset data)
(values))
;;; The C handler for interrupts calls this when it has a
-;;; debugging-tool break instruction. This does NOT handle all breaks;
-;;; for example, it does not handle breaks for internal errors.
+;;; 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"
;;; This handles code-location and DEBUG-FUN :FUN-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*)
bpt)))))
(defun handle-fun-end-breakpoint (offset component context)
- (/show0 "entering HANDLE-FUN-END-BREAKPOINT")
(let ((data (breakpoint-data component offset nil)))
(unless data
(error "unknown breakpoint in ~S at offset ~S"
;;; [old C code] or HANDLE-FUN-END-BREAKPOINT calls this directly
;;; [new C code].
(defun handle-fun-end-breakpoint-aux (breakpoints data signal-context)
- (/show0 "entering HANDLE-FUN-END-BREAKPOINT-AUX")
(delete-breakpoint-data data)
(let* ((scp
(locally
(do-debug-fun-blocks (block debug-fun)
(do-debug-block-locations (loc block)
(fill-in-code-location loc)
- (format t "~S code location at ~D"
+ (format t "~S code location at ~W"
(compiled-code-location-kind loc)
(compiled-code-location-pc loc))
(sb!debug::print-code-location-source-form loc 0)
projects / sbcl.git / blobdiff