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

adjust racket/engine so that it logs the time that various things happen

Browse Source 
(and remove the commented out printfs that seem to be printing
out that same information)
This commit is contained in:
Robby Findler 2012-10-29 06:21:35 -05:00
parent 47a33f2edf
commit b7681e0807
2 changed files with 40 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/racket/engine.rkt
View File

@ -13,7 +13,7 @@
;; An X-engine-object is
;; (make-engine-object thread semaphore channel channel X)
(define-struct engine-object (worker can-stop-lock done-ch ex-ch result)
(define-struct engine-object (worker can-stop-lock done-ch ex-ch result name)
#:mutable)
;; engine : ((bool ->) -> X) -> X-engine-object
@ -46,16 +46,18 @@
(let ([v (f enable-stop)])
(enable-stop #t)
(channel-put done-ch v)))))])
(begin0 (make-engine-object tid can-stop-lock done-ch ex-ch #f)
(begin0 (make-engine-object tid can-stop-lock done-ch ex-ch #f
(and (object-name f)
(symbol->string (object-name f))))
(thread-suspend tid)
(semaphore-post proceed-sema))))
;; engine : real-number X-engine-object -> bool
(define (engine-run timeout w)
(log "engine-run called" w)
(if (engine-object-worker w)
(let ([can-stop-lock (engine-object-can-stop-lock w)]
[worker (engine-object-worker w)])
#;(printf "2. starting engine\n")
(thread-resume worker)
(dynamic-wind
void
@ -65,25 +67,27 @@
timeout
(alarm-evt (+ timeout (current-inexact-milliseconds))))
(lambda (x)
#;(printf "2. alarm-evt\n")
(log "alarm woke up, waiting to suspend engine" w)
(semaphore-wait can-stop-lock)
(log "suspending engine" w)
(thread-suspend worker)
(semaphore-post can-stop-lock)
#f))
(wrap-evt (engine-object-done-ch w)
(lambda (res)
#;(printf "2. engine-done-evt\n")
(log "engine done" w)
(set-engine-object-result! w res)
(engine-kill w)
#t))
(wrap-evt (engine-object-ex-ch w)
(lambda (exn)
#;(printf "2. ex-evt\n")
(log "engine raised exn" w)
(engine-kill w)
(raise exn))))))
;; In case we escape through a break:
(lambda ()
(when (thread-running? worker)
(log "engine escape via break" w)
(semaphore-wait can-stop-lock)
(thread-suspend worker)
(semaphore-post can-stop-lock)))))
@ -104,3 +108,19 @@
(define (engine? x)
(engine-object? x))
(define engine-logger (make-logger 'racket/engine (current-logger)))
(define-syntax-rule
(log msg w)
(when (log-level? engine-logger 'debug)
(do-log msg w)))
(define (do-log msg w)
(define name (engine-object-name w))
(log-message engine-logger 'debug
(if name
(string-append "racket/engine: " name ": " msg)
(string-append "racket/engine: " msg))
(engine-info (current-inexact-milliseconds)
name)))
(struct engine-info (msec name) #:prefab)

14
collects/scribblings/reference/engine.scrbl
View File

@ -10,6 +10,20 @@ An @deftech{engine} is an abstraction that models processes that
can be preempted by a timer or other external trigger. They are
inspired by the work of Haynes and Friedman @cite["Haynes84"].
Engines log their behavior via a logger with the name
@racket['racket/engine]. The logger is created when the module
is instantiated and uses the result of @racket[(current-logger)]
as its parent. The library adds logs a @racket['debug] level
message: when @racket[engine-run]
is called, when the engine timeout expires, and when the engine is
stopped (either because it terminated or it reached a safe point to
stop). Each log message holds a value of the struct:
@racketblock[(struct engine-info (msec name) #:prefab)]
where the @racket[_msec] field holds the result of
@racket[(current-inexact-milliseconds)] at the moment of logging,
and the @racket[_name] field holds the name of the procedure
passed to @racket[engine].
@defproc[(engine [proc ((any/c . -> . void?) . -> . any/c)])
engine?]{