diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-17 19:43:38 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-17 19:43:38 -0800 |
| commit | be7b8caccc28b8e039171cced45a212da74f11dd (patch) | |
| tree | 5d4fca2534a774649088f0dc6f8f8bb93fcfa1c6 /share | |
| parent | c08daf0b459729d16ac60a565bd6fa974cb01f2e (diff) | |
| download | txr-be7b8caccc28b8e039171cced45a212da74f11dd.tar.gz txr-be7b8caccc28b8e039171cced45a212da74f11dd.tar.bz2 txr-be7b8caccc28b8e039171cced45a212da74f11dd.zip | |
compiler: fix jump-threading regression.
* share/txr/stdlib/optimize.tl (basic-blocks
thread-jumps-block): We want a set here, not a pset, otherwise
we are processing the old-instruction again rather than
iterating. This breaks jump threading where multiple
iterations are required to get to the ultimate target. It
showed up as a difference in the compiled image of the
sys:compile-match function.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/optimize.tl | 96 |
1 files changed, 48 insertions, 48 deletions
diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl index aee0dac8..ac978a06 100644 --- a/share/txr/stdlib/optimize.tl +++ b/share/txr/stdlib/optimize.tl @@ -80,54 +80,54 @@ (insn oinsn) (ninsn oinsn)) (while* (nequal ninsn insn) - (pset insn ninsn - ninsn (match-case insn - ((if (d @reg) @jlabel) nil) - ((jmp @jlabel) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@jlabel - (jmp @(and @jjlabel @(not @jlabel))) . @nil) - ^(jmp ,jjlabel)) - (@jelse insn)))) - ((if @reg @jlabel) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@jlabel - (if @reg - @(and @jjlabel @(not @jlabel))) . @nil) - ^(if ,reg ,jjlabel)) - ((@jlabel - (jmp @(and @jjlabel @(not @jlabel))) . @nil) - ^(if ,reg ,jjlabel)) - ((@jlabel - (ifq @reg nil @jjlabel) . @jrest) - (let ((xlabel (if jrest - bb.(cut-block jlabel jrest jinsns) - bb.(next-block jlabel)))) - (if xlabel - ^(if ,reg ,xlabel) - insn))) - (@jelse insn)))) - ((ifq @reg @creg @jlabel) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@jlabel - (ifq @reg @creg - @(and @jjlabel @(not @jlabel))) . @nil) - ^(ifq ,reg ,creg ,jjlabel)) - ((@jlabel - (jmp @(and @jjlabel @(not @jlabel))) . @nil) - ^(ifq ,reg ,creg ,jjlabel)) - (@jelse insn)))) - ((close @reg @nargs @jlabel . @cargs) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@jlabel - (jmp @(and @jjlabel @(not @jlabel))) . @nil) - ^(close ,reg ,nargs ,jjlabel ,*cargs)) - (@jelse insn)))) - (@else else)))) + (set insn ninsn + ninsn (match-case insn + ((if (d @reg) @jlabel) nil) + ((jmp @jlabel) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@jlabel + (jmp @(and @jjlabel @(not @jlabel))) . @nil) + ^(jmp ,jjlabel)) + (@jelse insn)))) + ((if @reg @jlabel) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@jlabel + (if @reg + @(and @jjlabel @(not @jlabel))) . @nil) + ^(if ,reg ,jjlabel)) + ((@jlabel + (jmp @(and @jjlabel @(not @jlabel))) . @nil) + ^(if ,reg ,jjlabel)) + ((@jlabel + (ifq @reg nil @jjlabel) . @jrest) + (let ((xlabel (if jrest + bb.(cut-block jlabel jrest jinsns) + bb.(next-block jlabel)))) + (if xlabel + ^(if ,reg ,xlabel) + insn))) + (@jelse insn)))) + ((ifq @reg @creg @jlabel) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@jlabel + (ifq @reg @creg + @(and @jjlabel @(not @jlabel))) . @nil) + ^(ifq ,reg ,creg ,jjlabel)) + ((@jlabel + (jmp @(and @jjlabel @(not @jlabel))) . @nil) + ^(ifq ,reg ,creg ,jjlabel)) + (@jelse insn)))) + ((close @reg @nargs @jlabel . @cargs) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@jlabel + (jmp @(and @jjlabel @(not @jlabel))) . @nil) + ^(close ,reg ,nargs ,jjlabel ,*cargs)) + (@jelse insn)))) + (@else else)))) (cond ((null ninsn) (ldiff code tail)) ((nequal ninsn oinsn) (append (ldiff code tail) (list ninsn))) |