Catch errors in VM processes
This commit is contained in:
parent
df3d76ae26
commit
859fb5a929
|
@ -19,9 +19,11 @@
|
|||
(write `(sleeping for ,delay milliseconds))
|
||||
(newline)
|
||||
(sleep delay (lambda ()
|
||||
(write `(awoke after ,delay milliseconds))
|
||||
(if (> delay 1500)
|
||||
(error 'example-process "Oh noes!")
|
||||
(begin (write `(awoke after ,delay milliseconds))
|
||||
(newline)
|
||||
(transition 'no-state (kill)))))
|
||||
(transition 'no-state (kill)))))))
|
||||
|
||||
(define spy
|
||||
(lambda ()
|
||||
|
|
23
os2.rkt
23
os2.rkt
|
@ -228,10 +228,11 @@
|
|||
[preaction
|
||||
(loop rest (perform-action pid preaction state) outbound-actions)])])))
|
||||
|
||||
(define (send-to-user f . args)
|
||||
(define (send-to-user failure-proc f . args)
|
||||
;; TODO: use this hook to find all the bits of code that will need
|
||||
;; with-handlers and crash compensation.
|
||||
(apply f args))
|
||||
(with-handlers ([exn:fail? failure-proc])
|
||||
(apply f args)))
|
||||
|
||||
(define (perform-action pid preaction state)
|
||||
(match preaction
|
||||
|
@ -332,7 +333,12 @@
|
|||
|
||||
(define (run-trapk state pid trap-k . args)
|
||||
(if trap-k
|
||||
(run-ready state pid (apply send-to-user trap-k args))
|
||||
(run-ready state pid (apply send-to-user
|
||||
(lambda (e) (lambda (process-state)
|
||||
(transition process-state
|
||||
(kill #f e))))
|
||||
trap-k
|
||||
args))
|
||||
state))
|
||||
|
||||
(define (maybe-transition->transition t)
|
||||
|
@ -343,14 +349,21 @@
|
|||
(define (run-ready state pid interrupt-k)
|
||||
(define old-process (hash-ref (vm-processes state) pid))
|
||||
(match-define (transition new-process-state actions)
|
||||
(maybe-transition->transition (send-to-user interrupt-k (process-state old-process))))
|
||||
(maybe-transition->transition (send-to-user (lambda (e)
|
||||
(transition (process-state old-process)
|
||||
(kill #f e)))
|
||||
interrupt-k
|
||||
(process-state old-process))))
|
||||
(struct-copy vm (enqueue-actions state pid actions)
|
||||
[processes (hash-set (vm-processes state) pid
|
||||
(struct-copy process old-process
|
||||
[state new-process-state]))]))
|
||||
|
||||
(define (do-spawn spawning-pid thunk k state)
|
||||
(match-define (transition initial-state initial-actions) (send-to-user thunk))
|
||||
(match-define (transition initial-state initial-actions) (send-to-user (lambda (e)
|
||||
(transition #f
|
||||
(kill #f e)))
|
||||
thunk))
|
||||
(define new-pid (vm-next-process-id state))
|
||||
(run-trapk (struct-copy vm (enqueue-actions state new-pid initial-actions)
|
||||
[processes (hash-set (vm-processes state) new-pid (process new-pid
|
||||
|
|
Loading…
Reference in New Issue