mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 23:00:22 +02:00
Code Activity

Changes to support tracing other than inside the repl-stack that

Browse source 
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.
This commit is contained in:
Neil Jerram 2001-06-29 15:36:47 +00:00
parent e235f2a6c7
commit 941614c6aa
2 changed files with 30 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

10
ice-9/ChangeLog
View file

@ -1,3 +1,13 @@
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> 2001-06-27 Marius Vollmer <mvo@zagadka.ping.de>
* common-list.scm (member-if): Put in docstring for member-if, it * common-list.scm (member-if): Put in docstring for member-if, it

22
ice-9/debug.scm
View file

@ -109,8 +109,25 @@
(define trace-level 0) (define trace-level 0)
(add-hook! abort-hook (lambda () (set! 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) (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)) (let ((cep (current-error-port))
(frame (last-stack-frame cont))) (frame (last-stack-frame cont)))
(if (not tail) (if (not tail)
@ -125,7 +142,8 @@
) )
(define (trace-exit key cont retval) (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))) (let ((cep (current-error-port)))
(set! trace-level (- trace-level 1)) (set! trace-level (- trace-level 1))
(let indent ((n trace-level)) (let indent ((n trace-level))