diff options
-rw-r--r-- | mu.arc | 27 | ||||
-rw-r--r-- | mu.arc.t | 14 |
2 files changed, 20 insertions, 21 deletions
diff --git a/mu.arc b/mu.arc index 9a521451..4253b6d0 100644 --- a/mu.arc +++ b/mu.arc @@ -120,6 +120,7 @@ integer-boolean-pair-array-address (obj size 1 address t elem 'integer-boolean-pair-array) integer-integer-pair (obj size 2 record t elems '(integer integer)) integer-point-pair (obj size 2 record t elems '(integer integer-integer-pair)) + integer-point-pair-address (obj size 1 address t elem 'integer-point-pair) ; tagged-values are the foundation of dynamic types tagged-value (obj size 2 record t elems '(type location) fields '(type payload)) tagged-value-address (obj size 1 address t elem 'tagged-value) @@ -548,7 +549,7 @@ (return rep.routine*!call-stack.0!default-scope)) (trace "m" loc) (assert (isa v.loc 'int) "addresses must be numeric (problem in convert-names?) @loc") - (with (n sz.loc + (with (n sizeof.loc addr addr.loc) ;? (trace "m" "reading " n " locations starting at " addr) (if (is 1 n) @@ -560,12 +561,12 @@ (def setm (loc val) ; set memory, respecting metadata (point return (when (is v.loc 'default-scope) - (assert (is 1 sz.loc) "can't store compounds in default-scope @loc") + (assert (is 1 sizeof.loc) "can't store compounds in default-scope @loc") (= rep.routine*!call-stack.0!default-scope val) (return)) (assert (isa v.loc 'int) "can't store to non-numeric address (problem in convert-names?)") (trace "setm" loc " <= " val) - (with (n sz.loc + (with (n sizeof.loc addr addr.loc) (trace "setm" "size of " loc " is " n) (assert n "setm: can't compute type of @loc") @@ -580,22 +581,6 @@ (trace "setm" loc ": setting " dest " to " src) (= (memory* dest) src))))))) -(def sz (operand) - (trace "sz" operand) - (if (is 'literal ty.operand) - 'literal - (pos 'deref metadata.operand) - (do (assert typeinfo.operand!address "tried to deref non-address @operand") - (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 - it!size)))) -(defextend sz (typename) (isa typename 'sym) - (or types*.typename!size - (err "type @typename doesn't have a size: " (tostring:pr types*.typename)))) - (def addr (operand) (let loc absolutize.operand (while (pos 'deref metadata.loc) @@ -625,7 +610,7 @@ (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)))) + (list (+ base (apply + (map sizeof (firstn idx basetype!elems)))) basetype!elems.idx))) (def array-info (operand offset) @@ -646,7 +631,7 @@ (die "@idx is out of bounds of array @operand"))) (list (+ base 1 ; for array size - (* idx (sz basetype!elem))) + (* idx (sizeof basetype!elem))) basetype!elem))) (def array-len (operand) diff --git a/mu.arc.t b/mu.arc.t index e0dc8b4d..81e4244b 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -821,8 +821,22 @@ (= memory*.3 4) (if (~is 34 (m '(3 integer-address deref))) (prn "F - 'm' redirects addresses")) +(= memory*.2 3) +(if (~is 34 (m '(2 integer-address-address deref deref))) + (prn "F - 'm' multiply redirects addresses")) (if (~iso (annotate 'record '(34 nil)) (m '(4 integer-boolean-pair))) (prn "F - 'm' supports compound records")) +(= memory*.5 35) +(= memory*.6 36) +(if (~iso (annotate 'record '(34 35 36)) (m '(4 integer-point-pair))) + (prn "F - 'm' supports records with compound fields")) +(if (~iso (annotate 'record '(34 35 36)) (m '(3 integer-point-pair-address deref))) + (prn "F - 'm' supports indirect access to records")) +(= memory*.4 2) +(if (~iso (annotate 'record '(2 35 36)) (m '(4 integer-array))) + (prn "F - 'm' supports access to arrays")) +(if (~iso (annotate 'record '(2 35 36)) (m '(3 integer-array-address deref))) + (prn "F - 'm' supports indirect access to arrays")) (reset) (new-trace "copy-record") |