diff options
-rw-r--r-- | mu.arc | 18 | ||||
-rw-r--r-- | mu.arc.t | 41 |
2 files changed, 53 insertions, 6 deletions
diff --git a/mu.arc b/mu.arc index b728c51a..afcd1620 100644 --- a/mu.arc +++ b/mu.arc @@ -128,13 +128,15 @@ (def run (fn-name) ;? (prn "AAA") + (point return (let context (list (obj fn-name fn-name pc 0 caller-arg-idx 0)) ;? (prn "BBB") (for ninstrs 0 (< ninstrs scheduling-interval*) (++ ninstrs) ;? (prn "CCC " pc.context " " context " " (len body.context)) - (if (>= pc.context (len body.context)) - (pop context)) - (if (no context) (break)) + (while (>= pc.context (len body.context)) + (pop context) + (if no.context (return ninstrs)) + (++ pc.context)) ;? (prn "--- " context.0!fn-name " " pc.context ": " (body.context pc.context)) ;? (prn " " memory*) (let (oarg op arg) (parse-instr (body.context pc.context)) @@ -215,11 +217,15 @@ (array-ref arg.0 (v arg.1)) reply (do (pop context) - (if no.context (break)) + (if no.context (return ninstrs)) (let (caller-oargs _ _) (parse-instr (body.context pc.context)) (each (dest src) (zip caller-oargs arg) (setm dest (m src)))) (++ pc.context) + (while (>= pc.context (len body.context)) + (pop context) + (if no.context (return ninstrs)) + (++ pc.context)) (continue)) new (let type (v arg.0) @@ -239,8 +245,8 @@ ;? (prn oarg.0) (setm oarg.0 tmp))) ) - (++ pc.context)))) - nil) + (++ pc.context))) + (return scheduling-interval*)))) (enq (fn () (= Memory-in-use-until 1000)) initialization-fns*) diff --git a/mu.arc.t b/mu.arc.t index 0b89873f..7974bf4d 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -31,6 +31,17 @@ ;? (prn memory*) (if (~iso memory* (obj 1 1 2 3 3 4)) (prn "F - calling a user-defined function runs its instructions")) +;? (quit) + +(reset) +(add-fns + '((test1 + ((1 integer) <- literal 1)) + (main + (test1)))) +(if (~iso 2 (run 'main)) + (prn "F - calling a user-defined function runs its instructions exactly once")) +;? (quit) (reset) (add-fns @@ -50,6 +61,35 @@ (reset) (add-fns + `((test1 + ((3 integer) <- test2)) + (test2 + (reply (2 integer))) + (main + ((2 integer) <- literal 34) + (test1)))) +(run 'main) +;? (prn memory*) +(if (~iso memory* (obj 2 34 3 34)) + (prn "F - 'reply' stops executing any callers as necessary")) +;? (quit) + +(reset) +(add-fns + '((test1 + ((3 integer) <- add (1 integer) (2 integer)) + (reply) + ((4 integer) <- literal 34)) + (main + ((1 integer) <- literal 1) + ((2 integer) <- literal 3) + (test1)))) +(if (~iso 4 (run 'main)) ; last reply sometimes not counted. worth fixing? + (prn "F - 'reply' executes instructions exactly once")) +;? (quit) + +(reset) +(add-fns '((test1 ((4 integer) <- arg) ((5 integer) <- arg) @@ -254,6 +294,7 @@ ;? (prn memory*) (if (~iso memory* (obj 1 8)) (prn "F - 'jmp' doesn't skip too many instructions")) +;? (quit) (reset) (add-fns |