compiler: peephole: merge basic blocks when jmp removed.

When a jmp instruction is removed from (necessarily) the end of a basic
block, that basic block can be merged with the next one, and marked for
re-scanning.

A test case where this eliminates wasteful register-register move
instruction is (match #(@a) #(3) a).

* stdlib/optimize.tl (basic-blocks): New slot, tryjoin.
(basic-blocks join-block): Null out the instruction list of the joined
block. This helps if we do this during peephole processing, because it
happens in the middle of an iteration over a list of blocks which can
still visit the next block that has been merged into its predecesor; we
don't want to be processing instructions that are no longer relevant.
(basic-blocks peephole-block): In the one case where a conditional
instruction is deleted from the end of the basic block, we add the block
to the rescan list, and also to the tryjoin list. If the block can
be merged with the next one, that can create more opportunities for
peephole optimization.
(basic-blocks peephole): Use zap in a few places to condense the logic
of sampling a state variable that needs to be nulled out. Add the
processing of the tryjoin list: pop basic blocks from the list, and try
to merge them with their successor, if possible. We handle cases here
where the next block could itself be in tryjoin. Also, if we join any
blocks, we set the recalc flag to recalculate the liveness info.

1 files changed, 16 insertions, 5 deletions

diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl
index f6acad64..db069efa 100644
--- a/stdlib/optimize.tl
+++ b/stdlib/optimize.tl
@@ -59,6 +59,7 @@
     rescan
     recalc
     reelim
+    tryjoin
     (:static start (gensym "start-"))
     (:static jump-ops '(jmp if ifq ifql close swtch ret abscsr
                         uwprot catch block jend))
@@ -105,6 +106,7 @@
       (when (eql (car nxbl.insns) nxbl.label)
         (pop nxbl.insns))
       (set bl.insns (append bl.insns nxbl.insns))
+      (set nxbl.insns nil)
       (set bl.next nxbl.next)
       (set bl.links nxbl.links)
       (set bb.list (remq nxbl bb.list))
@@ -433,6 +435,8 @@
            (@jelse insns))))
       (@(require ((if @(as reg (d @dn)) @jlabel) . @nil)
                  (not (memqual reg bb.lt-dregs)))
+        (push bl bb.tryjoin)
+        (push bl bb.rescan)
         nil)
       (@(require ((ifq @(as reg (d @dn)) (t 0) @jlabel) . @nil)
                  (not (memqual reg bb.lt-dregs)))
@@ -456,11 +460,18 @@
 (defmeth basic-blocks peephole (bb)
   (each ((bl bb.list))
     (set bl.insns bb.(peephole-block bl bl.insns)))
-  (whilet ((rescan bb.rescan))
-    (set bb.rescan nil)
-    (when bb.recalc
-      bb.(calc-liveness rescan)
-      (set bb.recalc nil))
+  (whilet ((rescan (zap bb.rescan)))
+    (whilet ((bl (pop bb.tryjoin)))
+      (let ((nxbl bl.next))
+        (when (null (cdr nxbl.rlinks))
+          bb.(join-block bl nxbl)
+          (set bb.recalc t)
+          (when (memq nxbl bb.tryjoin)
+            (upd bb.tryjoin (remq nxbl))
+            (push bl bb.tryjoin))
+          (upd bb.rescan (remq nxbl)))))
+    (when (zap bb.recalc)
+      bb.(calc-liveness rescan))
     (each ((bl rescan))
       (set bl.insns bb.(peephole-block bl bl.insns))))
  (when bb.reelim