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 need client-error to throw an exception, they are all fatal
all errors are fatal now -- you can do this when all errors are fatal now -- you can do this when
make all exposed cells and evstreams read-only make all exposed cells and evstreams read-only
@ -19,7 +18,6 @@ WHY CANT REQUIRE TAKE AN ABSOLUTE PATH?
(require (lib "file.ss")) (require (lib "file.ss"))
(find-relative-path (current-directory) "C:/Files/Desktop/debugger/src/collects/mztake/mztake.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. 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! 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"))) (prefix frp: (lib "frp.ss" "frtime")))
; Provides come from the script section at the bottom of the code ; Provides come from the script section at the bottom of the code
(provide (rename script:kill kill) (provide debugger)
(rename script:pause pause) ;(rename script:kill kill)
(rename script:trace/bind trace/bind) ;(rename script:pause pause)
(rename script:trace/break trace/break) ;(rename script:trace/bind trace/bind)
(rename script:set-running! set-running!) ;(rename script:trace/break trace/break)
(rename debugger:exited? debugger:exited?) ;(rename script:set-running! set-running!)
(rename script:start/resume start/resume) ;(rename debugger:exited? debugger:exited?)
(rename script:create client:create) ;(rename script:start/resume start/resume)
(rename debugger:exceptions debugger:exceptions) ;(rename script:create client:create)
(rename script:runtime/seconds debugger:runtime/seconds) ;(rename debugger:exceptions debugger:exceptions)
(rename script:runtime/milliseconds debugger:runtime/milliseconds)) ;(rename script:runtime/seconds debugger:runtime/seconds)
;(rename script:runtime/milliseconds debugger:runtime/milliseconds))
;(rename script-running? client-running?)) ; disabled until it works ;(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 tracepoints ; hash-table of traces
line-col->pos)); memoized O(n) function to map line/col -> byte offset 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 ; Keeps track of all defined clients
(define all-clients null) (define all-clients null)
; If you shutdown-all it will kill the debugger ;TODO For now, we have one global process in this list
(define debugger-custodian null) (define all-client-processes null)
; When you post to this the debuggee will continue executing ;TODO When you support more than one process, find and replace this function
(define run-semaphore null) (define (get-main-client-process) (first all-client-processes))
; 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))
;########################################################################################################### ;###########################################################################################################
@ -302,7 +311,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
[($ breakpoint-halt) [($ breakpoint-halt)
; do we want to pause interactive debugging ; do we want to pause interactive debugging
(when (running-now?) (when (running-now?)
(semaphore-post run-semaphore))] (semaphore-post (client-process-run-semaphore (get-main-client-process))))]
;when a top level expression finishes ;when a top level expression finishes
[($ expression-finished return-val-list) (void)])) [($ 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 ; set initial state of exit predicate
(frp:set-cell! debugger:exited? #f) (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) (set-client-process-custodian! (get-main-client-process) user-custodian)
(print-debug (format "~a" debugger-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 ; 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? ; predicate - is the debugee supposed to be running now?
(define (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?))) (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?) (lambda (run?)
(define (update) (define (update)
; start the debugger if needed ; 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)) (when run? (semaphore-post run-semaphore))
(frp:value-now run?)) (frp:value-now run?))
@ -586,15 +595,15 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
modpath))] modpath))]
[c (make-client modpath (make-hash) null)]) [c (make-client modpath (make-hash) null)])
;TODO remove me ;TODO remove me
(print-debug (format "'~a' -> '~a'" filename modpath)) (print-debug (format "'~a' -> '~a'" filename modpath))
; set curried line-col->pos function for client ; set curried line-col->pos function for client
(set-client-line-col->pos! c (line-col->pos c)) (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)) (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) (define (script:kill)
(script:pause) (script:pause)
; shutdown the custodian ; shutdown the custodian
(custodian-shutdown-all debugger-custodian) (custodian-shutdown-all (client-process-custodian (get-main-client-process)))
; set the exit predicate to 'exited' ; set the exit predicate to 'exited'
(frp:set-cell! debugger:exited? #t)) (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)))) (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 : #|load-with-annotations :
>initial-module : (union (listof symbol?) string?) >initial-module : (union (listof symbol?) string?)
Takes in a require spec -- "../file.ss", (file "complete-path.ss"), (lib ...), etc
In other words - In other words -
pass it a relative filename or a quoted lib to require pass it a relative filename or a quoted lib to require
"mztake.ss" or '(lib "mztake.ss" "mztake") "mztake.ss" or '(lib "mztake.ss" "mztake")
@ -39,56 +40,56 @@
(load/annotate annotator fn m)] (load/annotate annotator fn m)]
[else [else
(ocload/use-compiled fn m)]))))]) (ocload/use-compiled fn m)]))))])
(eval #`(require #,initial-module)))) (eval #`(require #,initial-module))))
(define (load/annotate annotator fn m) (define (load/annotate annotator fn m)
(let-values ([(base _ __) (split-path fn)] (let-values ([(base _ __) (split-path fn)]
[(in-port src) (build-input-port fn)]) [(in-port src) (build-input-port fn)])
(dynamic-wind (dynamic-wind
(lambda () (void)) (lambda () (void))
(lambda () (lambda ()
(parameterize ([read-accept-compiled #f] (parameterize ([read-accept-compiled #f]
[current-load-relative-directory base]) [current-load-relative-directory base])
(unless m (raise 'module-name-not-passed-to-load/annotate)) (unless m (raise 'module-name-not-passed-to-load/annotate))
(with-module-reading-parameterization (with-module-reading-parameterization
(lambda () (lambda ()
(let* ([first (expand (read-syntax src in-port))] (let* ([first (expand (read-syntax src in-port))]
[module-ized-exp (annotator fn m (check-module-form first m fn))] [module-ized-exp (annotator fn m (check-module-form first m fn))]
[second (read in-port)]) [second (read in-port)])
(unless (eof-object? second) (unless (eof-object? second)
(raise-syntax-error (raise-syntax-error
'load/annotate 'load/annotate
(format "expected only a `module' declaration for `~s', but found an extra expression" m) (format "expected only a `module' declaration for `~s', but found an extra expression" m)
second)) second))
(eval module-ized-exp)))))) (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... ; taken directly from mred.ss -- it's not exported...
(define (build-input-port filename) (define (build-input-port filename)
(let ([p (open-input-file filename)]) (let ([p (open-input-file filename)])
(port-count-lines! p) (port-count-lines! p)
(let ([p (cond [(regexp-match-peek "^WXME01[0-9][0-9] ## " p) (let ([p (cond [(regexp-match-peek "^WXME01[0-9][0-9] ## " p)
(let ([t (make-object text%)]) (let ([t (make-object text%)])
(send t insert-file p 'standard) (send t insert-file p 'standard)
(close-input-port p) (close-input-port p)
(open-input-text-editor t))] (open-input-text-editor t))]
[else p])]) [else p])])
(port-count-lines! p) (port-count-lines! p)
(let loop () (let loop ()
(when (with-handlers ([not-break-exn? (lambda (x) #f)]) (when (with-handlers ([not-break-exn? (lambda (x) #f)])
(regexp-match-peek "^#!" p)) (regexp-match-peek "^#!" p))
(let lloop ([prev #f]) (let lloop ([prev #f])
(let ([c (read-char-or-special p)]) (let ([c (read-char-or-special p)])
(if (or (eof-object? c) (if (or (eof-object? c)
(eq? c #\return) (eq? c #\return)
(eq? c #\newline)) (eq? c #\newline))
(when (eq? prev #\\) (when (eq? prev #\\)
(loop)) (loop))
(lloop c)))))) (lloop c))))))
(values p filename)))) (values p filename))))