* debug.scm (trace-entry, trace-exit): Check that we're on a repl

stack before printing traced frames; Re-enable trace flag at end
of handlers.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index aa81565..ce8dc7f 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,9 @@
+Sat Mar  1 15:24:39 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
+
+       * debug.scm (trace-entry, trace-exit): Check that we're on a repl
+       stack before printing traced frames; Re-enable trace flag at end
+       of handlers.
+
 Sat Mar  1 00:10:38 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
 
        * debug.scm: Add hook for reset of trace level at abort.

diff --git a/ice-9/debug.scm b/ice-9/debug.scm
index 6d3f043..18dfe61 100644 (file)
--- a/ice-9/debug.scm
+++ b/ice-9/debug.scm
@@ -111,15 +111,12 @@
 (define-all)
 
 \f
-
-;;; A fix to get the error handling working together with the module system.
-;;;
-(variable-set! (builtin-variable 'debug-options) debug-options)
-
-\f
-
 ;;; {Trace}
 ;;;
+;;; This code is just an experimental prototype (e. g., it is not
+;;; thread safe), but since it's at the same time useful, it's
+;;; included anyway.
+;;;
 (define traced-procedures '())
 
 (define-public (trace . args)
@@ -161,42 +158,30 @@
 (add-hook! abort-hook (lambda () (set! trace-level 0)))
 
 (define (trace-entry key cont tail)
-  (dynamic-wind
-   (lambda ()
-     ;; We have to protect ourselves against the case that the user
-     ;; has chosen to trace a procedure used in the trace handler.
-     ;; Note that debug-disable is a very slow operation.
-     ;; This is not an ideal solution. *fixme*
-     (debug-disable 'trace))
-   (lambda ()
-     (let ((cep (current-error-port))
-          (frame (last-stack-frame cont)))
-       (if (not tail)
-          (set! trace-level (+ trace-level 1)))
-       (let indent ((n trace-level))
-        (cond ((> n 1) (display "|  " cep) (indent (- n 1)))))
-       (display-application frame cep)
-       (newline cep)
-       ;; It's not necessary to call the continuation since
-       ;; execution will continue if the handler returns
-       ;(cont #f)
-       ))
-   (lambda ()
-     (debug-enable 'trace))))
+  (if (eq? (stack-id cont) 'repl-stack)
+      (let ((cep (current-error-port))
+           (frame (last-stack-frame cont)))
+       (if (not tail)
+           (set! trace-level (+ trace-level 1)))
+       (let indent ((n trace-level))
+         (cond ((> n 1) (display "|  " cep) (indent (- n 1)))))
+       (display-application frame cep)
+       (newline cep)))
+  (debug-enable 'trace)
+  ;; It's not necessary to call the continuation since
+  ;; execution will continue if the handler returns
+  ;(cont #f)
+  )
 
 (define (trace-exit key cont retval)
-  (dynamic-wind
-   (lambda ()
-     (debug-disable 'trace))
-   (lambda ()
-     (let ((cep (current-error-port)))
-       (set! trace-level (- trace-level 1))
-       (let indent ((n trace-level))
-        (cond ((> n 0) (display "|  " cep) (indent (- n 1)))))
-       (write retval cep)
-       (newline cep)))
-   (lambda ()
-     (debug-enable 'trace))))
+  (if (eq? (stack-id cont) 'repl-stack)
+      (let ((cep (current-error-port)))
+       (set! trace-level (- trace-level 1))
+       (let indent ((n trace-level))
+         (cond ((> n 0) (display "|  " cep) (indent (- n 1)))))
+       (write retval cep)
+       (newline cep)))
+  (debug-enable 'trace))
 
 (define (display-application frame port)
   (display #\[ port)
@@ -210,6 +195,11 @@
   (display #\] port))
 
 \f
+;;; A fix to get the error handling working together with the module system.
+;;;
+(variable-set! (builtin-variable 'debug-options) debug-options)
+
+\f
 
 (debug-enable 'debug)
 (read-enable 'positions)