From 559e2cace50b534d7591d7bb6f0ba68afe09dc68 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 17 Apr 2023 15:04:45 -0700
Subject: compiler: better handling for mutated locals in funargs.

Instead of the conservative strategy in compiler comp-var of
loading variables into t-registers, and relying on optimization
to remove them, let's just go back to the old way: variables
are just registers. For function calls, we can detect mutated
variables and generate the conservative code.

* stdlib/compiler.tl (frag): New slots vbin and alt-oreg.
When a variable access is compiled, the binding is recorded
in vbin, and the desired output register in alt-oreg.
(simplify-var-spy): New struct type, used for detecting
mutated lexical variables when we compile a function argument
list.
(compiler comp-var): Revert to the old compilation strategy
for lexicals: the code fragment is empty, and the output
register is just the v-reg. However, we record the variable
binding and remember the caller's desired register in the
new frag fields.
(compiler comp-setq): Also revert the strategy here.
Here we get our frag from a recursive compilation, so
we just annotate it.
(compiler comp-call-impl): Use the simplify-var-spy to
obtain a list of the lexical variables that were mutated.
This is used for rewriting the frags, if necessary.
(handle-mutated-var-args): New function. If the mutated-vars
list is non-empty, it rewrites the frag list. Every element
in the frag which is a compiled reference to a lexical
variable which is mutated over the evaluation of the arg list
is substituted with a conservative frag which loads the
variable into a temporary register. That register thus
samples the value of the variable at the correct point in the
left-to-right evaluation, so the function is called with
the correct values.
---
 stdlib/compiler.tl | 69 ++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 49 insertions(+), 20 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index 9e99c9c1..b09324f9 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -60,7 +60,9 @@
   code
   pars
   fvars
-  ffuns)
+  ffuns
+  vbin
+  alt-oreg)
 
 (defstruct binding nil
   sym
@@ -216,6 +218,15 @@
       (when (neq spy me)
         spy.(captured vbin sym)))))
 
+(defstruct simplify-var-spy ()
+  mutated-vars
+  (:method accessed (me vbin sym)
+    (ignore me vbin sym))
+
+  (:method assigned (me vbin sym)
+    (ignore sym)
+    (pushnew vbin me.mutated-vars)))
+
 (compile-only
   (defstruct compiler nil
     (treg-cntr 2)
@@ -570,7 +581,9 @@
       (vbin
         (each ((spy me.access-spies))
           spy.(accessed vbin sym))
-        (new (frag oreg (maybe-mov oreg vbin.loc) (list sym))))
+        (new (frag vbin.loc nil (list sym))
+             vbin vbin
+             alt-oreg oreg))
       ((special-var-p sym)
        (let ((dreg me.(get-dreg sym)))
          (new (frag oreg ^((getv ,oreg ,dreg)) (list sym)))))
@@ -584,8 +597,10 @@
                    (bind bind.loc)
                    (spec me.(get-dreg sym))
                    (t me.(get-sidx sym))))
-           (vfrag me.(compile oreg env value)))
+           (vfrag me.(compile (if bind vloc oreg) env value)))
       (when bind
+        (set vfrag.vbin bind
+             vfrag.alt-oreg oreg)
         (each ((spy me.access-spies))
           spy.(assigned bind sym)))
       (new (frag vfrag.oreg
@@ -1476,23 +1491,25 @@
                  (uni ffrag.ffuns cfrag.ffuns))))))
 
 (defmeth compiler comp-call-impl (me oreg env opcode freg args : extra-ffun)
-  (let* ((aoregs nil)
-         (afrags (collect-each ((arg args))
-                   (let* ((aoreg me.(alloc-treg))
-                          (afrag me.(compile aoreg env arg)))
-                     (if (nequal afrag.oreg aoreg)
-                       me.(free-treg aoreg)
-                       (push aoreg aoregs))
-                     afrag)))
-         (fvars [reduce-left uni afrags nil .fvars])
-         (ffuns [reduce-left uni afrags nil .ffuns]))
-    me.(free-tregs aoregs)
-    (when extra-ffun
-      (pushnew extra-ffun ffuns))
-    (new (frag oreg
-               ^(,*(mappend .code afrags)
-                 (,opcode ,oreg ,freg ,*(mapcar .oreg afrags)))
-               fvars ffuns))))
+  (with-access-spy me t spy (new simplify-var-spy)
+    (let* ((aoregs nil)
+           (afrags0 (collect-each ((arg args))
+                      (let* ((aoreg me.(alloc-treg))
+                             (afrag me.(compile aoreg env arg)))
+                        (if (nequal afrag.oreg aoreg)
+                          me.(free-treg aoreg)
+                          (push aoreg aoregs))
+                        afrag)))
+           (afrags (handle-mutated-var-args afrags0 spy.mutated-vars))
+           (fvars [reduce-left uni afrags nil .fvars])
+           (ffuns [reduce-left uni afrags nil .ffuns]))
+      me.(free-tregs aoregs)
+      (when extra-ffun
+        (pushnew extra-ffun ffuns))
+      (new (frag oreg
+                 ^(,*(mappend .code afrags)
+                   (,opcode ,oreg ,freg ,*(mapcar .oreg afrags)))
+                 fvars ffuns)))))
 
 (defmeth compiler comp-inline-lambda (me oreg env opcode lambda args)
   (let ((reg-args args) apply-list-arg)
@@ -1673,6 +1690,18 @@
                    (xend ,bfrag.oreg))
                  bfrag.fvars bfrag.ffuns)))))
 
+(defun handle-mutated-var-args (frags mutated-vars)
+  (if mutated-vars
+    (build
+      (each ((frag frags))
+        (let* ((vbin frag.vbin)
+               (oreg frag.alt-oreg))
+          (add (if (and vbin (memq vbin mutated-vars))
+                 (new (frag oreg (append frag.code (maybe-mov oreg vbin.loc))
+                            frag.fvars frag.ffuns frag.pars))
+                 frag)))))
+    frags))
+
 (defun misleading-ref-check (frag env form)
   (each ((v frag.fvars))
     (when env.(lookup-var v)
-- 
cgit v1.2.3