"If the trace indentation exceeds this value, then indentation restarts at
0.")
-(defvar *trace-encapsulate-default* :default
+(defvar *trace-encapsulate-default* t
#+sb-doc
"the default value for the :ENCAPSULATE option to TRACE")
\f
;;;; internal state
;;; a hash table that maps each traced function to the TRACE-INFO. The
-;;; entry for a closure is the shared function-entry object.
+;;; entry for a closure is the shared function entry object.
(defvar *traced-funs* (make-hash-table :test 'eq))
;;; A TRACE-INFO object represents all the information we need to
(let ((exp (car form)))
(if (sb-di:code-location-p loc)
(let ((fun (sb-di:preprocess-for-eval exp loc)))
+ (declare (type function fun))
(cons exp
(lambda (frame)
(let ((*current-frame* frame))
((nil) exp)
(:encapsulated
`(flet ((sb-debug:arg (n)
- (declare (special argument-list))
- (elt argument-list n)))
+ (declare (special arg-list))
+ (elt arg-list n)))
(declare (ignorable #'sb-debug:arg))
,exp))))
(fun (coerce `(lambda () ,bod) 'function)))
(dolist (entry *traced-entries*)
(when (cdr entry) (incf depth)))
(format t
- "~@V,0T~W: "
+ "~V,0@T~W: "
(+ (mod (* depth *trace-indentation-step*)
(- *max-trace-indentation* *trace-indentation-step*))
*trace-indentation-step*)
(or (not wherein)
(trace-wherein-p frame wherein)))))
(when conditionp
- (let ((sb-kernel:*current-level* 0)
+ (let ((sb-kernel:*current-level-in-print* 0)
(*standard-output* *trace-output*)
(*in-trace* t))
(fresh-line)
(print-trace-indentation)
(if (trace-info-encapsulated info)
- (locally (declare (special basic-definition argument-list))
- (prin1 `(,(trace-info-what info) ,@argument-list)))
+ ;; FIXME: These special variables should be given
+ ;; *FOO*-style names, and probably declared globally
+ ;; with DEFVAR.
+ (locally
+ (declare (special basic-definition arg-list))
+ (prin1 `(,(trace-info-what info) ,@arg-list)))
(print-frame-call frame))
(terpri)
(trace-print frame (trace-info-print info)))
;;; to determine the correct indentation for output. We then check to
;;; see whether the function is still traced and that the condition
;;; succeeded before printing anything.
+(declaim (ftype (function (trace-info) function) trace-end-breakpoint-fun))
(defun trace-end-breakpoint-fun (info)
(lambda (frame bpt *trace-values* cookie)
(declare (ignore bpt))
(or (cdr entry)
(let ((cond (trace-info-condition-after info)))
(and cond (funcall (cdr cond) frame)))))
- (let ((sb-kernel:*current-level* 0)
+ (let ((sb-kernel:*current-level-in-print* 0)
(*standard-output* *trace-output*)
(*in-trace* t))
(fresh-line)
;;; which we have cleverly contrived to work for our hook functions.
(defun trace-call (info)
(multiple-value-bind (start cookie) (trace-start-breakpoint-fun info)
+ (declare (type function start cookie))
(let ((frame (sb-di:frame-down (sb-di:top-frame))))
(funcall start frame nil)
(let ((*traced-entries* *traced-entries*))
- (declare (special basic-definition argument-list))
+ (declare (special basic-definition arg-list))
(funcall cookie frame nil)
(let ((vals
(multiple-value-list
- (apply basic-definition argument-list))))
+ (apply basic-definition arg-list))))
(funcall (trace-end-breakpoint-fun info) frame nil vals nil)
(values-list vals))))))
\f