This commit is contained in:
parent
c140d9cc5f
commit
c532f0ab5f
104
mu.arc
104
mu.arc
|
@ -96,18 +96,32 @@
|
||||||
offset (+ 1 (* idx sz.elem)))
|
offset (+ 1 (* idx sz.elem)))
|
||||||
(m `(,(+ v.operand offset) ,elem))))
|
(m `(,(+ v.operand offset) ,elem))))
|
||||||
|
|
||||||
; context is a table containing the 'stack' of functions that haven't yet
|
; context contains the call-stack of functions that haven't yet returned
|
||||||
; returned
|
|
||||||
; ({fn-name pc fn-arg-idx}*)
|
|
||||||
|
|
||||||
(mac body (context) ; assignable
|
(defextend empty (x) (isa x 'context)
|
||||||
`(function* ((,context 0) 'fn-name)))
|
(no rep.x!call-stack))
|
||||||
|
|
||||||
(mac pc (context) ; assignable
|
(def stack (context)
|
||||||
`((,context 0) 'pc))
|
((rep context) 'call-stack))
|
||||||
|
|
||||||
(mac caller-arg-idx (context) ; assignable
|
(mac push-stack (context op)
|
||||||
`((,context 0) 'caller-arg-idx))
|
`(push (obj fn-name ,op pc 0 caller-arg-idx 0)
|
||||||
|
((rep ,context) 'call-stack)))
|
||||||
|
|
||||||
|
(mac pop-stack (context)
|
||||||
|
`(pop ((rep ,context) 'call-stack)))
|
||||||
|
|
||||||
|
(def top (context)
|
||||||
|
stack.context.0)
|
||||||
|
|
||||||
|
(def body (context (o idx 0))
|
||||||
|
(function* stack.context.idx!fn-name))
|
||||||
|
|
||||||
|
(mac pc (context (o idx 0)) ; assignable
|
||||||
|
`((((rep ,context) 'call-stack) ,idx) 'pc))
|
||||||
|
|
||||||
|
(mac caller-arg-idx (context (o idx 0)) ; assignable
|
||||||
|
`((((rep ,context) 'call-stack) ,idx) 'caller-arg-idx))
|
||||||
|
|
||||||
(= scheduling-interval* 500)
|
(= scheduling-interval* 500)
|
||||||
|
|
||||||
|
@ -119,35 +133,35 @@
|
||||||
(list nil instr.0 cdr.instr)))
|
(list nil instr.0 cdr.instr)))
|
||||||
|
|
||||||
(def caller-args (context) ; not assignable
|
(def caller-args (context) ; not assignable
|
||||||
(let (_ _ args) (parse-instr ((body cdr.context) (pc cdr.context)))
|
(let (_ _ args) (parse-instr ((body context 1) (pc context 1)))
|
||||||
args))
|
args))
|
||||||
|
|
||||||
(def caller-oargs (context) ; not assignable
|
(def caller-oargs (context) ; not assignable
|
||||||
(let (oargs _ _) (parse-instr ((body cdr.context) (pc cdr.context)))
|
(let (oargs _ _) (parse-instr ((body context 1) (pc context 1)))
|
||||||
oargs))
|
oargs))
|
||||||
|
|
||||||
(= context* nil)
|
|
||||||
|
|
||||||
(def run (fn-name)
|
(def run (fn-name)
|
||||||
(= context* (list (obj fn-name fn-name pc 0 caller-arg-idx 0)))
|
|
||||||
(ret result 0
|
(ret result 0
|
||||||
(while context*
|
(let context (annotate 'context (obj call-stack (list
|
||||||
;? (prn "== " context*)
|
(obj fn-name fn-name pc 0 caller-arg-idx 0))))
|
||||||
(= result (+ result (run-for-time-slice scheduling-interval*))))))
|
(while (~empty context)
|
||||||
|
;? (prn "== " context)
|
||||||
|
(let insts-run (run-for-time-slice context scheduling-interval*)
|
||||||
|
(= result (+ result insts-run)))))))
|
||||||
|
|
||||||
(def run-for-time-slice (time-slice)
|
(def run-for-time-slice (context time-slice)
|
||||||
;? (prn "AAA")
|
;? (prn "AAA")
|
||||||
(point return
|
(point return
|
||||||
;? (prn "BBB")
|
;? (prn "BBB")
|
||||||
(for ninstrs 0 (< ninstrs time-slice) (++ ninstrs)
|
(for ninstrs 0 (< ninstrs time-slice) (++ ninstrs)
|
||||||
;? (prn "CCC " pc.context* " " context* " " (len body.context*))
|
;? (prn "CCC " pc.context " " context " " (len body.context))
|
||||||
(while (>= pc.context* (len body.context*))
|
(while (>= pc.context (len body.context))
|
||||||
(pop context*)
|
(pop-stack context)
|
||||||
(if no.context* (return ninstrs))
|
(if empty.context (return ninstrs))
|
||||||
(++ pc.context*))
|
(++ pc.context))
|
||||||
;? (prn "--- " context*.0!fn-name " " pc.context* ": " (body.context* pc.context*))
|
;? (prn "--- " top.context!fn-name " " pc.context ": " (body.context pc.context))
|
||||||
;? (prn " " memory*)
|
;? (prn " " memory*)
|
||||||
(let (oarg op arg) (parse-instr (body.context* pc.context*))
|
(let (oarg op arg) (parse-instr (body.context pc.context))
|
||||||
;? (prn op " " arg " -> " oarg)
|
;? (prn op " " arg " -> " oarg)
|
||||||
(let tmp
|
(let tmp
|
||||||
(case op
|
(case op
|
||||||
|
@ -185,23 +199,23 @@
|
||||||
arg
|
arg
|
||||||
(let idx (if arg
|
(let idx (if arg
|
||||||
arg.0
|
arg.0
|
||||||
(do1 caller-arg-idx.context*
|
(do1 caller-arg-idx.context
|
||||||
(++ caller-arg-idx.context*)))
|
(++ caller-arg-idx.context)))
|
||||||
;? (prn idx)
|
;? (prn idx)
|
||||||
;? (prn caller-args.context*)
|
;? (prn caller-args.context)
|
||||||
(m caller-args.context*.idx))
|
(m caller-args.context.idx))
|
||||||
type
|
type
|
||||||
(ty (caller-args.context* arg.0))
|
(ty (caller-args.context arg.0))
|
||||||
otype
|
otype
|
||||||
(ty (caller-oargs.context* arg.0))
|
(ty (caller-oargs.context arg.0))
|
||||||
jmp
|
jmp
|
||||||
(do (= pc.context* (+ 1 pc.context* (v arg.0)))
|
(do (= pc.context (+ 1 pc.context (v arg.0)))
|
||||||
;? (prn "jumping to " pc.context*)
|
;? (prn "jumping to " pc.context)
|
||||||
(continue))
|
(continue))
|
||||||
jif
|
jif
|
||||||
(when (is t (m arg.0))
|
(when (is t (m arg.0))
|
||||||
(= pc.context* (+ 1 pc.context* (v arg.1)))
|
(= pc.context (+ 1 pc.context (v arg.1)))
|
||||||
;? (prn "jumping to " pc.context*)
|
;? (prn "jumping to " pc.context)
|
||||||
(continue))
|
(continue))
|
||||||
copy
|
copy
|
||||||
(m arg.0)
|
(m arg.0)
|
||||||
|
@ -224,16 +238,16 @@
|
||||||
aref
|
aref
|
||||||
(array-ref arg.0 (v arg.1))
|
(array-ref arg.0 (v arg.1))
|
||||||
reply
|
reply
|
||||||
(do (pop context*)
|
(do (pop-stack context)
|
||||||
(if no.context* (return ninstrs))
|
(if empty.context (return ninstrs))
|
||||||
(let (caller-oargs _ _) (parse-instr (body.context* pc.context*))
|
(let (caller-oargs _ _) (parse-instr (body.context pc.context))
|
||||||
(each (dest src) (zip caller-oargs arg)
|
(each (dest src) (zip caller-oargs arg)
|
||||||
(setm dest (m src))))
|
(setm dest (m src))))
|
||||||
(++ pc.context*)
|
(++ pc.context)
|
||||||
(while (>= pc.context* (len body.context*))
|
(while (>= pc.context (len body.context))
|
||||||
(pop context*)
|
(pop-stack context)
|
||||||
(if no.context* (return ninstrs))
|
(if empty.context (return ninstrs))
|
||||||
(++ pc.context*))
|
(++ pc.context))
|
||||||
(continue))
|
(continue))
|
||||||
new
|
new
|
||||||
(let type (v arg.0)
|
(let type (v arg.0)
|
||||||
|
@ -241,7 +255,7 @@
|
||||||
(new-array type (v arg.1))
|
(new-array type (v arg.1))
|
||||||
(new-scalar type)))
|
(new-scalar type)))
|
||||||
; else user-defined function
|
; else user-defined function
|
||||||
(do (push (obj fn-name op pc 0 caller-arg-idx 0) context*)
|
(do (push-stack context op)
|
||||||
(continue))
|
(continue))
|
||||||
)
|
)
|
||||||
; opcode generated some value, stored in 'tmp'
|
; opcode generated some value, stored in 'tmp'
|
||||||
|
@ -253,7 +267,7 @@
|
||||||
;? (prn oarg.0)
|
;? (prn oarg.0)
|
||||||
(setm oarg.0 tmp)))
|
(setm oarg.0 tmp)))
|
||||||
)
|
)
|
||||||
(++ pc.context*)))
|
(++ pc.context)))
|
||||||
(return time-slice)))
|
(return time-slice)))
|
||||||
|
|
||||||
(enq (fn () (= Memory-in-use-until 1000))
|
(enq (fn () (= Memory-in-use-until 1000))
|
||||||
|
|
1
mu.arc.t
1
mu.arc.t
|
@ -8,6 +8,7 @@
|
||||||
;? (prn memory*)
|
;? (prn memory*)
|
||||||
(if (~iso memory* (obj 1 1))
|
(if (~iso memory* (obj 1 1))
|
||||||
(prn "F - 'literal' writes a literal value (its lone 'arg' after the instruction name) to a location in memory (an address) specified by its lone 'oarg' or output arg before the arrow"))
|
(prn "F - 'literal' writes a literal value (its lone 'arg' after the instruction name) to a location in memory (an address) specified by its lone 'oarg' or output arg before the arrow"))
|
||||||
|
;? (quit)
|
||||||
|
|
||||||
(reset)
|
(reset)
|
||||||
(add-fns
|
(add-fns
|
||||||
|
|
Loading…
Reference in New Issue