diff options
| -rw-r--r-- | mu.arc | 28 | ||||
| -rw-r--r-- | mu.arc.t | 55 |
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 |