diff options
Diffstat (limited to 'stdlib/optimize.tl')
| -rw-r--r-- | stdlib/optimize.tl | 62 |
1 files changed, 55 insertions, 7 deletions
diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl index 5ba5de82..788e1d04 100644 --- a/stdlib/optimize.tl +++ b/stdlib/optimize.tl @@ -32,6 +32,7 @@ (compile-only (defstruct live-info nil (defined 0) + (clobbered 0) (used 0) def0 def1) @@ -45,6 +46,7 @@ insns closer nojoin + cycle (:method print (bl stream pretty-p) (ignore pretty-p) @@ -52,6 +54,8 @@ (print ^(basic-block live ,bl.live label ,bl.label insns ,bl.insns + clobbered ,bl.clobbered + cycle ,bl.cycle links ,(mapcar .label bl.links) rlinks ,(mapcar .label bl.rlinks) next ,bl.next.?label) stream))) @@ -182,7 +186,7 @@ (pushnew bl nx.rlinks))))) (defmeth basic-blocks local-liveness (bb bl) - (set bl.live 0) + (set bl.live 0 bl.clobbered 0) (labels ((regnum (reg) (when-match (t @num) reg num)) (regnums (regs) @@ -199,8 +203,10 @@ ((nzerop dmask) (set li.def0 def0) (set li.def1 def1) + (upd li.clobbered (logior dmask)) (new live-info used (logand li.used (lognot dmask)) + clobbered li.clobbered defined dmask)) (t (prog1 (copy li) @@ -211,7 +217,8 @@ (let* ((rn (regnums refs)) (rmask (mask . rn))) (new live-info - used (logior li.used rmask)))) + used (logior li.used rmask) + clobbered li.clobbered))) (def-ref (li insn def . refs) (set li.def0 def [bb.li-hash insn] li) @@ -220,11 +227,14 @@ (dmask (if dn (mask dn))) (rmask (mask . rn))) (cond - (dn (new live-info + (dn (upd li.clobbered (logior dmask)) + (new live-info used (logior (logand li.used (lognot dmask)) rmask) - defined dmask)) + defined dmask + clobbered li.clobbered)) (t (new live-info - used (logior li.used rmask)))))) + used (logior li.used rmask) + clobbered li.clobbered))))) (liveness (insns) (if (null insns) (new live-info used 0) @@ -270,7 +280,8 @@ (copy li))))))) (let ((li (liveness bl.insns))) (set bl.used li.used - bl.defined li.defined)))) + bl.defined li.defined + bl.clobbered li.clobbered)))) (defmeth basic-blocks calc-liveness (bb : (blist bb.list)) (each ((bl blist)) @@ -306,6 +317,25 @@ (set changed nil) (visit (car bb.list))))))) +(defmeth basic-blocks identify-cycle-members (bb) + (each ((bl bb.list)) + (zap bl.cycle)) + (labels ((visit (bl cycle) + (case bl.cycle + (:visited + (set bl.cycle t) + (each ((nx bl.links)) + (visit nx t))) + (nil + (set bl.cycle cycle) + (each ((nx bl.links)) + (visit nx cycle)))))) + (each ((bl bb.list)) + (visit bl :visited))) + (each ((bl bb.list)) + (unless (eq t bl.cycle) + (zap bl.cycle)))) + (defmeth basic-blocks thread-jumps-block (bb code) (let* ((tail (last code)) (oinsn (car tail)) @@ -421,7 +451,20 @@ (defmeth basic-blocks do-peephole-block (bb bl code) (labels ((dead-treg (insn n) (let ((li [bb.li-hash insn])) - (and li (not (bit li.used n)))))) + (and li (not (bit li.used n))))) + (clobbered-treg-rec (b n) + (some-true ((pb b.rlinks)) + (or (bit pb.clobbered n) + (clobbered-treg-rec pb n)))) + (clobbered-treg (insns treg n) + (let ((clobbered nil) + (prev-insns (ldiff bl.insns insns))) + (each ((pi prev-insns)) + (let ((li [bb.li-hash pi])) + (if (mequal treg li.def0 li.def1) + (set clobbered t)))) + (or clobbered + (clobbered-treg-rec bl n))))) (rewrite-case insns code ;; dead t-reg (@(require ((@(or mov getlx getv getf getfb) (t @n) . @nil) . @nil) @@ -441,6 +484,11 @@ (pushnew bl bb.rescan) (set bb.recalc t) (cdr insns)) + ;; wasteful setting of treg to nil outside of cycle + (@(require ((mov @(as treg (t @n)) (t 0)) . @nil) + (not bl.cycle) + (not (clobbered-treg insns treg n))) + (cdr insns)) ;; wasteful moves (((mov @reg @reg) . @nil) (cdr insns)) |