about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2014-10-11 11:17:04 -0700
committerKartik K. Agaram <vc@akkartik.com>2014-10-11 11:17:04 -0700
commit1714bd1d50048ae177df6f8c2859ebe2cfd32f30 (patch)
tree8ba68d40d25f07c4a54a36636070112abc13a60f
parent639fd2fb54fde7dae2444678b1ecec6c8b376e07 (diff)
downloadmu-1714bd1d50048ae177df6f8c2859ebe2cfd32f30.tar.gz
131 - maybe-coerce now allocates new space each call
(Doesn't reclaim yet. Need to build free soon. Then lexical scopes..)

This commit showed the benefits of my persisting traces. I realized I
needed 'sz' to handle 'deref' args. But I vaguely remembered some
earlier instance when some primitive needed to recognize 'deref'
at some times but not others. Was it 'sz'? Just added a trace on
operands, reran all tests, grepped for deref.

  $ grep sz .traces -r |grep deref

Nothing would fail. Ok, add 'deref' support. Boom, 3 layers of tests
passed.

Still concerned I'm not using traces enough. Keep vigilant.

Mixing print and trace seems like a bad idea. From now on whenever I use
any existing commented-out prn's I'm going to turn them into trace
calls. That should put pressure on comprehending traces, and tools for
doing that, like segmenting by dynamic and static layers.
-rw-r--r--mu.arc39
-rw-r--r--mu.arc.t34
2 files changed, 56 insertions, 17 deletions
diff --git a/mu.arc b/mu.arc
index 1a82c2c5..f202a3a3 100644
--- a/mu.arc
+++ b/mu.arc
@@ -90,9 +90,13 @@
   (types* ty.operand))
 
 (def sz (operand)
-;?   (prn "sz " operand)
+  (trace "sz" operand)
   (if (is 'literal ty.operand)
         'literal
+      (pos 'deref metadata.operand)
+        (do (assert typeinfo.operand!address)
+            (sz (list (m `(,(v operand) location))
+                      typeinfo.operand!elem)))
       (let-or it typeinfo.operand (err "no such type: @operand")
         (if it!array
           array-len.operand
@@ -113,7 +117,7 @@
       (++ n))))
 
 (def m (loc)  ; read memory, respecting metadata
-;?   (prn "m " loc " " sz.loc)
+  (trace "m" loc " " sz.loc)
   (if (is 'literal ty.loc)
         (v loc)
       (is 1 sz.loc)
@@ -123,13 +127,17 @@
                   (map memory* (addrs addr.loc sz.loc)))))
 
 (def setm (loc val)  ; set memory, respecting metadata
-;?   (prn "setm " loc " " val)
-  (assert sz.loc)
-  (if (is 1 sz.loc)
-    (= (memory* addr.loc) val)
-    (each (dest src) (zip (addrs addr.loc sz.loc)
-                          (rep val))
-      (= (memory* dest) src))))
+  (trace "setm" loc " <= " val)
+  (let n sz.loc
+    (trace "size of " loc " is " n)
+    (assert n)
+    (if (is 1 n)
+      (do (assert (~isa val 'record))
+          (= (memory* addr.loc) val))
+      (do (assert (isa val 'record))
+          (each (dest src) (zip (addrs addr.loc n)
+                                (rep val))
+            (= (memory* dest) src))))))
 
 (def array-len (operand)
 ;?   (prn operand)
@@ -235,7 +243,7 @@
         (pop-stack context)
         (if empty.context (return ninstrs))
         (++ pc.context))
-;?       (prn memory*)
+      (trace "run" "-- " memory*)
       (trace "run" top.context!fn-name " " pc.context ": " (body.context pc.context))
 ;?       (prn "--- " top.context!fn-name " " pc.context ": " (body.context pc.context))
       (let (oarg op arg)  (parse-instr (body.context pc.context))
@@ -388,7 +396,7 @@
                              arg.0
                              (do1 caller-arg-idx.context
                                 (++ caller-arg-idx.context)))
-;?                     (prn arg " " idx " " caller-args.context)
+                    (trace "arg" arg " " idx " " caller-args.context)
                     (m caller-args.context.idx))
                 type
                   (ty (caller-args.context arg.0))
@@ -421,7 +429,7 @@
                 (for i 0 (< i (min len.tmp len.oarg)) ++.i
                   (setm oarg.i tmp.i))
                 (when oarg  ; must be a list
-;?                   (prn oarg.0)
+                  (trace "run" "writing to oarg " tmp " => " oarg.0)
                   (setm oarg.0 tmp)))
               )
         (++ pc.context)))
@@ -541,15 +549,16 @@
 ;; system software
 
 (init-fn maybe-coerce
-  ((23 tagged-value) <- arg)
+  ((x tagged-value-address) <- new (tagged-value type))
+  ((x tagged-value-address deref) <- arg)
   ((p type) <- arg)
-  ((xtype type) <- get (23 tagged-value) (0 offset))
+  ((xtype type) <- get (x tagged-value-address deref) (0 offset))
   ((match? boolean) <- eq (xtype type) (p type))
   { begin
     (breakif (match? boolean))
     (reply (0 literal) (nil boolean))
   }
-  ((xvalue location) <- get (23 tagged-value) (1 offset))
+  ((xvalue location) <- get (x tagged-value-address deref) (1 offset))
   (reply (xvalue location) (match? boolean)))
 
 ; drop all traces while processing above functions
diff --git a/mu.arc.t b/mu.arc.t
index a6ced345..14e5dfc5 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -139,6 +139,7 @@
               integer-point-pair (obj size 2  record t  elems '(integer integer-integer-pair))
               ; tagged-values are the foundation of dynamic types
               tagged-value (obj size 2  record t  elems '(type location))
+              tagged-value-address (obj size 1  address t  elem 'tagged-value)
               )))
 
 ; Our language is assembly-like in that functions consist of series of
@@ -584,10 +585,10 @@
 (if (~is memory*.1 3)
   (prn "F - 'sizeof' is different from number of elems"))
 
-; Regardless of a type's length, you can move it around with 'copy'.
+; Regardless of a type's length, you can move it around just like a primitive.
 
 (reset)
-(new-trace "compound-operand")
+(new-trace "compound-operand-copy")
 (add-fns
   '((test1
       ((1 integer) <- copy (34 literal))
@@ -599,6 +600,35 @@
 (if (~iso memory* (obj 1 34  2 nil  3 34  4 nil))
   (prn "F - ops can operate on records spanning multiple locations"))
 
+(reset)
+(new-trace "compound-arg")
+(add-fns
+  '((test1
+      ((4 integer-boolean-pair) <- arg))
+    (main
+      ((1 integer) <- copy (34 literal))
+      ((2 boolean) <- copy (nil literal))
+      (test1 (1 integer-boolean-pair)))))
+(run 'main)
+(if (~iso memory* (obj 1 34  2 nil  4 34  5 nil))
+  (prn "F - 'arg' can copy records spanning multiple locations"))
+
+(reset)
+(new-trace "compound-arg")
+;? (set dump-trace*)
+(add-fns
+  '((test1
+      ((4 integer-boolean-pair) <- arg))
+    (main
+      ((1 integer) <- copy (34 literal))
+      ((2 boolean) <- copy (nil literal))
+      ((3 integer-boolean-pair-address) <- copy (1 literal))
+      (test1 (3 integer-boolean-pair-address deref)))))
+(run 'main)
+;? (prn memory*)
+(if (~iso memory* (obj 1 34  2 nil  3 1  4 34  5 nil))
+  (prn "F - 'arg' can copy records spanning multiple locations in indirect mode"))
+
 ; A special kind of record is the 'tagged type'. It lets us represent
 ; dynamically typed values, which save type information in memory rather than
 ; in the code to use them. This will let us do things like create heterogenous