compiler: improve register use when compiling calls.

* share/txr/stdlib/compiler.tl (compiler comp-call-impl):
Instead of allocating N temporary registers for N arguments,
some (or even none) of which may actually be used, we
do this one argument at a time: allocate just one register,
compile the argument expression, and then free the register
immediately if that fragment specifies its own output location
instead of the register. Otherwise keep the register and push
it on a stack.  This strategy lowers maximum register use.
Also, since we are pushing the used registers on a stack,
when we call free-tregs, they get liberated in reverse
order of allocation, which keeps things tidy.

1 files changed, 11 insertions, 6 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index a1bae8cc..b6e9e786 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -836,13 +836,18 @@
                  (uni ffrag.ffuns cfrag.ffuns))))))
 
 (defmeth compiler comp-call-impl (me oreg env opcode freg args)
-  (let* ((sugg-oregs (mapcar (ret me.(alloc-treg)) args))
-         (afrags (mapcar (ret me.(compile @1 env @2))
-                         sugg-oregs args))
-         (real-oregs (mapcar .oreg afrags)))
-    me.(free-tregs sugg-oregs)
+  (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))))
+    me.(free-tregs aoregs)
     (new (frag oreg
-               ^(,*(mappend .code afrags) (,opcode ,oreg ,freg ,*real-oregs))
+               ^(,*(mappend .code afrags)
+                 (,opcode ,oreg ,freg ,*(mapcar .oreg afrags)))
                [reduce-left uni afrags nil .fvars]
                [reduce-left uni afrags nil .ffuns]))))