7 - cleanup 'run'

Finally gave in to permit user-land macros in 'run'. 'm' should translate
to an assembler function to decide what to emit.
This commit is contained in:
Kartik K. Agaram 2014-07-27 10:55:08 -07:00
parent f37b3ab481
commit c8a8fb6efa
1 changed files with 42 additions and 39 deletions

81
mu.arc
View File

@ -17,6 +17,9 @@
(each (name . body) fns (each (name . body) fns
(= function*.name body))) (= function*.name body)))
(mac m (loc)
`(memory* (,loc 1)))
(def run (instrs (o fn-args) (o otypes)) (def run (instrs (o fn-args) (o otypes))
(ret result nil (ret result nil
(let fn-arg-idx 0 (let fn-arg-idx 0
@ -33,77 +36,77 @@
;? (prn op " " oarg) ;? (prn op " " oarg)
(case op (case op
literal literal
(= (memory* oarg.0.1) arg.0) (= (m oarg.0) arg.0)
add add
;? (do (prn "add " arg.0.1 arg.1.1) ;? (do (prn "add " arg.0.1 arg.1.1)
(= (memory* oarg.0.1) (= (m oarg.0)
(+ (memory* arg.0.1) (memory* arg.1.1))) (+ (m arg.0) (m arg.1)))
;? (prn "add2")) ;? (prn "add2"))
sub sub
(= (memory* oarg.0.1) (= (m oarg.0)
(- (memory* arg.0.1) (memory* arg.1.1))) (- (m arg.0) (m arg.1)))
mul mul
(= (memory* oarg.0.1) (= (m oarg.0)
(* (memory* arg.0.1) (memory* arg.1.1))) (* (m arg.0) (m arg.1)))
div div
(= (memory* oarg.0.1) (= (m oarg.0)
(/ (real (memory* arg.0.1)) (memory* arg.1.1))) (/ (real (m arg.0)) (m arg.1)))
idiv idiv
(= (memory* oarg.0.1) (= (m oarg.0)
(trunc:/ (memory* arg.0.1) (memory* arg.1.1)) (trunc:/ (m arg.0) (m arg.1))
(memory* oarg.1.1) (m oarg.1)
(mod (memory* arg.0.1) (memory* arg.1.1))) (mod (m arg.0) (m arg.1)))
and and
(= (memory* oarg.0.1) (= (m oarg.0)
(and (memory* arg.0.1) (memory* arg.1.1))) (and (m arg.0) (m arg.1)))
or or
(= (memory* oarg.0.1) (= (m oarg.0)
(and (memory* arg.0.1) (memory* arg.1.1))) (and (m arg.0) (m arg.1)))
not not
(= (memory* oarg.0.1) (= (m oarg.0)
(not (memory* arg.0.1))) (not (m arg.0)))
eq eq
(= (memory* oarg.0.1) (= (m oarg.0)
(is (memory* arg.0.1) (memory* arg.1.1))) (is (m arg.0) (m arg.1)))
neq neq
(= (memory* oarg.0.1) (= (m oarg.0)
(~is (memory* arg.0.1) (memory* arg.1.1))) (~is (m arg.0) (m arg.1)))
lt lt
(= (memory* oarg.0.1) (= (m oarg.0)
(< (memory* arg.0.1) (memory* arg.1.1))) (< (m arg.0) (m arg.1)))
gt gt
(= (memory* oarg.0.1) (= (m oarg.0)
(> (memory* arg.0.1) (memory* arg.1.1))) (> (m arg.0) (m arg.1)))
le le
(= (memory* oarg.0.1) (= (m oarg.0)
(<= (memory* arg.0.1) (memory* arg.1.1))) (<= (m arg.0) (m arg.1)))
ge ge
(= (memory* oarg.0.1) (= (m oarg.0)
(>= (memory* arg.0.1) (memory* arg.1.1))) (>= (m arg.0) (m arg.1)))
arg arg
(let idx (if arg (let idx (if arg
arg.0 arg.0
(do1 fn-arg-idx (do1 fn-arg-idx
++.fn-arg-idx)) ++.fn-arg-idx))
(= (memory* oarg.0.1) (= (m oarg.0)
(memory* fn-args.idx.1))) (m fn-args.idx)))
otype otype
(= (memory* oarg.0.1) (= (m oarg.0)
(otypes arg.0)) (otypes arg.0))
jmp jmp
(do (= pc (+ pc arg.0.1)) ; relies on continue still incrementing (bug) (do (= pc (+ pc arg.0.1)) ; relies on continue still incrementing (bug)
;? (prn "jumping to " pc) ;? (prn "jumping to " pc)
(continue)) (continue))
jif jif
(when (is t (memory* arg.0.1)) (when (is t (m arg.0))
;? (prn "jumping to " arg.1.1) ;? (prn "jumping to " arg.1.1)
(= pc (+ pc arg.1.1)) ; relies on continue still incrementing (bug) (= pc (+ pc arg.1.1)) ; relies on continue still incrementing (bug)
(continue)) (continue))
copy copy
(= (memory* oarg.0.1) (memory* arg.0.1)) (= (m oarg.0) (m arg.0))
deref deref
(= (memory* oarg.0.1) (= (m oarg.0)
(memory* (memory* arg.0.1))) (m (memory* arg.0)))
reply reply
(do (= result arg) (do (= result arg)
(break)) (break))
@ -113,7 +116,7 @@
(let results (run new-body arg (map car oarg)) (let results (run new-body arg (map car oarg))
(each o oarg (each o oarg
;? (prn o) ;? (prn o)
(= (memory* o.1) (memory* pop.results.1))))) (= (m o) (m pop.results)))))
))))) )))))
;? (prn "return " result) ;? (prn "return " result)
))) )))