256 - channel pointers can now wrap

2 files changed, 82 insertions, 10 deletions

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