compiler: eliminate wasteful treg nulling.

* stdlib/optimize.tl (live-info): New slot, clobbered.
(basic-block): New slot, cycle. Struct also inherits
clobbered slot from live-info.
(basic-block print): Print clobbered and cycle.
(basic-blocks local-liveness): Calculate clobbered
for each instruction and from that for the basic block.
(basic-blocks identify-cycle-members): New method.
Discovers which basic blocks are part of any cycle,
and identifies them by setting the new cycle slot
to t.
(basic-blocks do-peephole-block): New local functions
here for determining whether a register has been
clobbered before the first instruction, either
in the same basic block or any ancestors. Only
works when the block is not part of a cycle.
We add a peephole pattern matching move instructions
that set tregs to (t 0)/nil. When we are not in a
cycle block, and the treg has not previously been
clobbered, we know it is clean: it still has the initial
nil value set by the VM and we can remove the instruction.

* stdlib/compiler.tl (compiler optimize): Call the
identify-cycle-members method before peephole.

2 files changed, 56 insertions, 7 deletions

diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index fe4db13e..c3043d38 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -1840,6 +1840,7 @@
             (while* (and (>= olev 6)
                          (neql nblocks (set nblocks bb.(num-blocks))))
               bb.(calc-liveness)
+              bb.(identify-cycle-members)
               bb.(peephole)
               bb.(link-graph)
               bb.(thread-jumps)
diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl
index 5ba5de82..788e1d04 100644
--- a/stdlib/optimize.tl
+++ b/stdlib/optimize.tl
@@ -32,6 +32,7 @@
 (compile-only
   (defstruct live-info nil
     (defined 0)
+    (clobbered 0)
     (used 0)
     def0 def1)
 
@@ -45,6 +46,7 @@
     insns
     closer
     nojoin
+    cycle
 
     (:method print (bl stream pretty-p)
       (ignore pretty-p)
@@ -52,6 +54,8 @@
       (print ^(basic-block live ,bl.live
                            label ,bl.label
                            insns ,bl.insns
+                           clobbered ,bl.clobbered
+                           cycle ,bl.cycle
                            links ,(mapcar .label bl.links)
                            rlinks ,(mapcar .label bl.rlinks)
                            next ,bl.next.?label) stream)))
@@ -182,7 +186,7 @@
         (pushnew bl nx.rlinks)))))
 
 (defmeth basic-blocks local-liveness (bb bl)
-  (set bl.live 0)
+  (set bl.live 0 bl.clobbered 0)
   (labels ((regnum (reg)
              (when-match (t @num) reg num))
            (regnums (regs)
@@ -199,8 +203,10 @@
                  ((nzerop dmask)
                   (set li.def0 def0)
                   (set li.def1 def1)
+                  (upd li.clobbered (logior dmask))
                   (new live-info
                        used (logand li.used (lognot dmask))
+                       clobbered li.clobbered
                        defined dmask))
                  (t (prog1
                       (copy li)
@@ -211,7 +217,8 @@
              (let* ((rn (regnums refs))
                     (rmask (mask . rn)))
                (new live-info
-                    used (logior li.used rmask))))
+                    used (logior li.used rmask)
+                    clobbered li.clobbered)))
            (def-ref (li insn def . refs)
              (set li.def0 def
                   [bb.li-hash insn] li)
@@ -220,11 +227,14 @@
                     (dmask (if dn (mask dn)))
                     (rmask (mask . rn)))
                (cond
-                 (dn (new live-info
+                 (dn (upd li.clobbered (logior dmask))
+                     (new live-info
                           used (logior (logand li.used (lognot dmask)) rmask)
-                          defined dmask))
+                          defined dmask
+                          clobbered li.clobbered))
                  (t (new live-info
-                         used (logior li.used rmask))))))
+                         used (logior li.used rmask)
+                         clobbered li.clobbered)))))
            (liveness (insns)
              (if (null insns)
                (new live-info used 0)
@@ -270,7 +280,8 @@
                      (copy li)))))))
     (let ((li (liveness bl.insns)))
       (set bl.used li.used
-           bl.defined li.defined))))
+           bl.defined li.defined
+           bl.clobbered li.clobbered))))
 
 (defmeth basic-blocks calc-liveness (bb : (blist bb.list))
   (each ((bl blist))
@@ -306,6 +317,25 @@
           (set changed nil)
           (visit (car bb.list)))))))
 
+(defmeth basic-blocks identify-cycle-members (bb)
+  (each ((bl bb.list))
+    (zap bl.cycle))
+  (labels ((visit (bl cycle)
+             (case bl.cycle
+               (:visited
+                 (set bl.cycle t)
+                 (each ((nx bl.links))
+                   (visit nx t)))
+               (nil
+                 (set bl.cycle cycle)
+                 (each ((nx bl.links))
+                   (visit nx cycle))))))
+    (each ((bl bb.list))
+      (visit bl :visited)))
+  (each ((bl bb.list))
+    (unless (eq t bl.cycle)
+      (zap bl.cycle))))
+
 (defmeth basic-blocks thread-jumps-block (bb code)
   (let* ((tail (last code))
          (oinsn (car tail))
@@ -421,7 +451,20 @@
 (defmeth basic-blocks do-peephole-block (bb bl code)
   (labels ((dead-treg (insn n)
              (let ((li [bb.li-hash insn]))
-               (and li (not (bit li.used n))))))
+               (and li (not (bit li.used n)))))
+           (clobbered-treg-rec (b n)
+             (some-true ((pb b.rlinks))
+               (or (bit pb.clobbered n)
+                   (clobbered-treg-rec pb n))))
+           (clobbered-treg (insns treg n)
+             (let ((clobbered nil)
+                   (prev-insns (ldiff bl.insns insns)))
+               (each ((pi prev-insns))
+                 (let ((li [bb.li-hash pi]))
+                   (if (mequal treg li.def0 li.def1)
+                     (set clobbered t))))
+               (or clobbered
+                   (clobbered-treg-rec bl n)))))
     (rewrite-case insns code
       ;; dead t-reg
       (@(require ((@(or mov getlx getv getf getfb) (t @n) . @nil) . @nil)
@@ -441,6 +484,11 @@
         (pushnew bl bb.rescan)
         (set bb.recalc t)
         (cdr insns))
+      ;; wasteful setting of treg to nil outside of cycle
+      (@(require ((mov @(as treg (t @n)) (t 0)) . @nil)
+                 (not bl.cycle)
+                 (not (clobbered-treg insns treg n)))
+        (cdr insns))
       ;; wasteful moves
       (((mov @reg @reg) . @nil)
        (cdr insns))