steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg: if a block has an instruction that kills values it must be the only instruction in the block

db4
Slava Pestov 2009-07-19 20:12:04 -05:00
parent 0a95ddd105
commit fdef772d67
10 changed files with 90 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/compiler/cfg/block-joining/block-joining.factor
View File

@ -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&& ;

12
basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
View File

@ -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 ;

15
basis/compiler/cfg/builder/builder-tests.factor
View File

@ -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

17
basis/compiler/cfg/builder/builder.factor
View File

@ -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 -- )
<alien-stack-frame> ##stack-frame ;
: emit-alien-node ( node quot -- )
[ params>> ] dip [ drop alien-stack-frame ] [ call ] 2bi
##branch begin-basic-block ; inline
[
[ params>> dup <alien-stack-frame> ] dip call
] emit-trivial-block ; inline
M: #alien-invoke emit-node
[ ##alien-invoke ] emit-alien-node ;

46
basis/compiler/cfg/checker/checker.factor
View File

@ -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 ;

1
basis/compiler/cfg/dcn/dcn-tests.factor
View File

@ -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

16
basis/compiler/cfg/def-use/def-use.factor
View File

@ -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 ;

28
basis/compiler/cfg/instructions/instructions.factor
View File

@ -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

11
basis/compiler/cfg/stack-analysis/stack-analysis.factor
View File

@ -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 , ;

7
basis/compiler/cfg/utilities/utilities.factor
View File

@ -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 )
[