diff --git a/os2.rkt b/os2.rkt index e788d9d..f826392 100644 --- a/os2.rkt +++ b/os2.rkt @@ -142,10 +142,10 @@ [preaction (loop rest (perform-action pid preaction state) outbound-actions)])]))) -(define (run-user-code v) +(define (send-to-user f . args) ;; TODO: use this hook to find all the bits of code that will need ;; with-handlers and crash compensation. - v) + (apply f args)) (define (perform-action pid preaction state) (match preaction @@ -241,19 +241,26 @@ body))) (define (run-trapk state pid trap-k . args) - (run-ready state pid (run-user-code (apply trap-k args)))) + (if trap-k + (run-ready state pid (apply send-to-user trap-k args)) + state)) + +(define (maybe-transition->transition t) + (if (transition? t) + t + (transition t '()))) (define (run-ready state pid interrupt-k) (define old-process (hash-ref (vm-processes state) pid)) (match-define (transition new-process-state actions) - (run-user-code (interrupt-k (process-state old-process)))) + (maybe-transition->transition (send-to-user 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) (run-user-code (thunk))) + (match-define (transition initial-state initial-actions) (send-to-user 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