From 230415b4e11e005f8ea999d207d6ba29ffc5ada7 Mon Sep 17 00:00:00 2001
From: "Kartik K. Agaram" <vc@akkartik.com>
Date: Tue, 26 Aug 2014 12:20:08 -0700
Subject: 77 - 'new' in the interpreter

Next we'll try to reimplement it on the simulated machine. But for now,
sys.arc is extraneous.

Debugging this, the commented out prints started to become onerous enough I couldn't
bear to keep them.
---
 mu.arc   | 26 ++++++++++++++++++++++++++
 mu.arc.t | 24 ++++++++++++++++++++++++
 2 files changed, 50 insertions(+)

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")))
-- 
cgit 1.4.1-2-gfad0