diff options
| -rw-r--r-- | stdlib/compiler.tl | 22 | ||||
| -rw-r--r-- | stdlib/optimize.tl | 26 | ||||
| -rw-r--r-- | tests/012/seq.tl | 30 |
3 files changed, 58 insertions, 20 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index e48a2403..8e8ba3c0 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -409,8 +409,9 @@ (((dreg [me.dreg dobj])) dreg) ((((< me.dreg-cntr %lev-size%))) (let ((dreg ^(d ,(pinc me.dreg-cntr)))) - (set [me.data (cadr dreg)] dobj) - (set [me.dreg dobj] dreg))) + (set me.datavec nil + [me.data (cadr dreg)] dobj + [me.dreg dobj] dreg))) (t (compile-error me.last-form "code too complex: too many literals"))))) (defmeth compiler alloc-dreg (me) @@ -420,6 +421,12 @@ dreg) (compile-error me.last-form "code too complex: too many literals"))) +(defmeth compiler null-dregs (me used-dreg) + (each ((n 0..me.dreg-cntr)) + (unless (bit used-dreg n) + (set [me.data n] nil + me.datavec nil)))) + (defmeth compiler get-sidx (me atom) (iflet ((sidx [me.sidx atom])) sidx @@ -427,6 +434,12 @@ (set [me.stab sidx] atom) (set [me.sidx atom] sidx)))) +(defmeth compiler null-stab (me used-sidx) + (each ((n 0..me.sidx-cntr)) + (unless (bit used-sidx n) + (set [me.stab n] nil + me.symvec nil)))) + (defmeth compiler get-datavec (me) (or me.datavec (set me.datavec (vec-list [mapcar me.data (range* 0 me.dreg-cntr)])))) @@ -1766,7 +1779,7 @@ (let ((olev *opt-level*)) (if (>= olev 4) (let* ((lt-dregs (mapcar .oreg me.lt-frags)) - (bb (new (basic-blocks insns lt-dregs me.(get-symvec))))) + (bb (new (basic-blocks me insns lt-dregs me.(get-symvec))))) (when (>= olev 4) bb.(thread-jumps) bb.(elim-dead-code)) @@ -1778,7 +1791,8 @@ bb.(peephole) bb.(link-graph) bb.(thread-jumps) - bb.(elim-dead-code)))) + bb.(elim-dead-code)) + bb.(null-unused-data))) (cond ((>= olev 7) bb.(merge-jump-thunks) diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl index 9950d934..b6cbbb10 100644 --- a/stdlib/optimize.tl +++ b/stdlib/optimize.tl @@ -52,7 +52,8 @@ rlinks ,(mapcar .label bl.rlinks) next ,bl.next.?label) stream))) - (defstruct (basic-blocks insns lt-dregs symvec) nil + (defstruct (basic-blocks compiler insns lt-dregs symvec) nil + compiler insns lt-dregs symvec @@ -524,6 +525,16 @@ (set bb.recalc t) (cons (car insns) ren)) (t insns)))) + ;; constant folding + (@(require ((gcall @tgt @idx . @(all (d @dn))) . @rest) + [%const-foldable% [bb.symvec idx]]) + (let* ((co bb.compiler) + (dvec co.(get-datavec)) + (fun [bb.symvec idx]) + (args [mapcar dvec dn]) + (val (apply fun args)) + (dreg co.(get-dreg val))) + ^((mov ,tgt ,dreg) ,*rest))) (@nil insns)))) (defmeth basic-blocks peephole (bb) @@ -764,6 +775,19 @@ (each ((cl clist)) cl.(apply-treg-compacting-map map)))))) +(defmeth basic-blocks null-unused-data (bb) + (let ((used-dregs 0) + (used-funs 0) + (co bb.compiler)) + (each ((bl bb.list)) + (each ((insn bl.insns)) + (if-match @(coll (d @dn)) insn + (set-mask used-dregs (mask . dn))) + (if-match (@(or gcall gapply getf getlx setlx) @nil @fn . @nil) insn + (set-mask used-funs (mask fn))))) + co.(null-dregs used-dregs) + co.(null-stab used-funs))) + (defun rewrite (fun list) (build (while* list diff --git a/tests/012/seq.tl b/tests/012/seq.tl index 4d2260e9..df5ce065 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -317,42 +317,42 @@ (mtest (nrot nil) nil - (nrot #()) #() + (nrot (vec)) #() (nrot "") "" (nrot nil 2) nil - (nrot #() 2) #() + (nrot (vec) 2) #() (nrot "" 2) "" (nrot nil -1) nil - (nrot #() -1) #() + (nrot (vec) -1) #() (nrot "" -1) "") (mtest (let ((s '(a))) (nrot s)) (a) - (let ((s #(1))) (nrot s) s) #(1) + (let ((s (vec 1))) (nrot s) s) #(1) (let ((s "x")) (nrot s) s) "x" (let ((s '(a))) (nrot s -1)) (a) - (let ((s #(1))) (nrot s -1) s) #(1) + (let ((s (vec 1))) (nrot s -1) s) #(1) (let ((s "x")) (nrot s -1) s) "x") (mtest (let ((s '(a b))) (nrot s)) (b a) - (let ((s #(1 2))) (nrot s) s) #(2 1) - (let ((s "xy")) (nrot s) s) "yx" + (let ((s (vec 1 2))) (nrot s) s) #(2 1) + (let ((s (copy "xy"))) (nrot s) s) "yx" (let ((s '(a b))) (nrot s -1)) (b a) - (let ((s #(1 2))) (nrot s -1) s) #(2 1) - (let ((s "xy")) (nrot s -1) s) "yx") + (let ((s (vec 1 2))) (nrot s -1) s) #(2 1) + (let ((s (copy "xy"))) (nrot s -1) s) "yx") (mtest (let ((s '(a b c))) (nrot s)) (b c a) - (let ((s #(1 2 3))) (nrot s) s) #(2 3 1) - (let ((s "xyz")) (nrot s) s) "yzx" + (let ((s (vec 1 2 3))) (nrot s) s) #(2 3 1) + (let ((s (copy "xyz"))) (nrot s) s) "yzx" (let ((s '(a b c))) (nrot s -1)) (c a b) - (let ((s #(1 2 3))) (nrot s -1) s) #(3 1 2) - (let ((s "xyz")) (nrot s -1) s) "zxy") + (let ((s (vec 1 2 3))) (nrot s -1) s) #(3 1 2) + (let ((s (copy "xyz"))) (nrot s -1) s) "zxy") (mtest - (let ((s '(a b c))) (nrot s 33)) (a b c) - (let ((s '(a b c))) (nrot s 34)) (b c a)) + (let ((s (list 'a 'b 'c))) (nrot s 33)) (a b c) + (let ((s (list 'a 'b 'c))) (nrot s 34)) (b c a)) (mtest (rot nil) nil |