This commit is contained in:
parent
d95ed21da9
commit
fbe15a986a
18
mu.arc
18
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*)
|
||||
|
|
41
mu.arc.t
41
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
|
||||
|
@ -48,6 +59,35 @@
|
|||
(prn "F - 'reply' stops executing the current function"))
|
||||
;? (quit)
|
||||
|
||||
(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
|
||||
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue