diff --git a/os2.rkt b/os2.rkt index 17f77dc..e93b7ad 100644 --- a/os2.rkt +++ b/os2.rkt @@ -229,8 +229,6 @@ (loop rest (perform-action pid preaction state) outbound-actions)])]))) (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. (with-handlers ([exn:fail? failure-proc]) (apply f args))) @@ -333,12 +331,10 @@ (define (run-trapk state pid trap-k . args) (if trap-k - (run-ready state pid (apply send-to-user - (lambda (e) (lambda (process-state) - (transition process-state - (kill #f e)))) - trap-k - args)) + (let ((failure-proc (lambda (e) (lambda (process-state) + (transition process-state + (kill #f e)))))) + (run-ready state pid (apply send-to-user failure-proc trap-k args))) state)) (define (maybe-transition->transition t) @@ -349,21 +345,18 @@ (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 (lambda (e) - (transition (process-state old-process) - (kill #f e))) - 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 (lambda (e) - (transition #f - (kill #f e))) - 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