228 - rudimentary read from channel

2 files changed, 31 insertions, 1 deletions

diff --git a/mu.arc b/mu.arc
index 774da3e0..28009cc5 100644
--- a/mu.arc
+++ b/mu.arc
@@ -819,6 +819,15 @@
   ((free integer-address deref) <- add (free integer-address deref) (1 literal))
   (reply (chan channel)))
 
+(init-fn read
+  ((default-scope scope-address) <- new (scope literal) (30 literal))
+  ((chan channel) <- arg)
+  ((full integer-address) <- get-address (chan channel) (first-full offset))
+  ((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))
+  (reply (result tagged-value) (chan channel)))
+
 ; drop all traces while processing above functions
 (on-init
   (= traces* (queue)))
diff --git a/mu.arc.t b/mu.arc.t
index 08fb19b9..a6d79583 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -1724,7 +1724,7 @@
       ((1 channel-address) <- new-channel (3 literal))
       ((2 integer-address) <- new (integer literal))
       ((2 integer-address deref) <- copy (34 literal))
-      ((3 tagged-value-address) <- new-tagged-value (integer literal) (2 integer-address))
+      ((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)))))
 ;? (set dump-trace*)
 ;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1")))
@@ -1734,4 +1734,25 @@
         (~is 1 (memory* (+ 1 memory*.1))))
   (prn "F - 'write' enqueues item to channel"))
 
+(reset)
+(new-trace "channel-read")
+(add-fns
+  '((main
+      ((1 channel-address) <- new-channel (3 literal))
+      ((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))
+      ((4 tagged-value) (1 channel-address deref) <- read (1 channel-address deref))
+      ((5 integer-address) <- maybe-coerce (4 tagged-value) (integer-address literal)))))
+;? (set dump-trace*)
+;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1")))
+(run 'main)
+;? (prn int-canon.memory*)
+(if (~is memory*.5 memory*.2)
+  (prn "F - 'read' returns written value"))
+(if (or (~is 1 (memory* memory*.1))
+        (~is 1 (memory* (+ 1 memory*.1))))
+  (prn "F - 'read' dequeues item from channel"))
+
 (reset)  ; end file with this to persist the trace for the final test