From 1714bd1d50048ae177df6f8c2859ebe2cfd32f30 Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Sat, 11 Oct 2014 11:17:04 -0700 Subject: 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. --- mu.arc | 39 ++++++++++++++++++++++++--------------- mu.arc.t | 34 ++++++++++++++++++++++++++++++++-- 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 -- cgit 1.4.1-2-gfad0