677 - more improvements for names in shared spaces

2 files changed, 75 insertions, 8 deletions

diff --git a/mu.arc b/mu.arc
index cc76e2ec..7d195bb7 100644
--- a/mu.arc
+++ b/mu.arc
@@ -1264,6 +1264,7 @@
 (def assign-names-to-location (instrs name)
 ;?   (tr name)
 ;?   (prn name ": " location*) ;? 1
+  (point return
   (ret location (table)
     ; if default-space in first instruction has a name, begin with its bindings
     (when (acons instrs.0)  ; not a label
@@ -1273,11 +1274,16 @@
                    (assoc 'names metadata.first-oarg-of-first-instr))
           (let old-names (location*:alref metadata.first-oarg-of-first-instr 'names)
             (unless old-names
-              (err "@name requires bindings for @(alref metadata.first-oarg-of-first-instr 'names) which aren't computed yet. Reorder @name to load later."))
+;?               (prn "@name requires bindings for @(alref metadata.first-oarg-of-first-instr 'names) which aren't computed yet. Waiting.") ;? 1
+              (return nil))
             (= location copy.old-names))))) ; assumption: we've already converted names for 'it'
-;?     (prn location) ;? 1
+;?     (unless empty.location (prn location)) ;? 2
     (with (isa-field  (table)
-           idx  1)  ; 0 always reserved for next space
+           idx  (+ 1  ; 0 always reserved for next space
+                   (or (apply max vals.location)  ; skip past bindings already shared from elsewhere
+                       0))
+           already-location (copy location)
+           )
       (each instr instrs
         (point continue
         (when atom.instr
@@ -1294,7 +1300,8 @@
 ;?               (tr 112)
               (trace "cn0" "field-access @field in @args.0 of type @basetype")
               (when (isa field 'sym)
-                (assert (or (~location field) isa-field.field) "field @args.1 is also a variable")
+                (unless (already-location field)
+                  (assert (or (~location field) isa-field.field) "field @args.1 is also a variable"))
                 (when (~location field)
                   (trace "cn0" "new field; computing location")
 ;?                   (tr "aa " type*.basetype)
@@ -1322,7 +1329,7 @@
               (when (maybe-add arg location idx)
                 (trace "cn0" "location for oarg " arg ": " idx)
                 ; todo: can't allocate arrays on the stack
-                (++ idx (sizeof `((_ ,@ty.arg)))))))))))))
+                (++ idx (sizeof `((_ ,@ty.arg))))))))))))))
 
 (def replace-names-with-location (instrs name)
   (each instr instrs
@@ -1509,8 +1516,15 @@
     (= function-table.name (convert-labels:convert-braces:tokenize-args:insert-code body name)))
   (each (name body)  canon.function-table
     (add-next-space-generator body name))
-  (each (name body)  canon.function-table
-    (= location*.name (assign-names-to-location body name)))
+  (let change t
+    (while change
+      (= change nil)
+      (each (name body)  canon.function-table
+        (when (no location*.name)
+          (= change t))
+        (or= location*.name (assign-names-to-location body name)))))
+;?   (each (name body)  canon.function-table ;? 1
+;?     (or= location*.name (assign-names-to-location body name))) ;? 1
   (each (name body)  canon.function-table
     (= function-table.name (replace-names-with-location body name)))
   ; we could clear location* at this point, but maybe we'll find a use for it
diff --git a/mu.arc.t b/mu.arc.t
index af4642a4..8761664e 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -1075,7 +1075,7 @@
 (push-stack routine* 'callee)  ; pretend call was at first instruction of caller
 (run-for-time-slice 1)
 (when (~is 1 pc.routine*)
-  (prn "F - 'reply' should increment pc in caller (to move past calling instruction)"))
+  (prn "F - 'reply' increments pc in caller (to move past calling instruction)"))
 
 (reset)
 (new-trace "new-fn-arg-sequential")
@@ -2278,6 +2278,59 @@
           (~is memory*.3 5))
   (prn "F - override names for the default space"))
 
+(reset)
+(new-trace "default-space-shared-with-extra-names")
+(add-code
+  '((function f [
+      (default-space:space-address <- new space:literal 30:literal)
+      (x:integer <- copy 3:literal)
+      (y:integer <- copy 4:literal)
+      (reply default-space:space-address)
+     ])
+    (function g [
+      (default-space:space-address/names:f <- next-input)
+      (y:integer <- add y:integer 1:literal)
+      (x:integer <- add x:integer 2:literal)
+      (z:integer <- add x:integer y:integer)
+      (reply z:integer)
+     ])
+    (function main [
+      (1:space-address <- f)
+      (2:integer <- g 1:space-address)
+     ])))
+(run 'main)
+(each routine completed-routines*
+  (aif rep.routine!error (prn "error - " it)))
+(when (~is memory*.2 10)
+  (prn "F - shared spaces can add new names"))
+
+(reset)
+(new-trace "default-space-shared-extra-names-dont-overlap-bindings")
+(add-code
+  '((function f [
+      (default-space:space-address <- new space:literal 30:literal)
+      (x:integer <- copy 3:literal)
+      (y:integer <- copy 4:literal)
+      (reply default-space:space-address)
+     ])
+    (function g [
+      (default-space:space-address/names:f <- next-input)
+      (y:integer <- add y:integer 1:literal)
+      (x:integer <- add x:integer 2:literal)
+      (z:integer <- copy 2:literal)
+      (reply x:integer y:integer)
+     ])
+    (function main [
+      (1:space-address <- f)
+      (2:integer <- g 1:space-address)
+     ])))
+(run 'main)
+(each routine completed-routines*
+  (aif rep.routine!error (prn "error - " it)))
+(when (or (~is memory*.2 5)
+          (~is memory*.3 5))
+  (prn "F - new names in shared spaces don't override old ones"))
+
 )  ; section 20
 
 (section 100