compiler: improve register removal optimization.

The register removal optimization now works for registers
initialized from variables. For instance

   mov t13 v00000
   mov t12 v00001
   gcall t7 3 t13 d0
   gcall t8 4 t12 t19

can, under the right conditions, be replaced with

   gcall t7 3 v00000 d0
   gcall t8 4 v00001 t19

where the useless copies of the v0 and v1 registers to
t13 and t12 are gone, and the refernces to those registers
are renamed to those v registers.

* share/txr/stdlib/optimize.tl (basic-blocks local-liveness):
We now use the def field of a live-info structure differently.
The def field holds a register, instead of a t register
number. For any instruction that defines a register, the
register is stored, whether it is v or t register.
(basic-blocks peephole-block): The rule is simplified and
extended to cover t-regs that receive a v-reg. A special
additional condition applies in this case: v-registers are
tied to a frame, and must not be accessed if their frame has ended.
Our optimization carries the risk that the variable was copied
into a register precisely for the purpose that the v register
is going out of scope, and the value is needed outside of the
frame.  We don't have frame level information in the basic
block, so to be conservative, we guess like this: if any end
instructions occur (potentially ending a frame), and if the
register is used after an end instruction, then we don't do
the replacement.

* share/txr/stdlib/compiler.tl (compiler comp-catch): Remove
inappropriate jend. Control definitely flows past this
instruction, because we jump here in the case when no
exception has taken place to continue the program. This bug
has resulted in some blocks being declared unreachable by the
control flow graph construction, and thus not included in
register liveness calculations, resulting in having a nil
in the live slot. This was exposed by the new new
optimization.

2 files changed, 17 insertions, 20 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 0e7e4b08..1d95fd3b 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -845,7 +845,7 @@
                      ,lhand
                      ,*(mappend .code cfrags)
                      ,lhend
-                     (jend ,tfrag.oreg)
+                     (end ,tfrag.oreg)
                      (end ,tfrag.oreg))
                    (uni tfrag.fvars [reduce-left uni cfrags nil .fvars])
                    (uni tfrag.ffuns [reduce-left uni cfrags nil .ffuns])))))))
diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl
index e1216167..754ad9ae 100644
--- a/share/txr/stdlib/optimize.tl
+++ b/share/txr/stdlib/optimize.tl
@@ -135,13 +135,13 @@
              (mappend (do when-match
                         (t @num) @1 (list num)) regs))
            (def (li insn def)
+             (set li (copy li)
+                  li.def def
+                  [bb.li-hash insn] li)
              (let* ((dn (regnum def))
                     (dmask (if dn (mask dn))))
                (cond
-                 (dn (set li (copy li)
-                          li.def dn
-                          [bb.li-hash insn] li)
-                     (new live-info
+                 (dn (new live-info
                           used (logand li.used (lognot dmask))
                           defined (logior li.defined dmask)))
                  (t (set [bb.li-hash insn] li)))))
@@ -153,15 +153,15 @@
                     used (logior li.used rmask)
                     defined (logand li.defined (lognot rmask)))))
            (def-ref (li insn def . refs)
+             (set li (copy li)
+                  li.def def
+                  [bb.li-hash insn] li)
              (let* ((rn (regnums refs))
                     (dn (regnum def))
                     (dmask (if dn (mask dn)))
                     (rmask (mask . rn)))
                (cond
-                 (dn (set li (copy li)
-                          li.def dn
-                          [bb.li-hash insn] li)
-                     (new live-info
+                 (dn (new live-info
                           used (logior (logand li.used (lognot dmask)) rmask)
                           defined (logior (logand li.defined (lognot rmask)) dmask)))
                  (t (set [bb.li-hash insn] li)
@@ -327,22 +327,19 @@
                  (and li (not (bit li.used n)))))
       (cdr insns))
     ;; unnecessary copying t-reg
-    (@(require ((mov @(as dst (t @n)) @(as src (@st @sn))) . @nil)
+    (@(require ((mov @(as dst (t @n)) @src) . @rest)
                (let ((li [bb.li-hash (car insns)]))
                  (and li (bit li.used n) (not (bit bl.live n))))
-               (neq st 'v)
-               (not (find n (cdr insns) : [chain bb.li-hash .def]))
-               (or (neq st 't)
-                   (and (not (bit bl.defined sn))
-                        (not (find sn insns : [chain bb.li-hash .def])))))
+               (or (neq (car src) 'v)
+                   (none rest [andf [chain car (op eq 'end)]
+                                    [chain bb.li-hash .used (lop bit n)]]))
+               (not (find dst rest : [chain bb.li-hash .def]))
+               (not (find src rest : [chain bb.li-hash .def])))
       (labels ((rename (insns n dst src)
                  (tree-case insns
                    ((fi . re)
-                      (let ((li [bb.li-hash fi]))
-                        (if (or (not li) (eql li.def n))
-                          insns
-                          (cons (subst-preserve dst src bb li fi)
-                                (rename (cdr insns) n dst src)))))
+                    (cons (subst-preserve dst src bb [bb.li-hash fi] fi)
+                          (rename (cdr insns) n dst src)))
                    (else else))))
         (rename (cdr insns) n dst src)))
     ;; wasteful moves