From f7b735a99787f67876cc8e9ae05ea49791e49966 Mon Sep 17 00:00:00 2001 From: Jono Spiro Date: Fri, 30 Jul 2004 20:32:50 +0000 Subject: [PATCH] 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 --- collects/mztake/debugger-model.ss | 25 +++++------ collects/mztake/make.bat | 3 ++ collects/mztake/mztake-structs.ss | 8 +--- collects/mztake/mztake.ss | 70 +++++++++---------------------- 4 files changed, 35 insertions(+), 71 deletions(-) create mode 100644 collects/mztake/make.bat diff --git a/collects/mztake/debugger-model.ss b/collects/mztake/debugger-model.ss index ab9998a5b5..cebb35454c 100644 --- a/collects/mztake/debugger-model.ss +++ b/collects/mztake/debugger-model.ss @@ -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)))))))) \ No newline at end of file + (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)))))))) \ No newline at end of file diff --git a/collects/mztake/make.bat b/collects/mztake/make.bat new file mode 100644 index 0000000000..453fa88706 --- /dev/null +++ b/collects/mztake/make.bat @@ -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 \ No newline at end of file diff --git a/collects/mztake/mztake-structs.ss b/collects/mztake/mztake-structs.ss index 5c7daefa34..b9f047cf1d 100644 --- a/collects/mztake/mztake-structs.ss +++ b/collects/mztake/mztake-structs.ss @@ -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 diff --git a/collects/mztake/mztake.ss b/collects/mztake/mztake.ss index e3f6a973b4..1a21b29e3b 100644 --- a/collects/mztake/mztake.ss +++ b/collects/mztake/mztake.ss @@ -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)))