diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 917fa7b22..c496f8e91 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,13 @@ +2001-06-29 Neil Jerram + + 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 * common-list.scm (member-if): Put in docstring for member-if, it diff --git a/ice-9/debug.scm b/ice-9/debug.scm index d2fe61324..0c25e5c70 100644 --- a/ice-9/debug.scm +++ b/ice-9/debug.scm @@ -109,8 +109,25 @@ (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) @@ -125,7 +142,8 @@ ) (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))