akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

81 - reify machine state into a 'context' variable 

Beginning of concurrency primitives.
This commit is contained in:
Kartik K. Agaram 2014-08-28 12:44:01 -07:00
parent 576d603f8f
commit d95ed21da9
3 changed files with 143 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
mu.arc
View File

@ -9,10 +9,6 @@
`(enq (fn () (= (function* ',name) ',body))
initialization-fns*))
(mac on-init body
`(enq (fn () (run ',body))
initialization-fns*))
(def clear ()
(= types* (obj
; must be scalar or array, sum or product or primitive
@ -75,7 +71,7 @@
(++ n))))
(def m (loc) ; read memory, respecting metadata
;? (prn "m " loc sz.loc)
;? (prn "m " loc " " sz.loc)
(if (is 1 sz.loc)
(memory* (addr loc))
(annotate 'record
@ -100,22 +96,50 @@
offset (+ 1 (* idx sz.elem)))
(m `(,(+ v.operand offset) ,elem))))
(def run (instrs (o fn-args) (o fn-oargs))
(ret result nil
(with (ninstrs 0 fn-arg-idx 0)
;? (prn instrs)
(for pc 0 (< pc len.instrs) (do ++.ninstrs ++.pc)
;? (if (> ninstrs 10) (break))
(let instr instrs.pc
;? (prn memory*)
;? (prn pc ": " instr)
(let delim (or (pos '<- instr) -1)
(with (oarg (if (>= delim 0)
(cut instr 0 delim))
op (instr (+ delim 1))
arg (cut instr (+ delim 2)))
;? (prn op " " oarg)
(let tmp
; context is a table containing the 'stack' of functions that haven't yet
; returned
; ({fn-name pc fn-arg-idx}*)
(mac body (context) ; assignable
`(function* ((,context 0) 'fn-name)))
(mac pc (context) ; assignable
`((,context 0) 'pc))
(mac caller-arg-idx (context) ; assignable
`((,context 0) 'caller-arg-idx))
(= scheduling-interval* 500)
(def parse-instr (instr)
(iflet delim (pos '<- instr)
(list (cut instr 0 delim) ; oargs
(instr (+ delim 1)) ; op
(cut instr (+ delim 2))) ; args
(list nil instr.0 cdr.instr)))
(def caller-args (context) ; not assignable
(let (_ _ args) (parse-instr ((body cdr.context) (pc cdr.context)))
args))
(def caller-oargs (context) ; not assignable
(let (oargs _ _) (parse-instr ((body cdr.context) (pc cdr.context)))
oargs))
(def run (fn-name)
;? (prn "AAA")
(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))
;? (prn "--- " context.0!fn-name " " pc.context ": " (body.context pc.context))
;? (prn " " memory*)
(let (oarg op arg) (parse-instr (body.context pc.context))
;? (prn op " " arg " -> " oarg)
(let tmp
(case op
literal
arg.0
@ -151,21 +175,23 @@
arg
(let idx (if arg
arg.0
(do1 fn-arg-idx
++.fn-arg-idx))
(m fn-args.idx))
(do1 caller-arg-idx.context
(++ caller-arg-idx.context)))
;? (prn idx)
;? (prn caller-args.context)
(m caller-args.context.idx))
type
(ty (fn-args arg.0))
(ty (caller-args.context arg.0))
otype
(ty (fn-oargs arg.0))
(ty (caller-oargs.context arg.0))
jmp
(do (= pc (+ pc (v arg.0)))
;? (prn "jumping to " pc)
(do (= pc.context (+ 1 pc.context (v arg.0)))
;? (prn "jumping to " pc.context)
(continue))
jif
(when (is t (m arg.0))
(= pc (+ pc (v arg.1)))
;? (prn "jumping to " pc)
(= pc.context (+ 1 pc.context (v arg.1)))
;? (prn "jumping to " pc.context)
(continue))
copy
(m arg.0)
@ -188,34 +214,33 @@
aref
(array-ref arg.0 (v arg.1))
reply
(do (= result arg)
(break))
(do (pop context)
(if no.context (break))
(let (caller-oargs _ _) (parse-instr (body.context pc.context))
(each (dest src) (zip caller-oargs arg)
(setm dest (m src))))
(++ pc.context)
(continue))
new
(let type (v arg.0)
(if types*.type!array
(new-array type (v arg.1))
(new-scalar type)))
; else user-defined function
(let-or new-body function*.op (prn "no definition for " op)
;? (prn "== " memory*)
(let results (run new-body arg oarg)
;? (prn "=> " oarg " " results)
(each o oarg
;? (prn o)
(setm o (m pop.results))))
(continue))
(do (push (obj fn-name op pc 0 caller-arg-idx 0) context)
(continue))
)
; opcode generated some value, stored in 'tmp'
;? (prn tmp " " oarg)
;? (prn "store: " tmp " " oarg)
(if (acons tmp)
(for i 0 (< i (min len.tmp len.oarg)) ++.i
(setm oarg.i tmp.i))
(when oarg ; must be a list
;? (prn oarg.0)
(setm oarg.0 tmp)))
)))))
;? (prn "return " result)
)))
)
(++ pc.context))))
nil)
(enq (fn () (= Memory-in-use-until 1000))
initialization-fns*)
@ -322,5 +347,5 @@
(reset)
(awhen cdr.argv
(map add-fns:readfile it)
(run function*!main)
(run 'main)
(prn memory*))

78
mu.arc.t
View File

@ -4,7 +4,7 @@
(add-fns
'((test1
((1 integer) <- literal 1))))
(run function*!test1)
(run 'test1)
;? (prn memory*)
(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"))
@ -15,7 +15,7 @@
((1 integer) <- literal 1)
((2 integer) <- literal 3)
((3 integer) <- add (1 integer) (2 integer)))))
(run function*!test1)
(run 'test1)
(if (~iso memory* (obj 1 1 2 3 3 4))
(prn "F - 'add' operates on two addresses"))
@ -27,7 +27,7 @@
((1 integer) <- literal 1)
((2 integer) <- literal 3)
(test1))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4))
(prn "F - calling a user-defined function runs its instructions"))
@ -42,7 +42,7 @@
((1 integer) <- literal 1)
((2 integer) <- literal 3)
(test1))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4))
(prn "F - 'reply' stops executing the current function"))
@ -61,7 +61,7 @@
((2 integer) <- literal 3)
(test1 (1 integer) (2 integer))
)))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
@ -82,7 +82,7 @@
((2 integer) <- literal 3)
(test1 (1 integer) (2 integer))
)))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
@ -105,7 +105,7 @@
((1 integer) <- literal 1)
((2 integer) <- literal 3)
((3 integer) <- test1 (1 integer) (2 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
@ -124,7 +124,7 @@
((1 integer) <- literal 1)
((2 integer) <- literal 3)
((3 integer) (7 integer) <- test1 (1 integer) (2 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4 7 3
; add-fn's temporaries
@ -137,7 +137,7 @@
((1 integer) <- literal 1)
((2 integer) <- literal 3)
((3 integer) <- sub (1 integer) (2 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 -2))
(prn "F - 'sub' subtracts the value at one address from the value at another"))
@ -148,7 +148,7 @@
((1 integer) <- literal 2)
((2 integer) <- literal 3)
((3 integer) <- mul (1 integer) (2 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 3 3 6))
(prn "F - 'mul' multiplies like 'add' adds"))
@ -159,7 +159,7 @@
((1 integer) <- literal 8)
((2 integer) <- literal 3)
((3 integer) <- div (1 integer) (2 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 8 2 3 3 (/ real.8 3)))
(prn "F - 'div' divides like 'add' adds"))
@ -170,7 +170,7 @@
((1 integer) <- literal 8)
((2 integer) <- literal 3)
((3 integer) (4 integer) <- idiv (1 integer) (2 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 8 2 3 3 2 4 2))
(prn "F - 'idiv' performs integer division, returning quotient and remainder"))
@ -181,7 +181,7 @@
((1 boolean) <- literal t)
((2 boolean) <- literal nil)
((3 boolean) <- and (1 boolean) (2 boolean)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 t 2 nil 3 nil))
(prn "F - logical 'and' for booleans"))
@ -192,7 +192,7 @@
((1 boolean) <- literal 4)
((2 boolean) <- literal 3)
((3 boolean) <- lt (1 boolean) (2 boolean)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 3 3 nil))
(prn "F - 'lt' is the less-than inequality operator"))
@ -203,7 +203,7 @@
((1 boolean) <- literal 4)
((2 boolean) <- literal 3)
((3 boolean) <- le (1 boolean) (2 boolean)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 3 3 nil))
(prn "F - 'le' is the <= inequality operator"))
@ -214,7 +214,7 @@
((1 boolean) <- literal 4)
((2 boolean) <- literal 4)
((3 boolean) <- le (1 boolean) (2 boolean)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 4 3 t))
(prn "F - 'le' returns true for equal operands"))
@ -225,7 +225,7 @@
((1 boolean) <- literal 4)
((2 boolean) <- literal 5)
((3 boolean) <- le (1 boolean) (2 boolean)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 5 3 t))
(prn "F - le is the <= inequality operator - 2"))
@ -237,7 +237,7 @@
(jmp (1 offset))
((2 integer) <- literal 3)
(reply))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 8))
(prn "F - 'jmp' skips some instructions"))
@ -250,7 +250,7 @@
((2 integer) <- literal 3)
(reply)
((3 integer) <- literal 34))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 8))
(prn "F - 'jmp' doesn't skip too many instructions"))
@ -265,7 +265,7 @@
((2 integer) <- literal 3)
(reply)
((3 integer) <- literal 34))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 1 3 t))
(prn "F - 'jif' is a conditional 'jmp'"))
@ -280,7 +280,7 @@
((4 integer) <- literal 3)
(reply)
((3 integer) <- literal 34))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 2 3 nil 4 3))
(prn "F - if 'jif's first arg is false, it doesn't skip any instructions"))
@ -296,7 +296,7 @@
((4 integer) <- literal 3)
(reply)
((3 integer) <- literal 34))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 4 3 nil 4 3))
(prn "F - 'jif' can take a negative offset to make backward jumps"))
@ -306,7 +306,7 @@
'((main
((1 integer) <- literal 34)
((2 integer) <- copy (1 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 34))
(prn "F - 'copy' performs direct addressing"))
@ -317,7 +317,7 @@
((1 integer-address) <- literal 2)
((2 integer) <- literal 34)
((3 integer) <- copy (1 integer-address deref)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 34 3 34))
(prn "F - 'copy' performs indirect addressing"))
@ -329,7 +329,7 @@
((2 integer) <- literal 34)
((3 integer) <- literal 2)
((1 integer-address deref) <- add (2 integer) (3 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 36 3 2))
(prn "F - instructions can perform indirect addressing on output arg"))
@ -341,7 +341,7 @@
((2 boolean) <- literal nil)
((3 boolean) <- get (1 integer-boolean-pair) (1 offset))
((4 integer) <- get (1 integer-boolean-pair) (0 offset)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 nil 3 nil 4 34))
(prn "F - 'get' accesses fields of records"))
@ -353,7 +353,7 @@
((2 integer) <- literal 35)
((3 integer) <- literal 36)
((4 integer-integer-pair) <- get (1 integer-point-pair) (1 offset)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 35 3 36 4 35 5 36))
(prn "F - 'get' accesses fields spanning multiple locations"))
@ -367,7 +367,7 @@
((4 integer) <- literal 24)
((5 boolean) <- literal t)
((6 integer) <- get (1 integer-boolean-pair-array) (0 offset)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 2))
(prn "F - 'get' accesses length of array"))
@ -381,7 +381,7 @@
((4 integer) <- literal 24)
((5 boolean) <- literal t)
((6 integer-boolean-pair) <- aref (1 integer-boolean-pair-array) (1 offset)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 24 7 t))
(prn "F - 'aref' accesses indices of arrays"))
@ -395,7 +395,7 @@
((2 boolean) <- literal nil)
((4 boolean) <- literal t)
((3 integer-boolean-pair) <- copy (1 integer-boolean-pair)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 nil 3 34 4 nil))
(prn "F - ops can operate on records spanning multiple locations"))
@ -415,12 +415,15 @@
((1 integer) <- literal 1)
((2 integer) <- literal 3)
((3 integer) <- test1 (1 integer) (2 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
4 'integer 5 'integer 6 nil 7 1 8 3 9 4))
(prn "F - an example function that checks that its args are integers"))
;? (quit)
; todo - test that reply increments pc for caller frame after popping current frame
(reset)
(add-fns
@ -444,13 +447,14 @@
((1 boolean) <- literal t)
((2 boolean) <- literal t)
((3 boolean) <- add-fn (1 boolean) (2 boolean)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj ; first call to add-fn
1 t 2 t 3 t
; add-fn's temporaries
4 'boolean 5 'boolean 6 nil 7 t 8 t 9 t))
(prn "F - an example function that can do different things (dispatch) based on the type of its args or oargs"))
;? (quit)
(reset)
(add-fns
@ -477,7 +481,7 @@
((10 integer) <- literal 3)
((11 integer) <- literal 4)
((12 integer) <- add-fn (10 integer) (11 integer)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj ; first call to add-fn
1 t 2 t 3 t
@ -571,7 +575,7 @@
((4 integer) <- literal 34)
}
(reply))))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 4 3 nil 4 34))
(prn "F - continue correctly loops"))
@ -588,7 +592,7 @@
((4 integer) <- literal 34)
}
(reply))))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 4 3 nil 4 34))
(prn "F - continue might never trigger"))
@ -598,7 +602,7 @@
(add-fns
'((main
((1 integer-address) <- new (integer type)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory*.1 before)
(prn "F - 'new' returns current high-water mark"))
@ -610,7 +614,7 @@
(add-fns
'((main
((1 type-array-address) <- new (type-array type) (5 literal)))))
(run function*!main)
(run 'main)
;? (prn memory*)
(if (~iso memory*.1 before)
(prn "F - 'new' returns current high-water mark"))

34
sys.arc
View File

@ -7,8 +7,38 @@
((2 integer) <- literal 2))))
initialization-fns*)
; todo: copy types* info into simulated machine
; todo: sizeof
(enq (fn ()
(build-type-table)
initialization-fns*)
(= Free 3)
(= Type-array Free)
(def build-type-table ()
(allocate-type-array)
(build-types)
(fill-in-type-array))
(def allocate-type-array ()
(= memory*.Free len.types*)
(++ Free)
(++ Free len.types*))
(def build-types ()
(each type types* ; todo
(
(def sizeof (typeinfo)
(if (~or typeinfo!record typeinfo!array)
typeinfo!size
typeinfo!record
(sum idfn
(accum yield
(each elem typeinfo!elems
(yield (sizeof type*.elem)))))
typeinfo!array
(* (sizeof (type* typeinfo!elem))
(
;; 'new' - simple slab allocator. Intended only to carve out isolated memory
;; for different threads/routines as they request.