compiler: liveness bug involving closures.

2022-09-13 commit 6e354e1c2d5d64d18f527d52db75e344a9223d95,
subject "compiler: bugfixes in dead code elimination",
introduced a problem. By allowing the closure body blocks to
be included in the links of the previous basic block that ends
in the close instruction, it caused liveness info to flow out
out of close blocks into the close instruction, which is
wrong. Thus registers used inside a closure, which are
entirely private, wrongly appear live outside of the closure,
interfering with optimizations like eliminating dead
registers.

We can't simply roll back the commit because the bug it
fixes will reappear. The fix is to pair the next field
with a prev field, and maintain them; don't rely on
the rlinks to point to the previous block.

* stdlib/optimize.tl (basic-block): New slot, prev.
(back-block join-block): As we delete the next block,
we must update that block's next block's prev link.
(basic-blocks link-graph): Build the prev links.
Fix the bug in handling the close instruction:
do not list the close body code among the links,
only the branch target of the close.
(basic-blocks do-peephole-block): In a few cases in
which we set the bl.next to nil, we also set the
bl.next.prev to nil, if bl.next exists.
(basic-blocks elim-dead-clode): Reset the bl.prev
of every block also.
(basic-block check-bypass-empty): Here, we no longer
depend on rlinks containing the previous block;
the prev gives it to us. So we move that fixup out
of the link, and also fix up the next blocks prev
pointer.

1 files changed, 17 insertions, 3 deletions

diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl
index 5919e8cb..bf82e5c1 100644
--- a/stdlib/optimize.tl
+++ b/stdlib/optimize.tl
@@ -35,6 +35,7 @@
     (live 0)
     label
     next
+    prev
     links
     rlinks
     insns
@@ -112,6 +113,8 @@
            bl.next nxbl.next
            bl.links nxbl.links
            bb.list (remq nxbl bb.list))
+      (if nxbl.next
+        (set nxbl.next.prev bl.prev))
       (del [bb.hash nxbl.label])
       (each ((nx bl.links))
         (upd nx.rlinks (remq nxbl))
@@ -140,7 +143,10 @@
          (set bl.links (list [bb.hash jlabel])))
         ((close @nil @nil @nil @jlabel . @nil)
          (set bl.links (list [bb.hash jlabel])
-              bl.next nxbl))
+              bl.next nxbl
+              link-next nil)
+         (if nxbl
+           (set nxbl.prev bl)))
         ((swtch @nil . @jlabels)
          (set bl.links [mapcar bb.hash (uniq jlabels)]
               link-next nil))
@@ -156,6 +162,8 @@
          (set bl.nojoin t)))
       (when (and nxbl link-next)
         (set bl.next nxbl)
+        (if nxbl
+          (set nxbl.prev bl))
         (pushnew nxbl bl.links))
       (each ((nx bl.links))
         (pushnew bl nx.rlinks)))))
@@ -467,6 +475,8 @@
                       ((@(or ifq ifql) (t 0) @(as reg (d @nil)) @jlabel) . @nil))
                  (not (memqual reg bb.lt-dregs)))
         (pushnew bl.next bb.rescan)
+        (if bl.next
+          (set bl.prev nil))
         (set bb.recalc t
              bl.next nil
              bl.links (list [bb.hash jlabel]))
@@ -498,6 +508,8 @@
                         (@nil insns))))
          (when (neq insns oinsns)
            (pushnew bl bb.rescan)
+           (if bl.next
+             (set bl.prev nil))
            (set bb.recalc t
                 bl.next nil
                 bl.links nil))
@@ -558,6 +570,7 @@
   (each ((bl bb.list))
     (set bl.links nil
          bl.next nil
+         bl.prev nil
          bl.rlinks nil))
   bb.(link-graph)
   (let* ((visited (hash :eq-based)))
@@ -722,9 +735,10 @@
 (defmeth basic-block check-bypass-empty (bl nx)
   (unless (cdr bl.insns)
     (upd nx.rlinks (remq bl))
+    (whenlet ((pb bl.prev))
+      (set pb.next nx)
+      (set nx.prev pb))
     (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))