2014-07-07 01:49:53 +00:00
|
|
|
; things that a future assembler will need separate memory for:
|
|
|
|
; code; types; args channel
|
2014-07-06 08:41:37 +00:00
|
|
|
(def clear ()
|
2014-07-11 05:08:08 +00:00
|
|
|
(= types* (obj
|
|
|
|
integer (obj size 1)
|
2014-07-12 05:53:51 +00:00
|
|
|
type (obj size 1)
|
2014-07-12 04:29:43 +00:00
|
|
|
location (obj size 1)
|
2014-07-12 05:50:55 +00:00
|
|
|
address (obj size 1)
|
|
|
|
boolean (obj size 1)))
|
2014-07-06 08:41:37 +00:00
|
|
|
(= memory* (table))
|
|
|
|
(= function* (table)))
|
|
|
|
(clear)
|
|
|
|
|
2014-07-12 05:26:19 +00:00
|
|
|
; just a convenience until we get an assembler
|
2014-07-17 15:16:22 +00:00
|
|
|
(= type* (obj integer 0 type 1 location 2 address 3 boolean 4))
|
2014-07-12 05:26:19 +00:00
|
|
|
|
2014-07-06 08:41:37 +00:00
|
|
|
(def add-fns (fns)
|
|
|
|
(each (name . body) fns
|
|
|
|
(= function*.name body)))
|
2014-07-06 07:07:03 +00:00
|
|
|
|
2014-07-12 04:53:44 +00:00
|
|
|
(def run (instrs (o fn-args) (o otypes))
|
2014-07-12 04:13:26 +00:00
|
|
|
(ret result nil
|
2014-07-12 04:53:44 +00:00
|
|
|
(let fn-arg-idx 0
|
2014-07-12 04:29:43 +00:00
|
|
|
;? (prn instrs)
|
2014-07-12 04:13:26 +00:00
|
|
|
(for pc 0 (< pc len.instrs) (++ pc)
|
|
|
|
(let instr instrs.pc
|
|
|
|
;? (prn memory*)
|
2014-07-17 15:16:22 +00:00
|
|
|
;? (prn pc ": " instr)
|
2014-07-12 04:13:26 +00:00
|
|
|
(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)
|
|
|
|
(case op
|
|
|
|
loadi
|
|
|
|
(= (memory* oarg.0.1) arg.0)
|
|
|
|
add
|
2014-07-12 05:26:19 +00:00
|
|
|
;? (do (prn "add " arg.0.1 arg.1.1)
|
2014-07-12 04:13:26 +00:00
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(+ (memory* arg.0.1) (memory* arg.1.1)))
|
2014-07-12 05:26:19 +00:00
|
|
|
;? (prn "add2"))
|
2014-07-12 04:13:26 +00:00
|
|
|
sub
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(- (memory* arg.0.1) (memory* arg.1.1)))
|
|
|
|
mul
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(* (memory* arg.0.1) (memory* arg.1.1)))
|
|
|
|
div
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(/ (real (memory* arg.0.1)) (memory* arg.1.1)))
|
|
|
|
idiv
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(trunc:/ (memory* arg.0.1) (memory* arg.1.1))
|
|
|
|
(memory* oarg.1.1)
|
|
|
|
(mod (memory* arg.0.1) (memory* arg.1.1)))
|
2014-07-12 05:50:55 +00:00
|
|
|
and
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(and (memory* arg.0.1) (memory* arg.1.1)))
|
|
|
|
or
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(and (memory* arg.0.1) (memory* arg.1.1)))
|
|
|
|
not
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(not (memory* arg.0.1)))
|
|
|
|
eq
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(iso (memory* arg.0.1) (memory* arg.1.1)))
|
2014-07-12 05:53:51 +00:00
|
|
|
neq
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(~iso (memory* arg.0.1) (memory* arg.1.1)))
|
2014-07-14 04:27:23 +00:00
|
|
|
lt
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(< (memory* arg.0.1) (memory* arg.1.1)))
|
|
|
|
gt
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(> (memory* arg.0.1) (memory* arg.1.1)))
|
|
|
|
le
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(<= (memory* arg.0.1) (memory* arg.1.1)))
|
|
|
|
ge
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(>= (memory* arg.0.1) (memory* arg.1.1)))
|
2014-07-12 04:53:44 +00:00
|
|
|
arg
|
2014-07-12 04:58:33 +00:00
|
|
|
(let idx (if arg
|
|
|
|
arg.0
|
|
|
|
(do1 fn-arg-idx
|
|
|
|
++.fn-arg-idx))
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(memory* fn-args.idx.1)))
|
2014-07-12 05:26:19 +00:00
|
|
|
otype
|
|
|
|
(= (memory* oarg.0.1)
|
|
|
|
(type* (otypes arg.0)))
|
2014-07-12 04:29:43 +00:00
|
|
|
jmp
|
2014-07-12 05:28:51 +00:00
|
|
|
(do (= pc (+ pc arg.0.1)) ; relies on continue still incrementing (bug)
|
2014-07-12 04:29:43 +00:00
|
|
|
;? (prn "jumping to " pc)
|
|
|
|
(continue))
|
2014-07-12 05:50:55 +00:00
|
|
|
jif
|
|
|
|
(when (is t (memory* arg.0.1))
|
2014-07-12 05:26:19 +00:00
|
|
|
;? (prn "jumping to " arg.1.1)
|
2014-07-12 05:28:51 +00:00
|
|
|
(= pc (+ pc arg.1.1)) ; relies on continue still incrementing (bug)
|
2014-07-12 04:29:43 +00:00
|
|
|
(continue))
|
2014-07-12 04:13:26 +00:00
|
|
|
reply
|
|
|
|
(do (= result arg)
|
|
|
|
(break))
|
|
|
|
; else user-defined function
|
2014-07-17 14:04:45 +00:00
|
|
|
(let-or new-body function*.op (prn "no definition for " op)
|
2014-07-12 04:13:26 +00:00
|
|
|
;? (prn "== " memory*)
|
2014-07-17 14:04:45 +00:00
|
|
|
(let results (run new-body arg (map car oarg))
|
2014-07-12 04:22:32 +00:00
|
|
|
(each o oarg
|
|
|
|
;? (prn o)
|
|
|
|
(= (memory* o.1) (memory* pop.results.1)))))
|
2014-07-12 04:13:26 +00:00
|
|
|
)))))
|
|
|
|
;? (prn "return " result)
|
2014-07-12 04:53:44 +00:00
|
|
|
)))
|
2014-07-06 07:07:03 +00:00
|
|
|
|
2014-07-06 08:41:37 +00:00
|
|
|
(awhen cdr.argv
|
|
|
|
(each file it
|
2014-07-07 01:49:53 +00:00
|
|
|
;? (prn file)
|
2014-07-06 08:41:37 +00:00
|
|
|
(add-fns readfile.file))
|
2014-07-07 01:49:53 +00:00
|
|
|
;? (prn function*)
|
2014-07-06 08:41:37 +00:00
|
|
|
(run function*!main)
|
2014-07-06 07:07:03 +00:00
|
|
|
(prn memory*))
|