From f27613a982b8a0d216802adfe22178c6670e40f5 Mon Sep 17 00:00:00 2001
From: "Kartik K. Agaram" <vc@akkartik.com>
Date: Tue, 4 Nov 2014 13:34:59 -0800
Subject: 222 - trace cleanup

---
 mu.arc | 48 +++++++++++++++++++++++++++++++++++-------------
 1 file changed, 35 insertions(+), 13 deletions(-)

diff --git a/mu.arc b/mu.arc
index a75aab00..be5b014c 100644
--- a/mu.arc
+++ b/mu.arc
@@ -160,14 +160,17 @@
       (err "type @typename doesn't have a size: " (tostring:pr types*.typename))))
 
 (def addr (loc)
-;?   (trace "addr" loc)
+  (trace "addr" loc)
   (ret result v.loc
+    (trace "addr" "initial result: " result)
     (unless (pos 'global metadata.loc)
       (whenlet base rep.routine*!call-stack.0!default-scope
         (if (< result memory*.base)
-           (++ result base)
-           (die "addr: no room for var @result"))))
+          (do (trace "addr" "incrementing by " base)
+              (++ result base))
+          (die "addr: no room for var @result"))))
     (when (pos 'deref metadata.loc)
+      (trace "addr" "deref " result " => " memory*.result)
       (zap memory* result))))
 
 (def addrs (n sz)
@@ -198,15 +201,19 @@
       (return))
     (assert (isa v.loc 'int) "can't store to non-numeric address (problem in convert-names?)")
     (trace "setm" loc " <= " val)
-    (let n sz.loc
+    (with (n  sz.loc
+           addr  addr.loc)
       (trace "setm" "size of " loc " is " n)
       (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 @val")
-            (= (memory* addr.loc) val))
+            (trace "setm" loc ": setting " addr " to " val)
+            (= (memory* addr) val))
         (do (assert (isa val 'record) "setm: non-record of size >1 @val")
-            (each (dest src) (zip (addrs addr.loc n)
+            (each (dest src) (zip (addrs addr n)
                                   (rep val))
+              (trace "setm" loc ": setting " dest " to " src)
               (= (memory* dest) src)))))))
 
 ; (operand field-offset) -> (base-addr field-type)
@@ -214,34 +221,44 @@
 ; operand can be scope-based
 ; base-addr returned is always global
 (def record-info (operand field-offset)
+  (trace "record-info" operand " " field-offset)
   (assert (is 'offset (ty field-offset)) "record index @field-offset must have type 'offset'")
   (with (base  addr.operand
          basetype  typeinfo.operand
          idx  (v field-offset))
+    (trace "record-info" "initial base " base " type " canon.basetype)
     (when (pos 'deref metadata.operand)
       (assert basetype!address "@operand requests deref, but it's not an address of a record")
-      (= basetype (types* basetype!elem)))
+      (= basetype (types* basetype!elem))
+      (trace "record-info" operand " requests deref => " canon.basetype))
     (assert basetype!record "get on non-record @operand")
     (assert (< -1 idx (len basetype!elems)) "@idx is out of bounds of record @operand")
     (list (+ base (apply + (map sz (firstn idx basetype!elems))))
           basetype!elems.idx)))
 
 (def array-info (operand offset)
+  (trace "array-info" operand " " offset)
   (with (base  addr.operand
          basetype  typeinfo.operand
          idx  (m offset))
+    (trace "array-info" "initial base " base " type " canon.basetype)
     (when (pos 'deref metadata.operand)
       (assert basetype!address "@operand requests deref, but it's not an address of an array")
-      (= basetype (types* basetype!elem)))
+      (= basetype (types* basetype!elem))
+      (trace "array-info" operand " requests deref => " canon.basetype))
     (assert basetype!array "index on non-array @operand")
-    (unless (< -1 idx array-len.operand)
-      (die "@idx is out of bounds of array @operand"))
+    (let array-len array-len.operand
+      (trace "array-info" "array-len of " operand " is " array-len)
+      (assert array-len "can't compute array-len of @operand")
+      (unless (< -1 idx array-len)
+        (die "@idx is out of bounds of array @operand")))
     (list (+ base
              1  ; for array size
              (* idx (sz basetype!elem)))
           basetype!elem)))
 
 (def array-len (operand)
+  (trace "array-len" operand)
   (if typeinfo.operand!array
         (m `(,v.operand integer))
       (and typeinfo.operand!address (pos 'deref metadata.operand))
@@ -342,7 +359,7 @@
         (pop-stack routine*)
         (if empty.routine* (return ninstrs))
         (++ pc.routine*))
-      (trace "run" "-- " (sort (compare < string:car) (as cons memory*)))
+      (trace "run" "-- " canon.memory*)
       (trace "run" top.routine*!fn-name " " pc.routine* ": " (body.routine* pc.routine*))
 ;?       (trace "run" routine*)
       (let (oarg op arg)  (parse-instr (body.routine* pc.routine*))
@@ -409,17 +426,19 @@
                   (m arg.0)
                 get
                   (let (addr type)  (record-info arg.0 arg.1)
-;?                     (prn addr " " type)
+                    (trace "get" arg.0 " " arg.1 " => " addr " " type)
                     (m `(,addr ,type global)))
                 get-address
                   (let (addr _)  (record-info arg.0 arg.1)
+                    (trace "get-address" arg.0 " " arg.1 " => " addr)
                     addr)
                 index
                   (let (addr type)  (array-info arg.0 arg.1)
-;?                     (prn arg.0 " " arg.1 " => " addr " " type)
+                    (trace "index" arg.0 " " arg.1 " => " addr " " type)
                     (m `(,addr ,type global)))
                 index-address
                   (let (addr _)  (array-info arg.0 arg.1)
+                    (trace "index-address" arg.0 " " arg.1 " => " addr)
                     addr)
                 new
                   (let type (v arg.0)
@@ -796,6 +815,9 @@
   (pr msg)
   (apply prn args))
 
+(def canon (table)
+  (sort (compare < string:car) (as cons table)))
+
 ;; after loading all files, start at 'main'
 (reset)
 (awhen cdr.argv
-- 
cgit 1.4.1-2-gfad0