;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB-DEBUG")
+(in-package "SB-DEBUG") ; (SB-, not SB!, since we're built in warm load.)
;;; FIXME: Why, oh why, doesn't the SB-DEBUG package use the SB-DI
;;; package? That would let us get rid of a whole lot of stupid
;; list of null environment forms
(print-after () :type list))
-;;; This is a list of conses (function-end-cookie . condition-satisfied),
+;;; This is a list of conses (fun-end-cookie . condition-satisfied),
;;; which we use to note distinct dynamic entries into functions. When
;;; we enter a traced function, we add a entry to this list holding
;;; the new end-cookie and whether the trace condition was satisfied.
;;;
;;; This list also helps us synchronize the TRACE facility dynamically
;;; for detecting non-local flow of control. Whenever execution hits a
-;;; :FUNCTION-END breakpoint used for TRACE'ing, we look for the
-;;; FUNCTION-END-COOKIE at the top of *TRACED-ENTRIES*. If it is not
+;;; :FUN-END breakpoint used for TRACE'ing, we look for the
+;;; FUN-END-COOKIE at the top of *TRACED-ENTRIES*. If it is not
;;; there, we discard any entries that come before our cookie.
;;;
;;; When we trace using encapsulation, we bind this variable and add
(values (fdefinition x) t))))
(function x)
(t (values (fdefinition x) t)))
- (if (sb-eval:interpreted-function-p res)
- (values res named-p (if (sb-eval:interpreted-function-closure res)
- :interpreted-closure :interpreted))
- (case (sb-kernel:get-type res)
- (#.sb-vm:closure-header-type
- (values (sb-kernel:%closure-function res)
- named-p
- :compiled-closure))
- (#.sb-vm:funcallable-instance-header-type
- (values res named-p :funcallable-instance))
- (t (values res named-p :compiled))))))
+ (case (sb-kernel:get-type res)
+ (#.sb-vm:closure-header-type
+ (values (sb-kernel:%closure-function res)
+ named-p
+ :compiled-closure))
+ (#.sb-vm:funcallable-instance-header-type
+ (values res named-p :funcallable-instance))
+ (t (values res named-p :compiled)))))
;;; When a function name is redefined, and we were tracing that name,
;;; then untrace the old definition and trace the new one.
(when (and info (trace-info-named info))
(untrace-1 fname)
(trace-1 fname info new-value)))))
-(push #'trace-redefined-update sb-int:*setf-fdefinition-hook*)
+(push #'trace-redefined-update *setf-fdefinition-hook*)
;;; Annotate some forms to evaluate with pre-converted functions. Each
;;; form is really a cons (exp . function). Loc is the code location
(defun trace-wherein-p (frame names)
(do ((frame (sb-di:frame-down frame) (sb-di:frame-down frame)))
((not frame) nil)
- (when (member (sb-di:debug-function-name (sb-di:frame-debug-function
- frame))
+ (when (member (sb-di:debug-fun-name (sb-di:frame-debug-fun frame))
names
:test #'equal)
(return t))))
(when (or (null *traced-entries*)
(let ((cookie (caar *traced-entries*)))
(or (not cookie)
- (sb-di:function-end-cookie-valid-p frame cookie))))
+ (sb-di:fun-end-cookie-valid-p frame cookie))))
(return))
(pop *traced-entries*)))
\f
;;; Return a closure that can be used for a function start breakpoint
;;; hook function and a closure that can be used as the
-;;; FUNCTION-END-COOKIE function. The first communicates the sense of
+;;; FUN-END-COOKIE function. The first communicates the sense of
;;; the Condition to the second via a closure variable.
(defun trace-start-breakpoint-fun (info)
(let (conditionp)
(nth-value 2 (trace-fdefinition definition)))
(trace-fdefinition function-or-name))
(when (gethash fun *traced-functions*)
- ;; FIXME: should be STYLE-WARNING
- (warn "Function ~S is already TRACE'd, retracing it." function-or-name)
+ (warn "~S is already TRACE'd, untracing it." function-or-name)
(untrace-1 fun))
- (let* ((debug-fun (sb-di:function-debug-function fun))
+ (let* ((debug-fun (sb-di:fun-debug-fun fun))
(encapsulated
(if (eq (trace-info-encapsulated info) :default)
(ecase kind
(:compiled nil)
(:compiled-closure
(unless (functionp function-or-name)
- (warn "Tracing shared code for ~S:~% ~S"
+ (warn "tracing shared code for ~S:~% ~S"
function-or-name
fun))
nil)
(trace-info-encapsulated info)))
(loc (if encapsulated
:encapsulated
- (sb-di:debug-function-start-location debug-fun)))
+ (sb-di:debug-fun-start-location debug-fun)))
(info (make-trace-info
:what function-or-name
:named named
(unless named
(error "can't use encapsulation to trace anonymous function ~S"
fun))
- (sb-int:encapsulate function-or-name 'trace `(trace-call ',info)))
+ (encapsulate function-or-name 'trace `(trace-call ',info)))
(t
(multiple-value-bind (start-fun cookie-fun)
(trace-start-breakpoint-fun info)
(let ((start (sb-di:make-breakpoint start-fun debug-fun
- :kind :function-start))
+ :kind :fun-start))
(end (sb-di:make-breakpoint
(trace-end-breakpoint-fun info)
- debug-fun :kind :function-end
- :function-end-cookie cookie-fun)))
+ debug-fun :kind :fun-end
+ :fun-end-cookie cookie-fun)))
(setf (trace-info-start-breakpoint info) start)
(setf (trace-info-end-breakpoint info) end)
;; The next two forms must be in the order in which they
;; appear, since the start breakpoint must run before the
- ;; function-end breakpoint's start helper (which calls the
+ ;; fun-end breakpoint's start helper (which calls the
;; cookie function.) One reason is that cookie function
;; requires that the CONDITIONP shared closure variable be
;; initialized.
(t
(cond
((trace-info-encapsulated info)
- (sb-int:unencapsulate (trace-info-what info) 'trace))
+ (unencapsulate (trace-info-what info) 'trace))
(t
(sb-di:delete-breakpoint (trace-info-start-breakpoint info))
(sb-di:delete-breakpoint (trace-info-end-breakpoint info))))
projects / sbcl.git / blobdiff