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

transition...

Browse Source 
svn: r115
This commit is contained in:
Jono Spiro 2004-07-29 18:58:19 +00:00
parent a19e47e861
commit a9923f1b16
2 changed files with 160 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

160
collects/mztake/mztake.ss
View File

@ -6,7 +6,6 @@ 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
@ -19,7 +18,6 @@ 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!
@ -137,17 +135,18 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
(prefix frp: (lib "frp.ss" "frtime")))
; Provides come from the script section at the bottom of the code
(provide (rename script:kill kill)
(rename script:pause pause)
(rename script:trace/bind trace/bind)
(rename script:trace/break trace/break)
(rename script:set-running! set-running!)
(rename debugger:exited? debugger:exited?)
(rename script:start/resume start/resume)
(rename script:create client:create)
(rename debugger:exceptions debugger:exceptions)
(rename script:runtime/seconds debugger:runtime/seconds)
(rename script:runtime/milliseconds debugger:runtime/milliseconds))
(provide debugger)
;(rename script:kill kill)
;(rename script:pause pause)
;(rename script:trace/bind trace/bind)
;(rename script:trace/break trace/break)
;(rename script:set-running! set-running!)
;(rename debugger:exited? debugger:exited?)
;(rename script:start/resume start/resume)
;(rename script:create client:create)
;(rename debugger:exceptions debugger:exceptions)
;(rename script:runtime/seconds debugger:runtime/seconds)
;(rename script:runtime/milliseconds debugger:runtime/milliseconds))
;(rename script-running? client-running?)) ; disabled until it works
@ -176,6 +175,42 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
tracepoints ; hash-table of traces
line-col->pos)); memoized O(n) function to map line/col -> byte offset
(define-struct client-process (namespace ; Namespace the process runs in
custodian ; If you shutdown-all it will kill the debugger process
run-semaphore ; When you post to this the debuggee will continue executing
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
runtime ; Behavior with current runtime in milliseconds
files/traces ; Hash-table with filenames as keys and hashtables of traces as values
))
(define run-semaphore null)
(define debugger:running? #f)
(define debugger:exited? (frp:new-cell))
(define debugger:exceptions (frp:event-receiver))
(define debugger:runtime
(frp:hold
((frp:changes
(frp:accum-b
((frp:changes frp:milliseconds)
. frp:-=> .
(match-lambda [(prev sum)
(if (frp:value-now debugger:running?)
(list (frp:value-now frp:milliseconds)
(+ (- (frp:value-now frp:milliseconds) prev) sum))
(list (frp:value-now frp:milliseconds) sum))]))
(list (frp:value-now frp:milliseconds) 0)))
. frp:==> .
second)
0))
;###########################################################################################################
@ -223,37 +258,11 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
; Keeps track of all defined clients
(define all-clients null)
; If you shutdown-all it will kill the debugger
(define debugger-custodian null)
;TODO For now, we have one global process in this list
(define all-client-processes null)
; When you post to this the debuggee will continue executing
(define run-semaphore null)
; Is the program (supposed-to-be) currently running
(define debugger:running? #f)
; FrTime cell receives #t when the target exits
(define debugger:exited? (frp:new-cell))
; (an event stream) Exceptions thrown during the evaluation of the target
(define debugger:exceptions (frp:event-receiver))
; Behavior with current runtime in milliseconds
(define debugger:runtime
(frp:hold
((frp:changes
(frp:accum-b
((frp:changes frp:milliseconds)
. frp:-=> .
(match-lambda [(prev sum)
(if (frp:value-now debugger:running?)
(list (frp:value-now frp:milliseconds)
(+ (- (frp:value-now frp:milliseconds) prev) sum))
(list (frp:value-now frp:milliseconds) sum))]))
(list (frp:value-now frp:milliseconds) 0)))
. frp:==> .
second)
0))
;TODO When you support more than one process, find and replace this function
(define (get-main-client-process) (first all-client-processes))
;###########################################################################################################
@ -302,7 +311,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
[($ breakpoint-halt)
; do we want to pause interactive debugging
(when (running-now?)
(semaphore-post run-semaphore))]
(semaphore-post (client-process-run-semaphore (get-main-client-process))))]
;when a top level expression finishes
[($ expression-finished return-val-list) (void)]))
@ -435,10 +444,10 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
; set initial state of exit predicate
(frp:set-cell! debugger:exited? #f)
(set! run-semaphore go-semaphore)
(set-client-process-run-semaphore! (get-main-client-process) go-semaphore)
(set! debugger-custodian user-custodian)
(print-debug (format "~a" debugger-custodian))
(set-client-process-custodian! (get-main-client-process) user-custodian)
(print-debug (format "~a" (client-process-custodian (get-main-client-process))))
; we run the program under its own custodian so we can easily kill it...that's IT
@ -504,7 +513,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
; predicate - is the debugee supposed to be running now?
(define (running-now?)
(and (not (null? run-semaphore))
(and (not (null? (client-process-run-semaphore (get-main-client-process))))
(frp:value-now debugger:running?)))
;###########################################################################################################
@ -534,7 +543,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
(lambda (run?)
(define (update)
; start the debugger if needed
(when (null? run-semaphore) (start-debugger))
(when (null? (client-process-run-semaphore (get-main-client-process))) (start-debugger))
(when run? (semaphore-post run-semaphore))
(frp:value-now run?))
@ -586,15 +595,15 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
modpath))]
[c (make-client modpath (make-hash) null)])
;TODO remove me
(print-debug (format "'~a' -> '~a'" filename modpath))
;TODO remove me
(print-debug (format "'~a' -> '~a'" filename modpath))
; set curried line-col->pos function for client
(set-client-line-col->pos! c (line-col->pos c))
; set curried line-col->pos function for client
(set-client-line-col->pos! c (line-col->pos c))
(set! all-clients (cons c all-clients))
(set! all-clients (cons c all-clients))
c)))))
c)))))
(define (script:pause) (script:set-running! #f))
@ -611,7 +620,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
(define (script:kill)
(script:pause)
; shutdown the custodian
(custodian-shutdown-all debugger-custodian)
(custodian-shutdown-all (client-process-custodian (get-main-client-process)))
; set the exit predicate to 'exited'
(frp:set-cell! debugger:exited? #t))
@ -640,4 +649,43 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
(trace-evnt-rcvr trace))))
;###########################################################################################################
;
; ;;;;; ;
; ; ; ;
; ; ;
; ; ; ; ; ;;;; ;;;;; ;;;; ; ;
; ; ; ; ;; ; ; ; ; ; ;
; ;;; ; ; ; ; ; ; ; ;
; ;;; ; ; ; ; ; ;;;;; ; ;
; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ;; ; ;
; ;;;;; ; ; ; ;;; ;;;; ; ; ;
; ;
; ;
; ;
(define-syntax debugger
(syntax-rules ()
[(debug
(process process-name
[client-name mod-path] ...)
(traces [trace-name trace-client-name
(trace-type . trace-args) (trace-body ...)] ...)
(run process-name
body ...)
(printf "clients: ~a~nrun: ~a~nbody: ~a~n"
'(clients [client-name client-path (traces [trace-name trace-client trace-type . trace-args] ...)] ...)
'(run run-client-name)
'(body ...))
]))
;###########################################################################################################
)

89
collects/mztake/private/load-annotator.ss
View File

@ -14,6 +14,7 @@
#|load-with-annotations :
>initial-module : (union (listof symbol?) string?)
Takes in a require spec -- "../file.ss", (file "complete-path.ss"), (lib ...), etc
In other words -
pass it a relative filename or a quoted lib to require
"mztake.ss" or '(lib "mztake.ss" "mztake")
@ -39,56 +40,56 @@
(load/annotate annotator fn m)]
[else
(ocload/use-compiled fn m)]))))])
(eval #`(require #,initial-module))))
(eval #`(require #,initial-module))))
(define (load/annotate annotator fn m)
(let-values ([(base _ __) (split-path fn)]
[(in-port src) (build-input-port fn)])
(dynamic-wind
(lambda () (void))
(define (load/annotate annotator fn m)
(let-values ([(base _ __) (split-path fn)]
[(in-port src) (build-input-port fn)])
(dynamic-wind
(lambda () (void))
(lambda ()
(parameterize ([read-accept-compiled #f]
[current-load-relative-directory base])
(unless m (raise 'module-name-not-passed-to-load/annotate))
(with-module-reading-parameterization
(lambda ()
(let* ([first (expand (read-syntax src in-port))]
[module-ized-exp (annotator fn m (check-module-form first m fn))]
[second (read in-port)])
(unless (eof-object? second)
(raise-syntax-error
'load/annotate
(format "expected only a `module' declaration for `~s', but found an extra expression" m)
second))
(eval module-ized-exp))))))
(lambda ()
(parameterize ([read-accept-compiled #f]
[current-load-relative-directory base])
(unless m (raise 'module-name-not-passed-to-load/annotate))
(with-module-reading-parameterization
(lambda ()
(let* ([first (expand (read-syntax src in-port))]
[module-ized-exp (annotator fn m (check-module-form first m fn))]
[second (read in-port)])
(unless (eof-object? second)
(raise-syntax-error
'load/annotate
(format "expected only a `module' declaration for `~s', but found an extra expression" m)
second))
(eval module-ized-exp))))))
(lambda () (close-input-port in-port)))))
(lambda () (close-input-port in-port)))))
; taken directly from mred.ss -- it's not exported...
(define (build-input-port filename)
(let ([p (open-input-file filename)])
(port-count-lines! p)
(let ([p (cond [(regexp-match-peek "^WXME01[0-9][0-9] ## " p)
(let ([t (make-object text%)])
(send t insert-file p 'standard)
(close-input-port p)
(open-input-text-editor t))]
[else p])])
(port-count-lines! p)
(let loop ()
(when (with-handlers ([not-break-exn? (lambda (x) #f)])
(regexp-match-peek "^#!" p))
(let lloop ([prev #f])
(let ([c (read-char-or-special p)])
(if (or (eof-object? c)
(eq? c #\return)
(eq? c #\newline))
(when (eq? prev #\\)
(loop))
(lloop c))))))
; taken directly from mred.ss -- it's not exported...
(define (build-input-port filename)
(let ([p (open-input-file filename)])
(port-count-lines! p)
(let ([p (cond [(regexp-match-peek "^WXME01[0-9][0-9] ## " p)
(let ([t (make-object text%)])
(send t insert-file p 'standard)
(close-input-port p)
(open-input-text-editor t))]
[else p])])
(port-count-lines! p)
(let loop ()
(when (with-handlers ([not-break-exn? (lambda (x) #f)])
(regexp-match-peek "^#!" p))
(let lloop ([prev #f])
(let ([c (read-char-or-special p)])
(if (or (eof-object? c)
(eq? c #\return)
(eq? c #\newline))
(when (eq? prev #\\)
(loop))
(lloop c))))))
(values p filename))))