suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

svn: r140

Browse Source
This commit is contained in:
Jono Spiro 2004-08-05 02:32:02 +00:00
parent 1b23b100bc
commit 942edb0d85
2 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mztake/debugger-model.ss
View File

@ -15,15 +15,11 @@
process) process)
(export run) (export run)
(define run-semaphore (debug-process-run-semaphore process)) (define run-semaphore (debug-process-run-semaphore process))
(define ev (make-eventspace))
(define ((break client) mark-set kind final-mark) (define ((break client) mark-set kind final-mark)
(let ([mark-list (continuation-mark-set->list mark-set debug-key)]) (let ([mark-list (continuation-mark-set->list mark-set debug-key)])
(parameterize ([current-eventspace ev]) (receive-result (make-normal-breakpoint-info (cons final-mark mark-list) client))
(queue-callback (lambda () (receive-result (make-normal-breakpoint-info (cons final-mark mark-list) client)))))
(semaphore-wait run-semaphore))) (semaphore-wait run-semaphore)))

10
collects/mztake/mztake.ss
View File

@ -157,6 +157,11 @@ TESTING/CAPABILITIES------------------------------------------------------------
; Callback for when a breakpoint (tracepoint) is hit by the model ; Callback for when a breakpoint (tracepoint) is hit by the model
; ((client) breakpoint-struct) -> () ; ((client) breakpoint-struct) -> ()
(define ((receive-result process) result) (define ((receive-result process) result)
; Before we process the trace, see if we are supposed to pause
(unless (running-now? process)
(semaphore-wait (debug-process-run-semaphore process)))
(match result (match result
; regular breakpoint ; regular breakpoint
[($ normal-breakpoint-info (top-mark rest-mark ...) client) [($ normal-breakpoint-info (top-mark rest-mark ...) client)
@ -170,11 +175,11 @@ TESTING/CAPABILITIES------------------------------------------------------------
; Run all traces at this breakpoint ; Run all traces at this breakpoint
(let ([to-send (map (lambda (t) (trace->frp-event client result t)) traces)]) (let ([to-send (map (lambda (t) (trace->frp-event client result t)) traces)])
(frp:send-synchronous-events to-send)) (frp:send-synchronous-events to-send))
; do we want to pause interactive debugging
; Now that we processed the trace, do we want to pause or continue
(when (running-now? process) (when (running-now? process)
(semaphore-post (debug-process-run-semaphore process))))] (semaphore-post (debug-process-run-semaphore process))))]
;TODO eventually remove this from debugger-model.ss
[($ error-breakpoint-info (source exn)) [($ error-breakpoint-info (source exn))
; all errors and raises from the TARGET program will be caught here ; all errors and raises from the TARGET program will be caught here
; FrTime errors from the script have their own eventstream ; FrTime errors from the script have their own eventstream
@ -462,7 +467,6 @@ TESTING/CAPABILITIES------------------------------------------------------------
(define (runtime/milliseconds process) (define (runtime/milliseconds process)
(debug-process-runtime process)) (debug-process-runtime process))
;TODO dont forget to contract this
(define (runtime/seconds process) (define (runtime/seconds process)
(frp:hold ((frp:changes (debug-process-runtime process)) (frp:hold ((frp:changes (debug-process-runtime process))
. frp:==> . . frp:==> .