diff options
| -rw-r--r-- | mu.arc | 47 | ||||
| -rw-r--r-- | mu.arc.t | 30 |
2 files changed, 41 insertions, 36 deletions
diff --git a/mu.arc b/mu.arc index 2b2971cc..236024b5 100644 --- a/mu.arc +++ b/mu.arc @@ -302,7 +302,7 @@ (= abort-routine* (parameter nil)) (= curr-cycle* 0) (= scheduling-interval* 500) - (= scheduler-switch-table* nil) ; hook into scheduler for tests + (= scheduler-switch-table* nil) ; hook into scheduler for debugging ) ; like arc's 'point' but you can also call ((abort-routine*)) in nested calls @@ -494,13 +494,14 @@ (++ pc.routine*)) (++ curr-cycle*) ;? (trace "run" "-- " int-canon.memory*) ;? 1 - (trace "run" curr-cycle* " " top.routine*!fn-name " " pc.routine* ": " (body.routine* pc.routine*)) +;? (trace "run" curr-cycle*) + (trace "run" label.routine* " " pc.routine* ": " (body.routine* pc.routine*)) ;? (trace "run" routine*) (when (atom (body.routine* pc.routine*)) ; label (when (aand scheduler-switch-table* (alref it (body.routine* pc.routine*))) (++ pc.routine*) - (trace "run" "context-switch forced " abort-routine*) + (trace "run" label.routine* " " pc.routine* ": " "context-switch forced " abort-routine*) ((abort-routine*))) (++ pc.routine*) (continue)) @@ -654,7 +655,7 @@ (case (v arg.0) for-some-cycles (let wakeup-time (+ curr-cycle* (v arg.1)) - (trace "run" "sleeping until " wakeup-time) ; TODO + (trace "run" label.routine* " " pc.routine* ": " "sleeping until " wakeup-time) (= rep.routine*!sleep `(until ,wakeup-time))) until-location-changes (= rep.routine*!sleep `(until-location-changes ,(addr arg.1) ,(m arg.1))) @@ -899,13 +900,13 @@ (pop-stack routine*) (if empty.routine* (return ninstrs)) (let (call-oargs _ call-args) (parse-instr (body.routine* pc.routine*)) - (trace "reply" repr.arg " " repr.call-oargs) +;? (trace "reply" repr.arg " " repr.call-oargs) ;? 1 (each (dest reply-arg val) (zip call-oargs reply-args results) + (trace "run" label.routine* " " pc.routine* ": " repr.val " => " dest) (when nondummy.dest (whenlet argidx (alref metadata.reply-arg 'same-as-arg) (unless (is v.dest (v call-args.argidx)) (die "'same-as-arg' output arg in @repr.reply-args can't bind to @repr.call-oargs"))) - (trace "reply" repr.val " => " dest) (setm dest val)))) (++ pc.routine*) (while (>= pc.routine* (len body.routine*)) @@ -936,10 +937,10 @@ (if (acons results) (each (dest val) (zip oarg results) (unless (is dest '_) - (trace "run" repr.val " => " dest) + (trace "run" label.routine* " " pc.routine* ": " repr.val " => " dest) (setm dest val))) (when oarg ; must be a list - (trace "run" repr.results " => " oarg.0) + (trace "run" label.routine* " " pc.routine* ": " repr.results " => " oarg.0) (setm oarg.0 results))) ) (++ pc.routine*))) @@ -964,16 +965,18 @@ (return v.loc)) (when (is v.loc 'default-space) (return rep.routine*!call-stack.0!default-space)) - (trace "m" loc) +;? (trace "mem" loc) ;? 1 (assert (isa v.loc 'int) "addresses must be numeric (problem in convert-names?): @repr.loc") - (with (n sizeof.loc - addr addr.loc) -;? (trace "m" "reading " n " locations starting at " addr) - (if (is 1 n) - memory*.addr - :else - (annotate 'record - (map memory* (addrs addr n))))))) + (ret result + (with (n sizeof.loc + addr addr.loc) +;? (trace "mem" "reading " n " locations starting at " addr) ;? 1 + (if (is 1 n) + memory*.addr + :else + (annotate 'record + (map memory* (addrs addr n))))) + (trace "mem" loc " => " result)))) (def setm (loc val) ; set memory, respecting metadata ;? (tr 111) @@ -985,16 +988,16 @@ (return)) ;? (tr 120) (assert (isa v.loc 'int) "can't store to non-numeric address (problem in convert-names?)") - (trace "setm" loc " <= " repr.val) +;? (trace "mem" loc " <= " repr.val) ;? 1 (with (n (if (isa val 'record) (len rep.val) 1) addr addr.loc typ typeof.loc) - (trace "setm" "size of " loc " is " n) +;? (trace "mem" "size of " loc " is " n) ;? 1 (assert n "setm: can't compute type of @loc") (assert addr "setm: null pointer @loc") (if (is 1 n) (do (assert (~isa val 'record) "setm: record of size 1 @(tostring prn.val)") - (trace "setm" loc ": setting " addr " to " repr.val) + (trace "mem" loc ": " addr " <= " repr.val) (= memory*.addr val)) (do (if type*.typ!array ; size check for arrays @@ -1007,7 +1010,7 @@ (die "writing to incorrect size @(tostring pr.val) => @loc"))) (let addrs (addrs addr n) (each (dest src) (zip addrs rep.val) - (trace "setm" loc ": setting " dest " to " repr.src) + (trace "mem" loc ": " dest " <= " repr.src) (= memory*.dest src)))))))) (def typeof (operand) @@ -1046,7 +1049,7 @@ (err "can't take len of non-array @operand"))) (def sizeof (x) - (trace "sizeof" x) +;? (trace "sizeof" x) ;? 1 (assert acons.x) (zap canonize x) (point return diff --git a/mu.arc.t b/mu.arc.t index 7eb6a65c..a1fd7b3f 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -163,7 +163,8 @@ ;? (prn memory*) (when (~is memory*.1 23) (prn "F - 'copy' writes its lone 'arg' after the instruction name to its lone 'oarg' or output arg before the arrow. After this test, the value 23 is stored in memory address 1.")) -;? (quit) +;? (reset) ;? 1 +;? (quit) ;? 1 ; Our basic arithmetic ops can operate on memory locations or literals. ; (Ignore hardware details like registers for now.) @@ -180,7 +181,8 @@ ;? (prn memory*) (when (~iso memory* (obj 1 1 2 3 3 4)) (prn "F - 'add' operates on two addresses")) -;? (quit) +;? (reset) ;? 1 +;? (quit) ;? 1 (reset) (new-trace "add-literal") @@ -628,7 +630,7 @@ (7:integer-boolean-pair-array-address <- copy 1:literal) (8:integer-boolean-pair <- index 7:integer-boolean-pair-array-address/deref 6:integer) ]))) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "cvt0" "cvt1"))) ;? (set dump-trace*) (run 'main) ;? (prn memory*) @@ -719,7 +721,7 @@ (7:integer <- length 6:integer-boolean-pair-array-address/deref) ]))) ;? (set dump-trace*) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "cvt0" "cvt1"))) (run 'main) ;? (prn memory*) (when (~is memory*.7 2) @@ -804,7 +806,7 @@ (reset) (new-trace "tagged-value") -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "cvt0" "cvt1"))) (add-code '((function main [ (1:type <- copy integer:literal) @@ -857,7 +859,7 @@ (2:tagged-value-address <- init-tagged-value integer:literal 1:integer) (3:integer 4:boolean <- maybe-coerce 2:tagged-value-address/deref integer:literal) ]))) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1" "sizeof"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "cvt0" "cvt1" "sizeof"))) (run 'main) ;? (prn memory*) (when (or (~is memory*.3 34) @@ -936,7 +938,7 @@ '((function main [ (1:integer <- init-list 3:literal 4:literal 5:literal) ]))) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1" "sizeof"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "cvt0" "cvt1" "sizeof"))) (run 'main) ;? (prn memory*) (let first memory*.1 @@ -2058,7 +2060,7 @@ (2:integer-address/deref <- copy 34:literal) (3:integer/raw <- get 1:integer-boolean-pair-address/deref 0:offset) ]))) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "cvt0" "cvt1"))) (run 'main) ;? (prn memory*) ;? (prn completed-routines*) @@ -2134,7 +2136,7 @@ (7:integer-boolean-pair-array <- copy 6:integer-boolean-pair-array-address/deref) ]))) ;? (set dump-trace*) -;? (= dump-trace* (obj whitelist '("run" "m" "sizeof"))) +;? (= dump-trace* (obj whitelist '("run" "mem" "sizeof"))) (run 'main) ;? (prn memory*) (each routine completed-routines* @@ -3263,7 +3265,7 @@ ]))) ;? (prn function*!write) ;? (set dump-trace*) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "array-len" "cvt0" "cvt1"))) ;? (= dump-trace* (obj whitelist '("jump"))) ;? (= dump-trace* (obj whitelist '("run" "reply"))) (run 'main) @@ -3289,7 +3291,7 @@ (9:integer <- get 1:channel-address/deref first-free:offset) ]))) ;? (set dump-trace*) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "array-len" "cvt0" "cvt1"))) (run 'main) ;? (prn int-canon.memory*) (when (~is memory*.7 34) @@ -3317,7 +3319,7 @@ (6:integer <- get 1:channel-address/deref first-free:offset) ]))) ;? (set dump-trace*) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "array-len" "cvt0" "cvt1"))) (run 'main) ;? (prn canon.memory*) (when (or (~is 1 memory*.5) @@ -3345,7 +3347,7 @@ (6:integer <- get 1:channel-address/deref first-full:offset) ]))) ;? (set dump-trace*) -;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +;? (= dump-trace* (obj blacklist '("sz" "mem" "addr" "array-len" "cvt0" "cvt1"))) (run 'main) ;? (prn canon.memory*) (when (or (~is 1 memory*.5) @@ -4857,7 +4859,7 @@ (prn "F - 'setm' checks that array written is well-formed")) (= routine* make-routine!foo) ;? (prn 111) -;? (= dump-trace* (obj whitelist '("sizeof" "setm"))) +;? (= dump-trace* (obj whitelist '("sizeof" "mem"))) (setm '((4 integer-boolean-pair-array)) (annotate 'record '(2 31 nil 32 nil 33))) (when (~posmatch "invalid array" rep.routine*!error) (prn "F - 'setm' checks that array of records is well-formed")) |