improved speed (eventspaces are the only things causing lots of garbage -- but using new threads garbage collects more often -- making synchronous calls to receive-results is fastest, but you lost control of the anim window)
demos are all working I have *not* fixed the problem with the mredkernel when require/annotations yet svn: r119
This commit is contained in:
Jono Spiro
parent
25b2b3cb44
commit
f7b735a997
|
|
@ -10,33 +10,26 @@
|
|||
|
||||
(provide debugger-model@)
|
||||
|
||||
(define (send-to-eventspace eventspace thunk)
|
||||
(parameterize ([current-eventspace eventspace])
|
||||
(queue-callback thunk)))
|
||||
|
||||
(define debugger-model@
|
||||
(unit
|
||||
(import receive-result
|
||||
process)
|
||||
(export run)
|
||||
|
||||
|
||||
(define run-semaphore (debug-process-run-semaphore process))
|
||||
(define debug-eventspace (debug-process-eventspace process))
|
||||
(define ev (make-eventspace))
|
||||
|
||||
(define (queue-result result)
|
||||
(send-to-eventspace debug-eventspace
|
||||
(lambda () (receive-result result))))
|
||||
|
||||
(define basic-eval (current-eval))
|
||||
|
||||
(define ((break client) mark-set kind final-mark)
|
||||
(let ([mark-list (continuation-mark-set->list mark-set debug-key)])
|
||||
(queue-result (make-normal-breakpoint-info (cons final-mark mark-list) client))
|
||||
(queue-result (make-breakpoint-halt))
|
||||
(parameterize ([current-eventspace ev])
|
||||
(queue-callback (lambda () (receive-result (make-normal-breakpoint-info (cons final-mark mark-list) client)))))
|
||||
(semaphore-wait run-semaphore)))
|
||||
|
||||
|
||||
(define ((err-display-handler source) message exn)
|
||||
(queue-result (make-error-breakpoint-info (list source exn))))
|
||||
(thread (lambda () (receive-result (make-error-breakpoint-info (list source exn))))))
|
||||
|
||||
|
||||
(define (annotate-module-with-error-handler stx err-hndlr)
|
||||
|
|
@ -75,5 +68,7 @@
|
|||
[_ (print "hack -- main-mod problem")]
|
||||
[main-mod (first all-used-module-paths)])
|
||||
|
||||
(parameterize ([error-display-handler (err-display-handler (format "Loading module ~a..." main-mod))])
|
||||
(require/annotations `(file ,main-mod) annotate-module? annotator))))))))
|
||||
(parameterize ([current-custodian (debug-process-custodian process)]
|
||||
[current-namespace (make-namespace)]
|
||||
[error-display-handler (err-display-handler (format "Loading module ~a..." main-mod))])
|
||||
(require/annotations `(file ,main-mod) annotate-module? annotator))))))))
|
||||
3
collects/mztake/make.bat
Normal file
3
collects/mztake/make.bat
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
"C:\Program Files\PLT\Setup PLT.exe" -l frtime
|
||||
"C:\Program Files\PLT\Setup PLT.exe" -l mztake
|
||||
"C:\Program Files\PLT\Setup PLT.exe" -l stepper
|
||||
|
|
@ -29,10 +29,8 @@
|
|||
line-col->pos ; memoized O(n) function to map line/col -> byte offset
|
||||
process)) ; parent debug-process
|
||||
|
||||
(define-struct debug-process (namespace ; Namespace the process runs in
|
||||
custodian ; If you shutdown-all it will kill the debugger process
|
||||
(define-struct debug-process (custodian ; If you shutdown-all it will kill the debugger process
|
||||
run-semaphore ; When you post to this the debuggee will continue executing
|
||||
eventspace ; The eventspace where events queue up
|
||||
running? ; Is the program (supposed-to-be) currently running
|
||||
exited? ; FrTime cell receives #t when the target exits
|
||||
exceptions ; (an event stream) Exceptions thrown during the evaluation of the target
|
||||
|
|
@ -66,10 +64,8 @@
|
|||
(make-break-trace (frp:event-receiver)))
|
||||
|
||||
(define (create-empty-debug-process)
|
||||
(make-debug-process (make-namespace)
|
||||
(make-custodian)
|
||||
(make-debug-process (make-custodian)
|
||||
null ; run-semaphore - null so we know it has never started
|
||||
(make-eventspace)
|
||||
#f ; running?
|
||||
(frp:new-cell) ; exited?
|
||||
(frp:event-receiver) ; exceptions
|
||||
|
|
|
|||
|
|
@ -9,22 +9,11 @@ does this work on binary drscheme files?
|
|||
|
||||
create client takes either a lib or relative or absolute path string
|
||||
|
||||
need client-error to throw an exception, they are all fatal
|
||||
|
||||
all errors are fatal now -- you can do this when
|
||||
|
||||
make all exposed cells and evstreams read-only by lifting the identity function on them
|
||||
|
||||
does this handle module prefixes?
|
||||
|
||||
what happens if two modules have the same name in different directories
|
||||
|
||||
WHY CANT REQUIRE TAKE AN ABSOLUTE PATH?
|
||||
(require (lib "file.ss"))
|
||||
(find-relative-path (current-directory) "C:/Files/Desktop/debugger/src/collects/mztake/mztake.ss")
|
||||
|
||||
Need to find a way to map the absolute paths taken in from clients to the function that determines what to annotate.
|
||||
|
||||
MAKE SURE THERE WONT BE COLLISIONS WHEN EVAL'NG MODULES...GIVE THEM UNIQUE NAMES BASED ON PATH!
|
||||
----------------
|
||||
|
||||
|
|
@ -63,8 +52,6 @@ exceptions thrown in anonymous threads spawned by the target, are caught by the
|
|||
RETHROW EXCEPTIONS CAUGHT ON THE STREAM FOR A CLIENT -- OFFER A WAY TO DISABLE IT
|
||||
WHO is catching (thread (lambda () (raise 'first-raise)))? It never gets to the exn evstream
|
||||
|
||||
CAN I CATCH FRTIME EXCEPTIONS AND RETHROW THOSE TOO?
|
||||
|
||||
code like
|
||||
(set-running! client (or (elapsed . < . 5) (elapsed . >= . 10)))
|
||||
(set-running! client #t)
|
||||
|
|
@ -101,6 +88,7 @@ improve speed of lookup for line-col->pos; load them into a hashtable? not impo
|
|||
|
||||
improve speed of load/annotate
|
||||
|
||||
improve speed of functions in (run)
|
||||
|
||||
|
||||
ERROR-CHECKING------------------------------------------------------------------------------
|
||||
|
|
@ -108,11 +96,6 @@ Make sure that you do not define more than one client for the same file.
|
|||
|
||||
Test what happens when you bind to variables that don't exist.
|
||||
|
||||
This throws an exception where it says something like random210 is an undefined variable
|
||||
The script does not tell you something went wrong though, and the solution (as-is/unchecked) is not obvious.
|
||||
(require (as-is mzscheme random random-seed))
|
||||
(random 100)
|
||||
|
||||
|
||||
TESTING/CAPABILITIES------------------------------------------------------------------------
|
||||
Does user interaction work? Can we step through loops one line at a time waiting for input? GUIs?
|
||||
|
|
@ -210,24 +193,17 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
|
|||
|
||||
; Run all traces at this breakpoint
|
||||
(let ([to-send (map (lambda (t) (trace->frp-event client result t)) traces)])
|
||||
(frp:send-synchronous-events to-send)))]
|
||||
; now, breakpoint-halt message should be sent by the debugger model
|
||||
(frp:send-synchronous-events to-send))
|
||||
; do we want to pause interactive debugging
|
||||
(when (running-now? process)
|
||||
(semaphore-post (debug-process-run-semaphore process))))]
|
||||
|
||||
;TODO eventually remove this from debugger-model.ss
|
||||
[($ error-breakpoint-info (source exn))
|
||||
; all errors and raises from the TARGET program will be caught here
|
||||
; FrTime errors from the script have their own eventstream
|
||||
(frp:send-event (debug-process-exceptions process) exn)
|
||||
(client-error (format "source: ~a | exception: ~a" source (if (exn? exn) (exn-message exn) exn)))]
|
||||
|
||||
;end of a statement
|
||||
[($ breakpoint-halt)
|
||||
; do we want to pause interactive debugging
|
||||
(when (running-now? process)
|
||||
(semaphore-post (debug-process-run-semaphore process)))]
|
||||
|
||||
;when a top level expression finishes
|
||||
[($ expression-finished return-val-list) (void)]))
|
||||
(client-error (format "source: ~a | exception: ~a" source (if (exn? exn) (exn-message exn) exn)))]))
|
||||
|
||||
;###########################################################################################################
|
||||
|
||||
|
|
@ -366,25 +342,19 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
|
|||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ;
|
||||
; ; ; ;;;; ;;; ;;;; ;;;; ;;;; ; ;;;; ; ; ; ;;; ;;;;
|
||||
|
||||
(define (start-debug-process process)
|
||||
(let* ([receive-result (receive-result process)])
|
||||
|
||||
; initialize the semaphore
|
||||
(set-debug-process-run-semaphore! process (make-semaphore))
|
||||
; set initial state of exit predicate
|
||||
(frp:set-cell! (debug-process-exited? process) #f)
|
||||
|
||||
(parameterize ([current-custodian (debug-process-custodian process)]
|
||||
[current-namespace (debug-process-namespace process)])
|
||||
|
||||
; connect to the debugger-model@ unit
|
||||
(define-values/invoke-unit (run) debugger-model@ #f receive-result process)
|
||||
|
||||
(thread (lambda ()
|
||||
; run the process
|
||||
(thread-wait (thread (lambda () (run))))
|
||||
; program terminates
|
||||
(kill process))))))
|
||||
(define (start-debug-process receive-result process)
|
||||
; initialize the semaphore
|
||||
(set-debug-process-run-semaphore! process (make-semaphore))
|
||||
; set initial state of exit predicate
|
||||
(frp:set-cell! (debug-process-exited? process) #f)
|
||||
|
||||
(thread (lambda ()
|
||||
; connect to the debugger-model@ unit
|
||||
(define-values/invoke-unit (run) debugger-model@ #f receive-result process)
|
||||
; run the process
|
||||
(thread-wait (thread (lambda () (run))))
|
||||
; program terminates
|
||||
(kill process))))
|
||||
|
||||
|
||||
; predicate - is the debugee supposed to be running now?
|
||||
|
|
@ -399,7 +369,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
|
|||
(define (update)
|
||||
; start the debugger if needed
|
||||
(when (null? (debug-process-run-semaphore process))
|
||||
(start-debug-process process))
|
||||
(start-debug-process (receive-result process) process))
|
||||
|
||||
(when run?
|
||||
(semaphore-post (debug-process-run-semaphore process)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user