"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 no usable debugging information available.")
- (:report (lambda (condition stream)
- (fresh-line stream)
- (format stream
- "no debug information available for ~S~%"
- (no-debug-info-code-component condition)))))
-
(define-condition no-debug-fun-returns (debug-condition)
((debug-fun :reader no-debug-fun-returns-debug-fun
:initarg :debug-fun))
(no-debug-fun-returns-debug-fun condition))))
(format stream
"~&Cannot return values from ~:[frame~;~:*~S~] since ~
- the debug information lacks details about returning ~
- values here."
+ the debug information lacks details about returning ~
+ values here."
fun)))))
(define-condition no-debug-blocks (debug-condition)
(#.lra-save-offset
(setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
-(defun foreign-function-debug-name (sap)
- (multiple-value-bind (name file base offset) (foreign-symbol-in-address sap)
+(defun foreign-function-backtrace-name (sap)
+ (let ((name (foreign-symbol-in-address sap)))
(if name
- (format nil "foreign function: ~A [~A: #x~X + #x~X]" name file base offset)
+ (format nil "foreign function: ~A" name)
(format nil "foreign function: #x~X" (sap-int sap)))))
;;; This returns a frame for the one existing in time immediately
"undefined function"))
(:foreign-function
(make-bogus-debug-fun
- (foreign-function-debug-name (int-sap (get-lisp-obj-address lra)))))
+ (foreign-function-backtrace-name
+ (int-sap (get-lisp-obj-address lra)))))
((nil)
(make-bogus-debug-fun
"bogus stack frame"))
(multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
(/noshow0 "at COND")
(cond (code
- (/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))
code (1+ real-lra-slot)))
(setq code (code-header-ref code real-lra-slot))
(aver code)))
- (t
- (/noshow0 "in T clause")
- ;; not escaped
+ ((not escaped)
(multiple-value-setq (pc-offset code)
(compute-lra-data-from-pc ra))
(unless code
(setf code :foreign-function
- pc-offset 0
- escaped nil))))
-
+ pc-offset 0))))
(let ((d-fun (case code
(:undefined-function
(make-bogus-debug-fun
"undefined function"))
(:foreign-function
- (make-bogus-debug-fun (foreign-function-debug-name ra)))
+ (make-bogus-debug-fun
+ (foreign-function-backtrace-name ra)))
((nil)
(make-bogus-debug-fun
"bogus stack frame"))
(defun debug-fun-from-pc (component pc)
(let ((info (%code-debug-info component)))
(cond
- ((not info)
- (debug-signal 'no-debug-info :code-component component))
+ ((not info)
+ ;; FIXME: It seems that most of these (at least on x86) are
+ ;; actually assembler routines, and could be named by looking
+ ;; at the sb-fasl:*assembler-routines*.
+ (make-bogus-debug-fun "no debug information for frame"))
((eq info :bogus-lra)
(make-bogus-debug-fun "function end breakpoint"))
(t
(zerop (logand val 3))
;; character
(and (zerop (logand val #xffff0000)) ; Top bits zero
- (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag
+ (= (logand val #xff) sb!vm:character-widetag)) ; char tag
;; unbound marker
(= val sb!vm:unbound-marker-widetag)
;; pointer
(sb!sys:without-gcing
(with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(with-escaped-value (val)
(code-char val)))
(#.sb!vm:sap-reg-sc-number
sb!vm:n-word-bytes)))))
(#.sb!vm:control-stack-sc-number
(sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(with-nfp (nfp)
(code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
sb!vm:n-word-bytes)))))
(without-gcing
(with-escaped-value (val)
(make-valid-lisp-obj val))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(with-escaped-value (val)
(code-char val)))
(#.sb!vm:sap-reg-sc-number
sb!vm:n-word-bytes)))))
(#.sb!vm:control-stack-sc-number
(stack-ref fp (sb!c:sc-offset-offset sc-offset)))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(code-char
(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes)))))
(without-gcing
(set-escaped-value
(get-lisp-obj-address value))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(set-escaped-value (char-code value)))
(#.sb!vm:sap-reg-sc-number
(set-escaped-value (sap-int value)))
(the long-float (realpart value)))))
(#.sb!vm:control-stack-sc-number
(setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
sb!vm:n-word-bytes))
(without-gcing
(set-escaped-value
(get-lisp-obj-address value))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(set-escaped-value (char-code value)))
(#.sb!vm:sap-reg-sc-number
(set-escaped-value (sap-int value)))
(imagpart (the (complex long-float) value))))
(#.sb!vm:control-stack-sc-number
(setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes)))
(char-code (the character value))))
(compiled-debug-fun-compiler-debug-fun what))
:standard)
(error ":FUN-END breakpoints are currently unsupported ~
- for the known return convention."))
+ for the known return convention."))
(let* ((bpt (%make-breakpoint hook-fun what kind info))
(starter (compiled-debug-fun-end-starter what)))
;;; instruction.
(defun make-bogus-lra (real-lra &optional known-return-p)
(without-gcing
+ ;; These are really code labels, not variables: but this way we get
+ ;; their addresses.
(let* ((src-start (foreign-symbol-address "fun_end_breakpoint_guts"))
(src-end (foreign-symbol-address "fun_end_breakpoint_end"))
(trap-loc (foreign-symbol-address "fun_end_breakpoint_trap"))
projects / sbcl.git / blobdiff