diff options
| -rw-r--r-- | share/txr/stdlib/optimize.tl | 90 |
1 files changed, 44 insertions, 46 deletions
diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl index 537bceed..4cc82876 100644 --- a/share/txr/stdlib/optimize.tl +++ b/share/txr/stdlib/optimize.tl @@ -41,55 +41,53 @@ (:method get-insns (bb) [mappend bb.hash bb.labels]))) +(defmacro rewrite-case (sym list . cases) + ^(rewrite (lambda (,sym) + (match-case ,sym + ,*cases)) + ,list)) + (defmeth basic-blocks thread-jumps (bb) (dohash (label code bb.hash) (set [bb.hash label] - (rewrite (lambda (insns) - (match-case insns - (((jmp @jlabel) . @rest) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@(op eq jlabel) - (jmp @(require @jjlabel (neq jjlabel jlabel))) - . @nil) - ^((jmp ,jjlabel) ,*rest)) - (@jelse insns)))) - (((if @reg @jlabel) . @rest) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@(op eq jlabel) - (if @(op eq reg) - @(require @jjlabel (neq jjlabel jlabel))) - . @nil) - ^((if ,reg ,jjlabel) ,*rest)) - ((@(op eq jlabel) - (jmp @(require @jjlabel (neq jjlabel jlabel))) - . @nil) - ^((if ,reg ,jjlabel) ,*rest)) - (@jelse insns)))) - (((ifq @reg @creg @jlabel) . @rest) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@(op eq jlabel) - (ifq @(op eq reg) @(op eq creg) - @(require @jjlabel (neq jjlabel jlabel))) - . @nil) - ^((ifq ,reg ,creg ,jjlabel) ,*rest)) - ((@(op eq jlabel) - (jmp @(require @jjlabel (neq jjlabel jlabel))) - . @nil) - ^((ifq ,reg ,creg ,jjlabel) ,*rest)) - (@jelse insns)))) - (((close @reg @nargs @jlabel . @cargs) . @rest) - (let ((jinsns [bb.hash jlabel])) - (match-case jinsns - ((@(op eq jlabel) - (jmp @(require @jjlabel (neq jjlabel jlabel))) - . @nil) - ^((close ,reg ,nargs ,jjlabel ,*cargs) ,*rest)) - (@jelse insns)))) - (@else insns))) - code)))) + (rewrite-case insns code + (((jmp @jlabel) . @rest) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@(op eq jlabel) + (jmp @(require @jjlabel (neq jjlabel jlabel))) . @nil) + ^((jmp ,jjlabel) ,*rest)) + (@jelse insns)))) + (((if @reg @jlabel) . @rest) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@(op eq jlabel) + (if @(op eq reg) + @(require @jjlabel (neq jjlabel jlabel))) . @nil) + ^((if ,reg ,jjlabel) ,*rest)) + ((@(op eq jlabel) + (jmp @(require @jjlabel (neq jjlabel jlabel))) . @nil) + ^((if ,reg ,jjlabel) ,*rest)) + (@jelse insns)))) + (((ifq @reg @creg @jlabel) . @rest) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@(op eq jlabel) + (ifq @(op eq reg) @(op eq creg) + @(require @jjlabel (neq jjlabel jlabel))) . @nil) + ^((ifq ,reg ,creg ,jjlabel) ,*rest)) + ((@(op eq jlabel) + (jmp @(require @jjlabel (neq jjlabel jlabel))) . @nil) + ^((ifq ,reg ,creg ,jjlabel) ,*rest)) + (@jelse insns)))) + (((close @reg @nargs @jlabel . @cargs) . @rest) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@(op eq jlabel) + (jmp @(require @jjlabel (neq jjlabel jlabel))) . @nil) + ^((close ,reg ,nargs ,jjlabel ,*cargs) ,*rest)) + (@jelse insns)))) + (@else insns))))) (defun rewrite (fun list) (build |