From 2a7bf5f339c2edc1649b33d661e401677aa08c9f Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 14 Jan 2022 18:58:03 -0800
Subject: compiler: two optimizations, motivated by optional params.

The motivating situation is this:

  (lambda (: (opt :)) opt)

When the default value of an optional parameter is :
then the net effect is that there is no optional substituion.
The optional argument is signaled by the : symbol, and that
same symbol then replaces the value.

This is not optimized well:

    data:
        0: :
        1: t
    syms:
    code:
        0: 8C000009 close t2 0 3 9 1 0 nil t2
        1: 00000002
        2: 00000001
        3: 00000003
        4: 00000002
        5: 3C000008 ifq t2 d0 8
        6: 00020400
        7: 2C020400 movsr t2 d0
        8: 10000002 end t2
        9: 10000002 end t2
    instruction count:
        5
    entry point:
        4

The instruction sequence

        5: 3C000008 ifq t2 d0 8
        6: 00020400
        7: 2C020400 movsr t2 d0
        8:

serves no purpose; it's like:

   (if (eq x y)
     (set x y))

With this commit it looks like:

data:
    0: :
    1: t
syms:
code:
    0: 8C000006 close t2 0 3 6 1 0 nil t2
    1: 00000002
    2: 00000001
    3: 00000003
    4: 00000002
    5: 10000002 end t2
    6: 10000002 end t2
instruction count:
    3
entry point:
    4

* stdlib/optimize.tl (basic-blocks peephole-block): Here, we
add an optimization for the useless assignment pattern.
If an "ifq tx dy label" instruction falls through to a
"mov tx dy", then we remove that move instruction from
the next block. But only if that next block has nothing
else jumping to it! If there are other jumps there, they could
be relying on that "mov tx dy", so it cannot be removed.
(basic-blocks elim-next-jump): The above optimization may
leave us with a useless ifq instruction, which jumps to
the same destination whether the comparison is true or not.
In elim-next-jmp, we took care only of jmp instructions which
uselessly jump to the next block in instruction order.
We fix this to also eliminate if and ifq instructions whose
destination label is the next block; they are equivalent to
an unconditional jump.
---
 stdlib/optimize.tl | 18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)

diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl
index 04df66e8..518264f5 100644
--- a/stdlib/optimize.tl
+++ b/stdlib/optimize.tl
@@ -444,6 +444,15 @@
              bl.next nil
              bl.links (list [bb.hash jlabel]))
         ^((jmp ,jlabel)))
+      ;; wasteful move of previously tested value
+      (@(require ((ifq (t @reg) (d @n) @nil) . @nil)
+                 (let* ((nxbl bl.next)
+                        (nxinsns nxbl.insns))
+                   (if (null (cdr nxbl.rlinks))
+                     (if-match (@label (mov (t @reg) (d @n)) . @rest) nxinsns
+                       (set nxbl.insns ^(,label ,*rest)
+                            bb.recalc t)))))
+        insns)
       (((jmp @jlabel) . @nil)
        (let* ((jinsns (cdr [bb.hash jlabel].insns))
               (oinsns (match-case jinsns
@@ -497,9 +506,12 @@
 (defmeth basic-blocks elim-next-jump (bb bl nx)
   (let* ((tail (last bl.insns))
          (linsn (car tail)))
-    (when-match (jmp @jlabel) linsn
-      (when (eql nx.label jlabel)
-        (set bl.insns (butlast bl.insns))))))
+    (match-case linsn
+      (@(or (jmp @jlabel)
+            (if @nil @jlabel)
+            (@(or ifq ifql) @nil @nil @jlabel))
+       (when (eql nx.label jlabel)
+         (set bl.insns (butlast bl.insns)))))))
 
 (defmeth basic-blocks join-blocks (bb)
   (labels ((joinbl (list)
-- 
cgit v1.2.3