diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-28 09:49:28 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-28 09:49:28 -0800 |
| commit | bbb60b690e5a7dc696a766d500a8c36e62c53eb8 (patch) | |
| tree | 9cc83c4b40b90fb4a293e6d0226531a4aa5e2325 /share | |
| parent | 920782cb237657e912ac154dbc5117b6ac8e1229 (diff) | |
| download | txr-bbb60b690e5a7dc696a766d500a8c36e62c53eb8.tar.gz txr-bbb60b690e5a7dc696a766d500a8c36e62c53eb8.tar.bz2 txr-bbb60b690e5a7dc696a766d500a8c36e62c53eb8.zip | |
compiler: avoid invalid if d-reg optimization.
We cannot assume that a d register is has a non-nil value.
This is because d registers are exploited in the
implementation of load-time: the result of a load-time form is
stored by mutating a d register, and the value could be nil.
Since we still want to be able to assume that d registers
are non-nil, what we can do is just avoid that assumption for
those d regisers that are used for load-time values.
* share/txr/stdlib/compiler.tl (struct compiler): When
constructing basic-blocks, pass a new constructor argument:
the list of load-time d-regs. This is easily obtained by
mapping the load-time frags to their oreg slots, which are
those d-regs.
* share/txr/stdlib/optimize.tl (struct basic-blocks): New
slot and BOA constructor argument, lt-dregs.
(basic-blocks thread-jumps-block): Add a require to the
pattern (if (d @reg) @jlabel), that the register must not
be one of the load-time d-regs.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 3 | ||||
| -rw-r--r-- | share/txr/stdlib/optimize.tl | 7 |
2 files changed, 7 insertions, 3 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index f8b3469e..59050ff5 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1502,7 +1502,8 @@ (new (frag dreg nil)))))))) (defmeth compiler optimize (me insns) - (let* ((bb (new (basic-blocks insns)))) + (let* ((lt-dregs (mapcar .oreg me.lt-frags)) + (bb (new (basic-blocks insns lt-dregs)))) bb.(calc-liveness) bb.(peephole) bb.(thread-jumps) diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl index a2054ca3..fcaece3b 100644 --- a/share/txr/stdlib/optimize.tl +++ b/share/txr/stdlib/optimize.tl @@ -37,8 +37,9 @@ links insns) - (defstruct (basic-blocks insns) nil + (defstruct (basic-blocks insns lt-dregs) nil insns + lt-dregs root (hash (hash)) (li-hash (hash :eq-based)) @@ -257,7 +258,9 @@ (while* (nequal ninsn insn) (set insn ninsn ninsn (match-case insn - ((if (d @reg) @jlabel) nil) + (@(require (if @(as reg (d @reg)) @jlabel) + (not (memqual reg bb.lt-dregs))) + nil) ((if (t 0) @jlabel) ^(jmp ,jlabel)) ((jmp @jlabel) |