88 |
(define (debug-if-flag-set) |
(define (debug-if-flag-set) |
89 |
(if *debug-flag* |
(if *debug-flag* |
90 |
(begin |
(begin |
91 |
(for-each display (reverse! *debug-entry-messages*)) |
(for-each (lambda (msg) |
92 |
|
(display msg (debugger-output-port))) |
93 |
|
(reverse! *debug-entry-messages*)) |
94 |
(set! *debug-entry-messages* '()) |
(set! *debug-entry-messages* '()) |
95 |
(debug-stack (make-stack *cont*) #:continuable)))) |
(debug-stack (make-stack *cont*) #:continuable)))) |
96 |
|
|
101 |
(add-hook! after-exit-frame-hook |
(add-hook! after-exit-frame-hook |
102 |
(lambda () |
(lambda () |
103 |
(if *trace-retval* |
(if *trace-retval* |
104 |
(begin |
(with-output-to-port (debugger-output-port) |
105 |
(let indent ((td *trace-depths*)) |
(lambda () |
106 |
(cond ((null? td)) |
(let indent ((td *trace-depths*)) |
107 |
(else (display "| ") |
(cond ((null? td)) |
108 |
(indent (cdr td))))) |
(else (display "| ") |
109 |
(display "| ") |
(indent (cdr td))))) |
110 |
(write *retval*) |
(display "| ") |
111 |
(newline) |
(write *retval*) |
112 |
(set! *trace-retval* #f))) |
(newline) |
113 |
|
(set! *trace-retval* #f)))) |
114 |
(debug-if-flag-set))) |
(debug-if-flag-set))) |
115 |
|
|
116 |
(define (frame-depth frame) |
(define (frame-depth frame) |
253 |
(else (loop (+ frame-number 1))))))) |
(else (loop (+ frame-number 1))))))) |
254 |
(if push-current-depth |
(if push-current-depth |
255 |
(set! *trace-depths* (cons *depth* *trace-depths*))) |
(set! *trace-depths* (cons *depth* *trace-depths*))) |
256 |
(let indent ((td *trace-depths*)) |
(with-output-to-port (debugger-output-port) |
257 |
(cond ((null? td)) |
(lambda () |
258 |
(else |
(let indent ((td *trace-depths*)) |
259 |
(display "| ") |
(cond ((null? td)) |
260 |
(indent (cdr td))))) |
(else |
261 |
((if *expr* |
(display "| ") |
262 |
write-frame-short/expression |
(indent (cdr td))))) |
263 |
write-frame-short/application) *frame*) |
((if *expr* |
264 |
(newline) |
write-frame-short/expression |
265 |
|
write-frame-short/application) *frame*) |
266 |
|
(newline))) |
267 |
(if push-current-depth |
(if push-current-depth |
268 |
(at-exit (lambda () |
(at-exit (lambda () |
269 |
(set! *trace-depths* (cdr *trace-depths*)) |
(set! *trace-depths* (cdr *trace-depths*)) |