82

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