compiler: new jump threading optimization case.

This opportunity now exists due to the previous commit which
eliminates discarded register moves.

The idea is to recognize code like

    if Txxx label0
    jmp label1  ;; jump if Txx is not nil

  label1:
    if Txxx ... ;; Txxx is not nil
    jmp label2  ;; jump taken

and rewrite the jmp in the first block to:

    if Txxx label0
    jmp label2

The leading if Txx label0 is then susceptible to further
threading via label0, as before.

Before the previous compiler commit, there were dead register
moves between the if and jmp that would be too complicated to
analyze in the peephole.

The motivation is that this pattern occurs in match-case
and lambda-match due to the way the cases update a matched-p
variable which is used to skip subsequent cases:

 case0
 (unless matched-p
   case1) ;; sets matched-p if it matches
 (unless matched-p)
   case2) ;; sets matched-p if it matches
 ...

and so on. Those successive matched-p tests now thread; if matched-p
is true, the control flow will short-circuit past the
subsequent tests.

* share/txr/stdlib/optimize.tl (basic-blocks peephole): Add
new case for recognizing aforementioned pattern.

1 files changed, 9 insertions, 0 deletions

diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl
index 7a6b9dbb..a8a329de 100644
--- a/share/txr/stdlib/optimize.tl
+++ b/share/txr/stdlib/optimize.tl
@@ -65,6 +65,15 @@
                    (jmp @(require @jjlabel (neq jjlabel jlabel))) . @nil)
                  ^((jmp ,jjlabel) ,*rest))
                 (@jelse insns))))
+           (((if @reg @jlabel0)
+             (jmp @jlabel1) . @rest)
+            (let ((jinsns [bb.hash jlabel1]))
+              (if-match (@(op eq jlabel1)
+                         (if @(op eq reg) @nil)
+                         (jmp @jlabel3) . @nil)
+                        jinsns
+                ^(,(car insns) (jmp ,jlabel3) ,*rest)
+                insns)))
            (((if @reg @jlabel) . @rest)
             (let ((jinsns [bb.hash jlabel]))
               (match-case jinsns