From a37dc7e431283890bb6ef5da74a7928dbbae4fde Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 23 Oct 2021 07:27:15 -0700
Subject: compiler: improvement in wasteful jmp elimination.

* stdlib/compiler.tl (compiler optimize): After the dataflow-driven
peephole optimization, call elim-dead-code again.

* stdlib/optimize.tl (basic-blocks check-bypass-empty): New method.
(basic-bocks elim-dead-code): After eliminating unreachable blocks
from the list, we use check-bypass-empty to squeeze out any
empty blocks: blocks that have no instructions in their list,
other than the leading label. This helps elim-next-jmp
to find more opportunities to eliminate a wasteful jump, because
sometimes these jumps straddle over empty blocks.
Furthermore, elim-next-jmp can generate more empty blocks itself;
so we check for this situation, delete the blocks and iterate.
---
 stdlib/compiler.tl |  3 ++-
 stdlib/optimize.tl | 33 +++++++++++++++++++++++++++++----
 2 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index 19dbf260..0d8e1de2 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -1622,7 +1622,8 @@
           bb.(elim-dead-code))
         (when (>= olev 5)
           bb.(calc-liveness)
-          bb.(peephole))
+          bb.(peephole)
+          bb.(elim-dead-code))
         (cond
           ((>= olev 6)
            bb.(merge-jump-thunks)
diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl
index bf5dfdaa..a947c715 100644
--- a/stdlib/optimize.tl
+++ b/stdlib/optimize.tl
@@ -486,6 +486,16 @@
   (each ((bl bb.list))
     (set bl.insns bb.(thread-jumps-block bl.insns))))
 
+(defmeth basic-blocks check-bypass-empty (bb bl nx)
+  (unless (cdr bl.insns)
+    (each ((pb bl.rlinks))
+      (if (eq pb.next bl)
+        (set pb.next nx))
+      (upd pb.links (subst bl nx))
+      (upd pb.insns (mapcar [iffi consp (op subst bl.label nx.label)]))
+      (push pb nx.rlinks))
+    bl))
+
 (defmeth basic-blocks elim-next-jump (bb bl nx)
   (let* ((tail (last bl.insns))
          (linsn (car tail)))
@@ -523,10 +533,25 @@
       (for ((bl bb.root)) (bl) ((set bl bl.next))
         (visit bl))
       (visit bb.root))
-    (set bb.list [keep-if visited bb.list])
-    (each ((bl bb.list)
-           (nx (cdr bb.list)))
-      bb.(elim-next-jump bl nx)))
+    (upd bb.list (keep-if visited))
+    (let (flg)
+      (each ((bl bb.list)
+             (nx (cdr bb.list)))
+        (when bb.(check-bypass-empty bl nx)
+          (set flg t)
+          (del [visited bl])))
+      (if flg
+        (upd bb.list (keep-if visited))))
+    (while
+      (let (rep)
+        (each ((bl bb.list)
+               (nx (cdr bb.list)))
+          bb.(elim-next-jump bl nx)
+          (when bb.(check-bypass-empty bl nx)
+            (set rep t)
+            (del [visited bl])))
+        (if rep
+          (upd bb.list (keep-if visited))))))
   bb.(join-blocks))
 
 (defmeth basic-blocks merge-jump-thunks (bb)
-- 
cgit v1.2.3