diff options
-rw-r--r-- | mu.arc | 26 | ||||
-rw-r--r-- | mu.arc.t | 24 |
2 files changed, 50 insertions, 0 deletions
diff --git a/mu.arc b/mu.arc index 2715ffc7..26946792 100644 --- a/mu.arc +++ b/mu.arc @@ -18,6 +18,7 @@ ; must be scalar or array, sum or product or primitive type (obj size 1) type-array (obj array t elem 'type) + type-array-address (obj size 1 address t elem 'type-array) typeinfo (obj size 5 record t elems '(integer boolean boolean boolean type-array)) typeinfo-address (obj size 1 address t elem 'typeinfo) typeinfo-address-array (obj array t elem 'typeinfo-address) @@ -86,6 +87,7 @@ `(with (loc@ ,loc val@ ,val) ;? (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@) @@ -195,6 +197,11 @@ reply (do (= result arg) (break)) + new + (let type (v arg.0) + (if types*.type!array + (new-array type (v arg.1)) + (new-scalar type))) ; else user-defined function (let-or new-body function*.op (prn "no definition for " op) ;? (prn "== " memory*) @@ -217,6 +224,25 @@ ;? (prn "return " result) ))) +(enq (fn () (= Memory-in-use-until 1000)) + initialization-fns*) +(def new-scalar (type) + (ret result Memory-in-use-until + (++ Memory-in-use-until sizeof.type))) + +(def new-array (type size) + (ret result Memory-in-use-until + (++ Memory-in-use-until (* (sizeof types*.type!elem) size)))) + +(def sizeof (type) + (if (~or types*.type!record types*.type!array) + types*.type!size + types*.type!record + (sum idfn + (accum yield + (each elem types*.type!elems + (yield sizeof.elem)))))) + (def convert-braces (instrs) (let locs () ; list of information on each brace: (open/close pc) (let pc 0 diff --git a/mu.arc.t b/mu.arc.t index 6dfb7824..3695b4c8 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -592,3 +592,27 @@ ;? (prn memory*) (if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) (prn "F - continue might never trigger")) + +(reset) +(let before Memory-in-use-until + (add-fns + '((main + ((1 integer-address) <- new (integer type))))) + (run function*!main) + ;? (prn memory*) + (if (~iso memory*.1 before) + (prn "F - 'new' returns current high-water mark")) + (if (~iso Memory-in-use-until (+ before 1)) + (prn "F - 'new' on primitive types increments high-water mark by their size"))) + +(reset) +(let before Memory-in-use-until + (add-fns + '((main + ((1 type-array-address) <- new (type-array type) (5 literal))))) + (run function*!main) + ;? (prn memory*) + (if (~iso memory*.1 before) + (prn "F - 'new' returns current high-water mark")) + (if (~iso Memory-in-use-until (+ before 5)) + (prn "F - 'new' on primitive arrays increments high-water mark by their size"))) |