From 437ab6826db2b0a1b165acfbb9831a482dc3a217 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 24 Mar 2012 16:00:42 -0400 Subject: [PATCH] Tweak kernel-to-user transitions, in prep for exception handling --- os2.rkt | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) 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