diff --git a/mu.arc b/mu.arc index 1a342b77..d9e96210 100644 --- a/mu.arc +++ b/mu.arc @@ -431,18 +431,22 @@ ; control flow jump (do (= pc.routine* (+ 1 pc.routine* (v arg.0))) -;? (trace "jump" "jumping to " pc.routine*) + (trace "jump" "jumping to " pc.routine*) (continue)) jump-if - (when (is t (m arg.0)) - (= pc.routine* (+ 1 pc.routine* (v arg.1))) -;? (trace "jump-if" "jumping to " pc.routine*) - (continue)) + (let flag (m arg.0) + (trace "jump" "checking that " flag " is t") + (when (is t flag) + (= pc.routine* (+ 1 pc.routine* (v arg.1))) + (trace "jump" "jumping to " pc.routine*) + (continue))) jump-unless ; convenient helper - (unless (is t (m arg.0)) - (= pc.routine* (+ 1 pc.routine* (v arg.1))) -;? (trace "jump-unless" "jumping to " pc.routine*) - (continue)) + (let flag (m arg.0) + (trace "jump" "checking that " flag " is not t") + (unless (is t flag) + (= pc.routine* (+ 1 pc.routine* (v arg.1))) + (trace "jump" "jumping to " pc.routine*) + (continue))) ; data management: scalars, arrays, records copy @@ -858,6 +862,12 @@ ((dest tagged-value-address) <- index-address (q tagged-value-array-address deref) (free integer-address deref)) ((dest tagged-value-address deref) <- copy (val tagged-value)) ((free integer-address deref) <- add (free integer-address deref) (1 literal)) + { begin + ((qlen integer) <- len (q tagged-value-array-address deref)) + ((remaining? boolean) <- lt (free integer-address deref) (qlen integer)) + (break-if (remaining? boolean)) + ((free integer-address deref) <- copy (0 literal)) + } ((watch boolean-address) <- get-address (chan channel) (write-watch offset)) ((watch boolean-address deref) <- copy (t literal)) (reply (chan channel))) @@ -869,6 +879,12 @@ ((q tagged-value-array-address) <- get (chan channel) (circular-buffer offset)) ((result tagged-value) <- index (q tagged-value-array-address deref) (full integer-address deref)) ((full integer-address deref) <- add (full integer-address deref) (1 literal)) + { begin + ((qlen integer) <- len (q tagged-value-array-address deref)) + ((remaining? boolean) <- lt (full integer-address deref) (qlen integer)) + (break-if (remaining? boolean)) + ((full integer-address deref) <- copy (0 literal)) + } ((watch boolean-address) <- get-address (chan channel) (read-watch offset)) ((watch boolean-address deref) <- copy (t literal)) (reply (result tagged-value) (chan channel))) diff --git a/mu.arc.t b/mu.arc.t index 0931ffdd..756b8bab 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -1851,11 +1851,13 @@ ((5 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 whitelist '("jump"))) (run 'main) -;? (prn memory*) +;? (prn canon.memory*) (if (or (~is 0 memory*.4) (~is 1 memory*.5)) (prn "F - 'write' enqueues item to channel")) +;? (quit) (reset) (new-trace "channel-read") @@ -1913,4 +1915,58 @@ (~is t memory*.5)) (prn "F - 'read' sets channel watch")) +(reset) +(new-trace "channel-write-wrap") +(add-fns + '((main + ; channel with 2 slots (capacity 1 since we waste a slot) + ((1 channel-address) <- new-channel (2 literal)) + ; write a value + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ; first-free will now be 1 + ((4 integer) <- get (1 channel-address deref) (first-free offset)) + ; read one value + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ; write a second value; verify that first-free wraps around to 0. + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((5 integer) <- get (1 channel-address deref) (first-free offset))))) +;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +(run 'main) +;? (prn canon.memory*) +(if (or (~is 1 memory*.4) + (~is 0 memory*.5)) + (prn "F - 'write' can wrap pointer back to start")) + +(reset) +(new-trace "channel-read-wrap") +(add-fns + '((main + ; channel with 2 slots (capacity 1 since we waste a slot) + ((1 channel-address) <- new-channel (2 literal)) + ; write a value + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ; read one value + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ; first-full will now be 1 + ((4 integer) <- get (1 channel-address deref) (first-full offset)) + ; write a second value + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ; read second value; verify that first-full wraps around to 0. + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ((5 integer) <- get (1 channel-address deref) (first-full offset))))) +;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +(run 'main) +;? (prn canon.memory*) +(if (or (~is 1 memory*.4) + (~is 0 memory*.5)) + (prn "F - 'read' can wrap pointer back to start")) + (reset) ; end file with this to persist the trace for the final test