+2001-06-29 Neil Jerram <neil@ossau.uklinux.net>
+
+ Changes to support tracing other than inside the repl-stack that
+ is set up by the REPL code in boot-9.scm.
+
+ * debug.scm (trace-entry, trace-exit): Conditionalize tracing on
+ whether the current stack id is in `traced-stack-ids'.
+ (traced-stack-ids, trace-all-stacks?, trace-stack, untrace-stack):
+ New.
+
2001-06-27 Marius Vollmer <mvo@zagadka.ping.de>
* common-list.scm (member-if): Put in docstring for member-if, it
(define trace-level 0)
(add-hook! abort-hook (lambda () (set! trace-level 0)))
+(define traced-stack-ids (list 'repl-stack))
+(define trace-all-stacks? #f)
+
+(define-public (trace-stack id)
+ "Add ID to the set of stack ids for which tracing is active.
+If `#t' is in this set, tracing is active regardless of stack context.
+To remove ID again, use `untrace-stack'. If you add the same ID twice
+using `trace-stack', you will need to remove it twice."
+ (set! traced-stack-ids (cons id traced-stack-ids))
+ (set! trace-all-stacks? (memq #t traced-stack-ids)))
+
+(define-public (untrace-stack id)
+ "Remove ID from the set of stack ids for which tracing is active."
+ (set! traced-stack-ids (delq1! id traced-stack-ids))
+ (set! trace-all-stacks? (memq #t traced-stack-ids)))
+
(define (trace-entry key cont tail)
- (if (eq? (stack-id cont) 'repl-stack)
+ (if (or trace-all-stacks?
+ (memq (stack-id cont) traced-stack-ids))
(let ((cep (current-error-port))
(frame (last-stack-frame cont)))
(if (not tail)
)
(define (trace-exit key cont retval)
- (if (eq? (stack-id cont) 'repl-stack)
+ (if (or trace-all-stacks?
+ (memq (stack-id cont) traced-stack-ids))
(let ((cep (current-error-port)))
(set! trace-level (- trace-level 1))
(let indent ((n trace-level))