diff options
| -rw-r--r-- | mu.arc | 35 | ||||
| -rw-r--r-- | mu.arc.t | 185 |
2 files changed, 218 insertions, 2 deletions
diff --git a/mu.arc b/mu.arc index 3200b073..e19a0fe0 100644 --- a/mu.arc +++ b/mu.arc @@ -9,7 +9,7 @@ initialization-fns*)) (mac init-fn (name . body) - `(enq (fn () (= (function* ',name) (convert-names:convert-braces ',body))) + `(enq (fn () (= (function* ',name) (convert-names:convert-braces:insert-code ',body))) initialization-fns*)) ; things that a future assembler will need separate memory for: @@ -135,7 +135,7 @@ (def add-fns (fns) (each (name . body) fns - (= function*.name (convert-names:convert-braces body)))) + (= function*.name (convert-names:convert-braces:insert-code body)))) ;; managing concurrent routines @@ -853,6 +853,37 @@ (each instr (as cons deferred) (yield instr))))) +(on-init + (= before* (table)) ; label -> queue of fragments + (= after* (table))) ; label -> list of fragments + +(def add-hooks (clauses) + (each (op label . fragment) clauses + ; multiple before directives => code in order + (when (is op 'before) + (or= before*.label (queue)) + (enq fragment before*.label)) + ; multiple after directives => code in *reverse* order + ; (if initialization order in a function is A B, corresponding + ; finalization order should be B A) + (when (is op 'after) + (push fragment after*.label)))) + +(def insert-code (instrs) + (accum yield + (each instr instrs + (if (acons instr) + (yield instr) + ; label + (do + (each fragment (as cons before*.instr) + (each instr fragment + (yield instr))) + (yield instr) + (each fragment after*.instr + (each instr fragment + (yield instr)))))))) + ;; system software (init-fn maybe-coerce diff --git a/mu.arc.t b/mu.arc.t index 447811a5..5368fc95 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -2436,4 +2436,189 @@ ((2 integer) <- copy (5 literal)))) (prn "F - convert-quotes can handle labels")) +(reset) +;? (new-trace "insert-code-before") +(add-hooks '((before label1 + ((2 integer) <- copy (0 literal))))) +(if (~iso (as cons before*!label1) + '(; fragment + ( + ((2 integer) <- copy (0 literal))))) + (prn "F - add-hooks records fragments of code to insert before labels")) + +(if (~iso (insert-code + '(((1 integer) <- copy (0 literal)) + label1 + ((3 integer) <- copy (0 literal)))) + '(((1 integer) <- copy (0 literal)) + ((2 integer) <- copy (0 literal)) + label1 + ((3 integer) <- copy (0 literal)))) + (prn "F - 'insert-code' can insert fragments before labels")) + +(reset) +;? (new-trace "insert-code-before-multiple") +(add-hooks '((before label1 + ((2 integer) <- copy (0 literal))) + (before label1 + ((3 integer) <- copy (0 literal))))) +(if (~iso (as cons before*!label1) + '(; fragment + ( + ((2 integer) <- copy (0 literal))) + ( + ((3 integer) <- copy (0 literal))))) + (prn "F - add-hooks records 'before' fragments in order")) + +(if (~iso (insert-code + '(((1 integer) <- copy (0 literal)) + label1 + ((4 integer) <- copy (0 literal)))) + '(((1 integer) <- copy (0 literal)) + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal)) + label1 + ((4 integer) <- copy (0 literal)))) + (prn "F - 'insert-code' can insert multiple fragments in order before label")) + +(reset) +;? (new-trace "insert-code-after") +(add-hooks '((after label1 + ((2 integer) <- copy (0 literal))))) +(if (~iso (as cons after*!label1) + '(; fragment + ( + ((2 integer) <- copy (0 literal))))) + (prn "F - add-hooks records fragments of code to insert after labels")) + +(if (~iso (insert-code + '(((1 integer) <- copy (0 literal)) + label1 + ((3 integer) <- copy (0 literal)))) + '(((1 integer) <- copy (0 literal)) + label1 + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal)))) + (prn "F - 'insert-code' can insert fragments after labels")) + +(reset) +;? (new-trace "insert-code-after-multiple") +(add-hooks '((after label1 + ((2 integer) <- copy (0 literal))) + (after label1 + ((3 integer) <- copy (0 literal))))) +(if (~iso (as cons after*!label1) + '(; fragment + ( + ((3 integer) <- copy (0 literal))) + ( + ((2 integer) <- copy (0 literal))))) + (prn "F - add-hooks records 'after' fragments in reverse order")) + +(if (~iso (insert-code + '(((1 integer) <- copy (0 literal)) + label1 + ((4 integer) <- copy (0 literal)))) + '(((1 integer) <- copy (0 literal)) + label1 + ((3 integer) <- copy (0 literal)) + ((2 integer) <- copy (0 literal)) + ((4 integer) <- copy (0 literal)))) + (prn "F - 'insert-code' can insert multiple fragments in order after label")) + +(reset) +;? (new-trace "insert-code-before-after") +(add-hooks '((before label1 + ((2 integer) <- copy (0 literal))) + (after label1 + ((3 integer) <- copy (0 literal))))) +(if (and (~iso (as cons before*!label1) + '(; fragment + ( + ((2 integer) <- copy (0 literal))))) + (~iso (as cons after*!label1) + '(; fragment + ( + ((3 integer) <- copy (0 literal)))))) + (prn "F - add-hooks can record 'before' and 'after' fragments at once")) + +(if (~iso (insert-code + '(((1 integer) <- copy (0 literal)) + label1 + ((4 integer) <- copy (0 literal)))) + '(((1 integer) <- copy (0 literal)) + ((2 integer) <- copy (0 literal)) + label1 + ((3 integer) <- copy (0 literal)) + ((4 integer) <- copy (0 literal)))) + (prn "F - 'insert-code' can insert multiple fragments around label")) + +(reset) +;? (new-trace "insert-code-before-after-multiple") +(add-hooks '((before label1 + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal))) + (after label1 + ((4 integer) <- copy (0 literal))) + (before label1 + ((5 integer) <- copy (0 literal))) + (after label1 + ((6 integer) <- copy (0 literal)) + ((7 integer) <- copy (0 literal))))) +(if (or (~iso (as cons before*!label1) + '(; fragment + ( + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal))) + ( + ((5 integer) <- copy (0 literal))))) + (~iso (as cons after*!label1) + '(; fragment + ( + ((6 integer) <- copy (0 literal)) + ((7 integer) <- copy (0 literal))) + ( + ((4 integer) <- copy (0 literal)))))) + (prn "F - add-hooks can record multiple 'before' and 'after' fragments at once")) + +(if (~iso (insert-code + '(((1 integer) <- copy (0 literal)) + label1 + ((8 integer) <- copy (0 literal)))) + '(((1 integer) <- copy (0 literal)) + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal)) + ((5 integer) <- copy (0 literal)) + label1 + ((6 integer) <- copy (0 literal)) + ((7 integer) <- copy (0 literal)) + ((4 integer) <- copy (0 literal)) + ((8 integer) <- copy (0 literal)))) + (prn "F - 'insert-code' can insert multiple fragments around label - 2")) + +;? (new-trace "insert-code-before-after-independent") +(if (~iso (do + (reset) + (add-hooks '((before label1 + ((2 integer) <- copy (0 literal))) + (after label1 + ((3 integer) <- copy (0 literal))) + (before label1 + ((4 integer) <- copy (0 literal))) + (after label1 + ((5 integer) <- copy (0 literal))))) + (list before*!label1 after*!label1)) + (do + (reset) + (add-hooks '((before label1 + ((2 integer) <- copy (0 literal))) + (before label1 + ((4 integer) <- copy (0 literal))) + (after label1 + ((3 integer) <- copy (0 literal))) + (after label1 + ((5 integer) <- copy (0 literal))))) + (list before*!label1 after*!label1))) + (prn "F - order matters within 'before' and 'after' fragments, but not *between* 'before' and 'after' fragments")) + (reset) ; end file with this to persist the trace for the final test |