guile/guile-core/ice-9 ChangeLog debug.scm

[Neil Jerram]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Neil Jerram <address@hidden>    01/06/29 08:36:47

Modified files:
        guile-core/ice-9: ChangeLog debug.scm 

Log message:
        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.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/ChangeLog.diff?cvsroot=OldCVS&tr1=1.457&tr2=1.458&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/debug.scm.diff?cvsroot=OldCVS&tr1=1.22&tr2=1.23&r1=text&r2=text

Patches:
Index: guile/guile-core/ice-9/ChangeLog
diff -u guile/guile-core/ice-9/ChangeLog:1.457 
guile/guile-core/ice-9/ChangeLog:1.458
--- guile/guile-core/ice-9/ChangeLog:1.457      Tue Jun 26 16:52:14 2001
+++ guile/guile-core/ice-9/ChangeLog    Fri Jun 29 08:36:47 2001
@@ -1,3 +1,13 @@
+2001-06-29  Neil Jerram  <address@hidden>
+
+       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  <address@hidden>
 
        * common-list.scm (member-if): Put in docstring for member-if, it
Index: guile/guile-core/ice-9/debug.scm
diff -u guile/guile-core/ice-9/debug.scm:1.22 
guile/guile-core/ice-9/debug.scm:1.23
--- guile/guile-core/ice-9/debug.scm:1.22       Tue Jun 26 14:55:45 2001
+++ guile/guile-core/ice-9/debug.scm    Fri Jun 29 08:36:47 2001
@@ -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))