diff options
| -rw-r--r-- | stdlib/asm.tl | 2 | ||||
| -rw-r--r-- | stdlib/compiler.tl | 2 | ||||
| -rw-r--r-- | stdlib/optimize.tl | 14 | ||||
| -rw-r--r-- | tests/019/comp-bugs.tl | 6 |
4 files changed, 18 insertions, 6 deletions
diff --git a/stdlib/asm.tl b/stdlib/asm.tl index 96f3f9e8..139eab47 100644 --- a/stdlib/asm.tl +++ b/stdlib/asm.tl @@ -394,6 +394,8 @@ (defopcode-alias jend end) +(defopcode-alias xend end) + (defopcode-derived op-prof prof auto op-end) (defopcode op-call call auto diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 78ee5f12..6fb7cae0 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -1599,7 +1599,7 @@ (new (frag oreg ^((prof ,oreg) ,*bfrag.code - (end ,bfrag.oreg)) + (xend ,bfrag.oreg)) bfrag.fvars bfrag.ffuns))))) (defun misleading-ref-check (frag env form) diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl index 914df5b3..490653c9 100644 --- a/stdlib/optimize.tl +++ b/stdlib/optimize.tl @@ -39,6 +39,7 @@ rlinks insns closer + nojoin (:method print (bl stream pretty-p) (put-string "#S" stream) @@ -64,7 +65,7 @@ tryjoin (:static start (gensym "start-")) (:static jump-ops '(jmp if ifq ifql close swtch ret abscsr - uwprot catch block jend)) + uwprot catch block jend xend)) (:postinit (bb) (let* ((insns (early-peephole (dedup-labels (cons bb.start bb.insns)))) @@ -146,7 +147,9 @@ ((uwprot @clabel) (set bl.links (list [bb.hash clabel]))) ((@(or abscsr ret jend) . @nil) - (set link-next nil))) + (set link-next nil)) + ((xend . @nil) + (set bl.nojoin t))) (when (and nxbl link-next) (set bl.next nxbl) (pushnew nxbl bl.links)) @@ -200,7 +203,7 @@ (let* ((li (liveness (cdr insns))) (insn (car insns))) (match-case insn - ((@(or end jend prof) @reg) + ((@(or end jend xend prof) @reg) (refs li insn reg)) ((@(or apply call) @def . @refs) (def-ref li insn def . refs)) @@ -230,7 +233,7 @@ (def li insn reg)) ((@op . @nil) (caseq op - ((end jend prof or apply call or gapply gcall mov if + ((end jend xend prof or apply call or gapply gcall mov if ifq ifql swtch block ret abscsr catch handle getv getvb getfb getl1b getlx getf setl1 setlx bindv close) (error `wrongly handled @insn instruction`)) @@ -481,7 +484,7 @@ (whilet ((rescan (zap bb.rescan))) (whilet ((bl (pop bb.tryjoin))) (let ((nxbl bl.next)) - (when (null (cdr nxbl.rlinks)) + (unless (or bl.nojoin (cdr nxbl.rlinks)) bb.(join-block bl nxbl) (set bb.recalc t) (when (memq nxbl bb.tryjoin) @@ -527,6 +530,7 @@ (cond ((and (eq bl.next nxbl) (eq (car bl.links) nxbl) + (null bl.nojoin) (null (cdr bl.links)) (null (cdr nxbl.rlinks))) bb.(join-block bl nxbl) diff --git a/tests/019/comp-bugs.tl b/tests/019/comp-bugs.tl new file mode 100644 index 00000000..c2cb2ad7 --- /dev/null +++ b/tests/019/comp-bugs.tl @@ -0,0 +1,6 @@ +(load "../common") + +(set *compile-test* t) + +(test + (prof (for ((i 42)) ((< i 42) i) ())) (42 0 0 0)) |