From fdef772d67ffcaa3006d8d56702c97c2d64bd21a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 19 Jul 2009 20:12:04 -0500 Subject: [PATCH] compiler.cfg: if a block has an instruction that kills values it must be the only instruction in the block --- .../cfg/block-joining/block-joining.factor | 10 +--- .../build-stack-frame.factor | 12 +++-- .../compiler/cfg/builder/builder-tests.factor | 15 +++--- basis/compiler/cfg/builder/builder.factor | 17 ++++--- basis/compiler/cfg/checker/checker.factor | 46 +++++++++++++------ basis/compiler/cfg/dcn/dcn-tests.factor | 1 + basis/compiler/cfg/def-use/def-use.factor | 16 +------ .../cfg/instructions/instructions.factor | 28 ++++++----- .../cfg/stack-analysis/stack-analysis.factor | 11 ++--- basis/compiler/cfg/utilities/utilities.factor | 7 ++- 10 files changed, 90 insertions(+), 73 deletions(-) diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor index 982f0866e6..b4c7223435 100644 --- a/basis/compiler/cfg/block-joining/block-joining.factor +++ b/basis/compiler/cfg/block-joining/block-joining.factor @@ -8,20 +8,14 @@ IN: compiler.cfg.block-joining ! Joining blocks that are not calls and are connected by a single CFG edge. ! Predecessors must be recomputed after this. Also this pass does not ! update ##phi nodes and should therefore only run before stack analysis. - -: kill-vreg-block? ( bb -- ? ) - instructions>> { - [ length 2 >= ] - [ penultimate kill-vreg-insn? ] - } 1&& ; - : predecessor ( bb -- pred ) predecessors>> first ; inline : join-block? ( bb -- ? ) { + [ kill-block? not ] [ predecessors>> length 1 = ] - [ predecessor kill-vreg-block? not ] + [ predecessor kill-block? not ] [ predecessor successors>> length 1 = ] [ [ predecessor ] keep back-edge? not ] } 1&& ; diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor index 71798da6fc..76b10dda01 100644 --- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor +++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor @@ -13,10 +13,16 @@ SYMBOL: spill-counts GENERIC: compute-stack-frame* ( insn -- ) : request-stack-frame ( stack-frame -- ) + frame-required? on stack-frame [ max-stack-frame ] change ; -M: ##stack-frame compute-stack-frame* - frame-required? on +M: ##alien-invoke compute-stack-frame* + stack-frame>> request-stack-frame ; + +M: ##alien-indirect compute-stack-frame* + stack-frame>> request-stack-frame ; + +M: ##alien-callback compute-stack-frame* stack-frame>> request-stack-frame ; M: ##call compute-stack-frame* @@ -45,8 +51,6 @@ M: insn compute-stack-frame* GENERIC: insert-pro/epilogues* ( insn -- ) -M: ##stack-frame insert-pro/epilogues* drop ; - M: ##prologue insert-pro/epilogues* drop frame-required? get [ stack-frame get _prologue ] when ; diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index 4a481a09d8..90e42912a1 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -1,12 +1,13 @@ IN: compiler.cfg.builder.tests -USING: tools.test kernel sequences -words sequences.private fry prettyprint alien alien.accessors -math.private compiler.tree.builder compiler.tree.optimizer -compiler.cfg.builder compiler.cfg.debugger arrays locals byte-arrays -kernel.private math ; +USING: tools.test kernel sequences words sequences.private fry +prettyprint alien alien.accessors math.private compiler.tree.builder +compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger +compiler.cfg.predecessors compiler.cfg.checker arrays locals +byte-arrays kernel.private math slots.private ; ! Just ensure that various CFGs build correctly. -: unit-test-cfg ( quot -- ) '[ _ test-cfg drop ] [ ] swap unit-test ; +: unit-test-cfg ( quot -- ) + '[ _ test-cfg [ compute-predecessors check-cfg ] each ] [ ] swap unit-test ; { [ ] @@ -49,6 +50,8 @@ kernel.private math ; [ "int" f "malloc" { "int" } alien-invoke ] [ "int" { "int" } "cdecl" alien-indirect ] [ "int" { "int" } "cdecl" [ ] alien-callback ] + [ swap - + * ] + [ swap slot ] } [ unit-test-cfg ] each diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 30c15b787f..e3c502e66e 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -63,10 +63,15 @@ GENERIC: emit-node ( node -- ) basic-block get successors>> push basic-block off ; +: emit-trivial-block ( quot -- ) + basic-block get instructions>> empty? [ ##branch begin-basic-block ] unless + call + ##branch begin-basic-block ; inline + : emit-call ( word height -- ) over loops get key? [ drop loops get at emit-loop-call ] - [ ##call ##branch begin-basic-block ] + [ [ ##call ] emit-trivial-block ] if ; ! #recursive @@ -157,7 +162,7 @@ M: #shuffle emit-node ! #return M: #return emit-node - drop ##epilogue ##return ; + drop ##branch begin-basic-block ##epilogue ##return ; M: #return-recursive emit-node label>> id>> loops get key? @@ -181,12 +186,10 @@ M: #terminate emit-node drop ##no-tco basic-block off ; [ return>> return-size >>return ] [ alien-parameters parameter-sizes drop >>params ] bi ; -: alien-stack-frame ( params -- ) - ##stack-frame ; - : emit-alien-node ( node quot -- ) - [ params>> ] dip [ drop alien-stack-frame ] [ call ] 2bi - ##branch begin-basic-block ; inline + [ + [ params>> dup ] dip call + ] emit-trivial-block ; inline M: #alien-invoke emit-node [ ##alien-invoke ] emit-alien-node ; diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 49ea775600..f9f5211c9c 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -1,34 +1,51 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel compiler.cfg.instructions compiler.cfg.rpo -compiler.cfg.def-use compiler.cfg.linearization compiler.cfg.liveness -combinators.short-circuit accessors math sequences sets assocs ; +USING: kernel combinators.short-circuit accessors math sequences sets +assocs compiler.cfg.instructions compiler.cfg.rpo compiler.cfg.def-use +compiler.cfg.linearization compiler.cfg.liveness +compiler.cfg.utilities ; IN: compiler.cfg.checker -ERROR: last-insn-not-a-jump insn ; +ERROR: bad-kill-block bb ; + +: check-kill-block ( bb -- ) + dup instructions>> first2 + swap ##epilogue? [ [ ##return? ] [ ##callback-return? ] bi or ] [ ##branch? ] if + [ drop ] [ bad-kill-block ] if ; + +ERROR: last-insn-not-a-jump bb ; : check-last-instruction ( bb -- ) - last dup { + dup instructions>> last { [ ##branch? ] [ ##dispatch? ] [ ##conditional-branch? ] [ ##compare-imm-branch? ] - [ ##return? ] - [ ##callback-return? ] - [ ##jump? ] [ ##fixnum-add? ] [ ##fixnum-sub? ] [ ##fixnum-mul? ] [ ##no-tco? ] } 1|| [ drop ] [ last-insn-not-a-jump ] if ; -ERROR: bad-loop-entry ; +ERROR: bad-loop-entry bb ; : check-loop-entry ( bb -- ) - dup length 2 >= [ + dup instructions>> dup length 2 >= [ 2 head* [ ##loop-entry? ] any? - [ bad-loop-entry ] when - ] [ drop ] if ; + [ bad-loop-entry ] [ drop ] if + ] [ 2drop ] if ; + +ERROR: bad-kill-insn bb ; + +: check-kill-instructions ( bb -- ) + dup instructions>> [ kill-vreg-insn? ] any? + [ bad-kill-insn ] [ drop ] if ; + +: check-normal-block ( bb -- ) + [ check-loop-entry ] + [ check-last-instruction ] + [ check-kill-instructions ] + tri ; ERROR: bad-successors ; @@ -37,10 +54,9 @@ ERROR: bad-successors ; [ bad-successors ] unless ; : check-basic-block ( bb -- ) - [ instructions>> check-last-instruction ] - [ instructions>> check-loop-entry ] + [ dup kill-block? [ check-kill-block ] [ check-normal-block ] if ] [ check-successors ] - tri ; + bi ; ERROR: bad-live-in ; diff --git a/basis/compiler/cfg/dcn/dcn-tests.factor b/basis/compiler/cfg/dcn/dcn-tests.factor index 40cfaae8f8..29ed81082a 100644 --- a/basis/compiler/cfg/dcn/dcn-tests.factor +++ b/basis/compiler/cfg/dcn/dcn-tests.factor @@ -2,6 +2,7 @@ IN: compiler.cfg.dcn.tests USING: tools.test kernel accessors namespaces assocs cpu.architecture vectors sequences compiler.cfg +compiler.cfg.utilities compiler.cfg.debugger compiler.cfg.registers compiler.cfg.predecessors diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index c8a9d1861b..2aa55df911 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -9,6 +9,7 @@ GENERIC: uses-vregs ( insn -- seq ) M: ##flushable defs-vregs dst>> 1array ; M: ##fixnum-overflow defs-vregs dst>> 1array ; +M: _fixnum-overflow defs-vregs dst>> 1array ; M: insn defs-vregs drop f ; M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ; @@ -47,18 +48,3 @@ M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ; M: _compare-imm-branch uses-vregs src1>> 1array ; M: _dispatch uses-vregs src>> 1array ; M: insn uses-vregs drop f ; - -! Instructions that use vregs -UNION: vreg-insn -##flushable -##write-barrier -##dispatch -##effect -##fixnum-overflow -##conditional-branch -##compare-imm-branch -##phi -##gc -_conditional-branch -_compare-imm-branch -_dispatch ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index dc656d61fa..43d92c9ccc 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -52,7 +52,6 @@ INSN: ##inc-d { n integer } ; INSN: ##inc-r { n integer } ; ! Subroutine calls -INSN: ##stack-frame stack-frame ; INSN: ##call word { height integer } ; INSN: ##jump word ; INSN: ##return ; @@ -160,9 +159,9 @@ INSN: ##write-barrier < ##effect card# table ; INSN: ##alien-global < ##flushable symbol library ; ! FFI -INSN: ##alien-invoke params ; -INSN: ##alien-indirect params ; -INSN: ##alien-callback params ; +INSN: ##alien-invoke params stack-frame ; +INSN: ##alien-indirect params stack-frame ; +INSN: ##alien-callback params stack-frame ; INSN: ##callback-return params ; ! Instructions used by CFG IR only. @@ -230,16 +229,23 @@ INSN: _reload dst class n ; INSN: _copy dst src class ; INSN: _spill-counts counts ; -! Instructions that poison the stack state -UNION: poison-insn - ##jump - ##return - ##callback-return ; +! Instructions that use vregs +UNION: vreg-insn + ##flushable + ##write-barrier + ##dispatch + ##effect + ##fixnum-overflow + ##conditional-branch + ##compare-imm-branch + ##phi + ##gc + _conditional-branch + _compare-imm-branch + _dispatch ; ! Instructions that kill all live vregs UNION: kill-vreg-insn - poison-insn - ##stack-frame ##call ##prologue ##epilogue diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis.factor b/basis/compiler/cfg/stack-analysis/stack-analysis.factor index cf15c0a312..ec34c96a24 100644 --- a/basis/compiler/cfg/stack-analysis/stack-analysis.factor +++ b/basis/compiler/cfg/stack-analysis/stack-analysis.factor @@ -26,19 +26,14 @@ SYMBOL: global-optimization? [ 2drop ] [ state get untranslate-loc ##replace ] if ] each ; -ERROR: poisoned-state state ; - : sync-state ( -- ) state get { - [ dup poisoned?>> [ poisoned-state ] [ drop ] if ] [ ds-height>> save-ds-height ] [ rs-height>> save-rs-height ] [ save-changed-locs ] [ clear-state ] } cleave ; -: poison-state ( -- ) state get t >>poisoned? drop ; - ! Abstract interpretation GENERIC: visit ( insn -- ) @@ -87,7 +82,11 @@ M: ##replace visit M: ##copy visit [ call-next-method ] [ record-copy ] bi ; -M: poison-insn visit call-next-method poison-state ; +M: ##jump visit sync-state , ; + +M: ##return visit sync-state , ; + +M: ##callback-return visit sync-state , ; M: kill-vreg-insn visit sync-state , ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 6edc883af4..c3d3e47485 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -33,11 +33,16 @@ IN: compiler.cfg.utilities building off basic-block off ; +: emit-trivial-block ( quot -- ) + basic-block get instructions>> empty? [ ##branch begin-basic-block ] unless + call + ##branch begin-basic-block ; inline + : call-height ( #call -- n ) [ out-d>> length ] [ in-d>> length ] bi - ; : emit-primitive ( node -- ) - [ word>> ] [ call-height ] bi ##call ##branch begin-basic-block ; + [ [ word>> ] [ call-height ] bi ##call ] emit-trivial-block ; : with-branch ( quot -- final-bb ) [