diff options
| -rw-r--r-- | mu.arc | 147 | ||||
| -rw-r--r-- | mu.arc.t | 11 |
2 files changed, 88 insertions, 70 deletions
diff --git a/mu.arc b/mu.arc index 2c204777..4ccd9b33 100644 --- a/mu.arc +++ b/mu.arc @@ -9,7 +9,7 @@ initialization-fns*)) (mac init-fn (name . body) - `(enq (fn () (= (function* ',name) (convert-braces ',body))) + `(enq (fn () (= (function* ',name) (convert-names:convert-braces ',body))) initialization-fns*)) ; things that a future assembler will need separate memory for: @@ -78,13 +78,14 @@ (= traces* (queue))) (def new-trace (filename) -;? (prn "new-trace " filename) + (prn "new-trace " filename) (= curr-trace-file* filename)) (= dump-trace* nil) (def trace (label . args) ;? (prn "trace: " dump-trace*) - (if dump-trace* (apply prn label ": " args)) + (when (and dump-trace* (~pos label dump-trace*!blacklist)) + (apply prn label ": " args)) (enq (list label (apply tostring:prn args)) traces*)) @@ -149,6 +150,7 @@ (err "type @typename doesn't have a size: " (tostring:pr types*.typename)))) (def addr (loc) +;? (trace "addr" loc) (ret result v.loc (unless (pos 'global metadata.loc) (whenlet base rep.routine*!call-stack.0!default-scope @@ -168,6 +170,8 @@ (point return (if (in ty.loc 'literal 'offset) (return v.loc)) + (when (is v.loc 'default-scope) + (return rep.routine*!call-stack.0!default-scope)) (assert (isa v.loc 'int)) (trace "m" loc " " sz.loc) (if (is 1 sz.loc) @@ -316,7 +320,7 @@ (++ pc.routine*)) (trace "run" "-- " (sort (compare < string:car) (as cons memory*))) (trace "run" top.routine*!fn-name " " pc.routine* ": " (body.routine* pc.routine*)) -;? (prn "--- " top.routine*!fn-name " " pc.routine* ": " (body.routine* pc.routine*)) +;? (trace "run" routine*) (let (oarg op arg) (parse-instr (body.routine* pc.routine*)) ;? (prn op " " arg " -> " oarg) (let tmp @@ -380,34 +384,38 @@ copy (m arg.0) get - (with (base arg.0 ; integer (non-symbol) memory location including metadata + (with (base (addr arg.0) ; integer (non-symbol) memory location including metadata + basetype (typeinfo arg.0) idx (v arg.1)) ; literal integer -;? (prn base ": " (memory* v.base)) - (assert (in (ty arg.1) 'literal 'offset)) - (when typeinfo.base!address - (assert (pos 'deref metadata.base)) - (= base (list (memory* v.base) typeinfo.base!elem))) -;? (prn "after: " base) - (if typeinfo.base!record - (do (assert (< -1 idx (len typeinfo.base!elems))) - (m `(,(+ v.base + (assert (is 'offset (ty arg.1))) + (when (pos 'deref (metadata arg.0)) + (assert basetype!address) + (= basetype (types* basetype!elem)) + ) + (if basetype!record + (do (assert (< -1 idx (len basetype!elems))) + (m `(,(+ base (apply + (map sz - (firstn idx typeinfo.base!elems)))) - ,typeinfo.base!elems.idx))) + (firstn idx basetype!elems)))) + ,basetype!elems.idx + global)) + ) (assert nil "get on invalid type @base"))) get-address - (with (base arg.0 - idx (v arg.1)) - (trace "get-address" base "." idx) - (when typeinfo.base!address - (assert (pos 'deref metadata.base)) - (= base (list (memory* v.base) typeinfo.base!elem))) - (trace "get-address" "after: " base) - (if typeinfo.base!record - (do (assert (< -1 idx (len typeinfo.base!elems))) - (+ v.base + (with (base (addr arg.0) ; integer (non-symbol) memory location including metadata + basetype (typeinfo arg.0) + idx (v arg.1)) ; literal integer + (assert (is 'offset (ty arg.1))) + (when (pos 'deref (metadata arg.0)) + (assert basetype!address) + (= basetype (types* basetype!elem)) + ) + (if basetype!record + (do (assert (< -1 idx (len basetype!elems))) + (+ base (apply + (map sz - (firstn idx typeinfo.base!elems))))) + (firstn idx basetype!elems)))) + ) (assert nil "get-address on invalid type @base"))) index (with (base arg.0 ; integer (non-symbol) memory location including metadata @@ -510,11 +518,11 @@ (continue))) ; else try to call as a user-defined function (do (if function*.op - (do (push-stack routine* op) - (= caller-args.routine* - (accum yield - (each a arg - (yield (m a)))))) + (let callee-args (accum yield + (each a arg + (yield (m a)))) + (push-stack routine* op) + (= caller-args.routine* callee-args)) (err "no such op @op")) (continue)) ) @@ -711,56 +719,61 @@ ;; system software (init-fn maybe-coerce - ((101 tagged-value-address) <- new (tagged-value literal)) - ((101 tagged-value-address deref) <- arg) - ((102 type) <- arg) - ((103 type) <- get (101 tagged-value-address deref) (0 offset)) - ((104 boolean) <- eq (103 type) (102 type)) + ((default-scope scope-address) <- new (scope literal) (30 literal)) + ((x tagged-value-address) <- new (tagged-value literal)) + ((x tagged-value-address deref) <- arg) + ((p type) <- arg) + ((xtype type) <- get (x tagged-value-address deref) (0 offset)) + ((match? boolean) <- eq (xtype type) (p type)) { begin - (break-if (104 boolean)) + (break-if (match? boolean)) (reply (0 literal) (nil literal)) } - ((105 location) <- get (101 tagged-value-address deref) (1 offset)) - (reply (105 location) (104 boolean))) + ((xvalue location) <- get (x tagged-value-address deref) (1 offset)) + (reply (xvalue location) (match? boolean))) (init-fn new-tagged-value - ((201 type) <- arg) - ((202 integer) <- sizeof (201 type)) - ((203 boolean) <- eq (202 integer) (1 literal)) - (assert (203 boolean)) + ((default-scope scope-address) <- new (scope literal) (30 literal)) + ((xtype type) <- arg) + ((xtypesize integer) <- sizeof (xtype type)) + ((xcheck boolean) <- eq (xtypesize integer) (1 literal)) + (assert (xcheck boolean)) ; todo: check that arg 0 matches the type? or is that for the future typechecker? - ((204 tagged-value-address) <- new (tagged-value literal)) - ((205 location) <- get-address (204 tagged-value-address deref) (0 offset)) - ((205 location deref) <- copy (201 type)) - ((206 location) <- get-address (204 tagged-value-address deref) (1 offset)) - ((206 location deref) <- arg) - (reply (204 tagged-value-address))) + ((result tagged-value-address) <- new (tagged-value literal)) + ((resulttype location) <- get-address (result tagged-value-address deref) (0 offset)) + ((resulttype location deref) <- copy (xtype type)) + ((locaddr location) <- get-address (result tagged-value-address deref) (1 offset)) + ((locaddr location deref) <- arg) + (reply (result tagged-value-address))) (init-fn list-next ; list-address -> list-address - ((301 list-address) <- arg) - ((302 list-address) <- get (301 list-address deref) (1 offset)) - (reply (302 list-address))) + ((default-scope scope-address) <- new (scope literal) (30 literal)) + ((base list-address) <- arg) + ((result list-address) <- get (base list-address deref) (1 offset)) + (reply (result list-address))) (init-fn list-value-address ; list-address -> tagged-value-address - ((401 list-address) <- arg) - ((402 tagged-value-address) <- get-address (401 list-address deref) (0 offset)) - (reply (402 tagged-value-address))) + ((default-scope scope-address) <- new (scope literal) (30 literal)) + ((base list-address) <- arg) + ((result tagged-value-address) <- get-address (base list-address deref) (0 offset)) + (reply (result tagged-value-address))) (init-fn new-list - ((501 list-address) <- new (list literal)) - ((502 list-address) <- copy (501 list-address)) + ((default-scope scope-address) <- new (scope literal) (30 literal)) + ((new-list-result list-address) <- new (list literal)) + ((curr list-address) <- copy (new-list-result list-address)) { begin - ((503 integer) (504 boolean) <- arg) - (break-unless (504 boolean)) - ((505 list-address-address) <- get-address (502 list-address deref) (1 offset)) - ((505 list-address-address deref) <- new (list literal)) - ((502 list-address) <- list-next (502 list-address)) - ((506 tagged-value-address) <- list-value-address (502 list-address)) - ((506 tagged-value-address deref) <- save-type (503 integer)) + ((curr-value integer) (exists? boolean) <- arg) + (break-unless (exists? boolean)) + ((next list-address-address) <- get-address (curr list-address deref) (1 offset)) + ((next list-address-address deref) <- new (list literal)) + ((curr list-address) <- list-next (curr list-address)) + ((dest tagged-value-address) <- list-value-address (curr list-address)) + ((dest tagged-value-address deref) <- save-type (curr-value integer)) (continue) } - ((501 list-address) <- list-next (501 list-address)) ; memory leak - (reply (501 list-address))) + ((new-list-result list-address) <- list-next (new-list-result list-address)) ; memory leak + (reply (new-list-result list-address))) ; drop all traces while processing above functions (on-init diff --git a/mu.arc.t b/mu.arc.t index 6f26ec7d..3d8358ea 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -415,6 +415,7 @@ ((2 boolean) <- copy (nil literal)) ((3 boolean) <- get (1 integer-boolean-pair) (1 offset)) ((4 integer) <- get (1 integer-boolean-pair) (0 offset))))) +;? (set dump-trace*) (run 'main) ;? (prn memory*) (if (~iso memory* (obj 1 34 2 nil 3 nil 4 34)) @@ -429,6 +430,7 @@ ((3 integer-boolean-pair-address) <- copy (1 literal)) ((4 boolean) <- get (3 integer-boolean-pair-address deref) (1 offset)) ((5 integer) <- get (3 integer-boolean-pair-address deref) (0 offset))))) +;? (set dump-trace*) (run 'main) ;? (prn memory*) (if (~iso memory* (obj 1 34 2 nil 3 1 4 nil 5 34)) @@ -613,7 +615,7 @@ (reset) (new-trace "tagged-value") -;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) (add-fns '((main ((1 type) <- copy (integer-address literal)) @@ -621,8 +623,10 @@ ((3 integer-address) (4 boolean) <- maybe-coerce (1 tagged-value) (integer-address literal))))) (run 'main) ;? (prn memory*) +;? (prn completed-routines*) (if (or (~is memory*.3 34) (~is memory*.4 t)) (prn "F - 'maybe-coerce' copies value only if type tag matches")) +;? (quit) (reset) (new-trace "tagged-value-2") @@ -650,16 +654,17 @@ (reset) (new-trace "new-tagged-value") -;? (set dump-trace*) (add-fns '((main ((1 integer-address) <- copy (34 literal)) ; pointer to nowhere ((2 tagged-value-address) <- new-tagged-value (integer-address literal) (1 integer-address)) ((3 integer-address) (4 boolean) <- maybe-coerce (2 tagged-value-address deref) (integer-address literal))))) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1" "sizeof"))) (run 'main) ;? (prn memory*) (if (or (~is memory*.3 34) (~is memory*.4 t)) (prn "F - 'new-tagged-value' is the converse of 'maybe-coerce'")) +;? (quit) ; Now that we can record types for values we can construct a dynamically typed ; list. @@ -720,7 +725,7 @@ (add-fns '((main ((1 integer) <- new-list (3 literal) (4 literal) (5 literal))))) -;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1" "sizeof"))) (run 'main) ;? (prn memory*) (let first memory*.1 |