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

RPO linearization

db4
Slava Pestov 2008-09-11 02:05:22 -05:00
parent b36f610170
commit 411b38924f
14 changed files with 204 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
unfinished/compiler/cfg/builder/builder-tests.factor
View File

@ -1,12 +1,10 @@
IN: compiler.cfg.builder.tests
USING: compiler.cfg.builder tools.test kernel sequences
USING: tools.test kernel sequences
words sequences.private fry prettyprint alien
math.private compiler.tree.builder compiler.tree.optimizer
words sequences.private fry prettyprint alien ;
compiler.cfg.builder compiler.cfg.debugger ;
! Just ensure that various CFGs build correctly.
: test-cfg ( quot -- result )
build-tree optimize-tree gensym gensym build-cfg ;
{
[ ]
[ dup ]
@ -28,10 +26,6 @@ words sequences.private fry prettyprint alien ;
'[ _ test-cfg drop ] [ ] swap unit-test
] each
: test-word-cfg ( word -- result )
[ build-tree-from-word nip optimize-tree ] keep dup
build-cfg ;
: test-1 ( -- ) test-1 ;
: test-2 ( -- ) 3 . test-2 ;
: test-3 ( a -- b ) dup [ test-3 ] when ;
@ -41,5 +35,5 @@ words sequences.private fry prettyprint alien ;
test-2
test-3
} [
'[ _ test-word-cfg drop ] [ ] swap unit-test
'[ _ test-cfg drop ] [ ] swap unit-test
] each

14
unfinished/compiler/cfg/builder/builder.factor
View File

@ -30,6 +30,8 @@ IN: compiler.cfg.builder
building off
basic-block off ;
: stop-iterating ( -- next ) end-basic-block f ;
USE: qualified
FROM: compiler.generator.registers => +input+ ;
FROM: compiler.generator.registers => +output+ ;
@ -49,7 +51,7 @@ SYMBOL: current-label-start
: add-procedure ( -- )
basic-block get current-word get current-label get
<procedure> procedures get push ;
<cfg> procedures get push ;
: begin-procedure ( word label -- )
end-basic-block
@ -100,17 +102,17 @@ GENERIC: emit-node ( node -- next )
: if-intrinsics ( #call -- quot )
word>> "if-intrinsics" word-prop ;
: local-recursive-call ( basic-block -- )
: local-recursive-call ( basic-block -- next )
%branch
basic-block get successors>> push
end-basic-block ;
stop-iterating ;
: emit-call ( word -- next )
finalize-phantoms
{
{ [ tail-call? not ] [ 0 %frame-required %call iterate-next ] }
{ [ dup loops get key? ] [ loops get at local-recursive-call f ] }
[ %epilogue %jump f ]
{ [ dup loops get key? ] [ loops get at local-recursive-call ] }
[ %epilogue %jump stop-iterating ]
} cond ;
! #recursive
@ -265,7 +267,7 @@ M: #return-recursive emit-node
[ %epilogue %return ] unless f ;
! #terminate
M: #terminate emit-node drop end-basic-block f ;
M: #terminate emit-node drop stop-iterating ;
! FFI
M: #alien-invoke emit-node

32
unfinished/compiler/cfg/cfg.factor
View File

@ -3,45 +3,25 @@
USING: kernel accessors namespaces assocs sequences sets fry ;
IN: compiler.cfg
TUPLE: procedure entry word label ;
TUPLE: cfg entry word label ;
C: <procedure> procedure
C: <cfg> cfg
! - "id" is a globally unique id used for hashcode*.
! - "number" is assigned by linearization.
! - "number" and "visited" is used by linearization.
TUPLE: basic-block < identity-tuple
id
visited
number
label
instructions
successors
predecessors ;
SYMBOL: next-block-id
: <basic-block> ( -- basic-block )
basic-block new
next-block-id counter >>id
V{ } clone >>instructions
V{ } clone >>successors
V{ } clone >>predecessors ;
M: basic-block hashcode* id>> nip ;
TUPLE: mr instructions word label ;
! Utilities
SYMBOL: visited-blocks
: visit-block ( basic-block quot -- )
over visited-blocks get 2dup key?
[ 2drop 2drop ] [ conjoin call ] if ; inline
: (each-block) ( basic-block quot -- )
'[
_
[ call ]
[ [ successors>> ] dip '[ _ (each-block) ] each ]
2bi
] visit-block ; inline
: each-block ( basic-block quot -- )
H{ } clone visited-blocks [ (each-block) ] with-variable ; inline
C: <mr> mr

29
unfinished/compiler/cfg/debugger/debugger.factor Normal file
View File

@ -0,0 +1,29 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words sequences quotations namespaces io
accessors prettyprint prettyprint.config
compiler.tree.builder compiler.tree.optimizer
compiler.cfg.builder compiler.cfg.linearization ;
IN: compiler.cfg.debugger
GENERIC: test-cfg ( quot -- cfgs )
M: callable test-cfg
build-tree optimize-tree gensym gensym build-cfg ;
M: word test-cfg
[ build-tree-from-word nip optimize-tree ] keep dup
build-cfg ;
: test-mr ( quot -- mrs ) test-cfg [ build-mr ] map ;
: mr. ( mrs -- )
[
boa-tuples? on
"=== word: " write
dup word>> pprint
", label: " write
dup label>> pprint nl nl
instructions>> .
nl
] each ;

4
unfinished/compiler/machine/linear-scan/allocation/allocation.factor → unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces sequences math math.order kernel assocs
accessors vectors fry
compiler.machine.linear-scan.live-intervals
compiler.cfg.linear-scan.live-intervals
compiler.backend ;
IN: compiler.machine.linear-scan.allocation
IN: compiler.cfg.linear-scan.allocation
! Mapping from vregs to machine registers
SYMBOL: register-allocation

8
unfinished/compiler/machine/linear-scan/linear-scan.factor → unfinished/compiler/cfg/linear-scan/linear-scan.factor
View File

@ -1,12 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler.machine.linear-scan
IN: compiler.cfg.linear-scan
! See http://www.cs.ucla.edu/~palsberg/course/cs132/linearscan.pdf
! ! ! Step 1: compute live intervals
! ! ! Step 2: allocate registers

2
unfinished/compiler/machine/linear-scan/live-intervals/live-intervals.factor → unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs accessors sequences math
math.order sorting compiler.instructions compiler.registers ;
IN: compiler.machine.linear-scan.live-intervals
IN: compiler.cfg.linear-scan.live-intervals
TUPLE: live-interval < identity-tuple vreg start end ;

93
unfinished/compiler/cfg/linearization/linearization.factor Normal file
View File

@ -0,0 +1,93 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math accessors sequences namespaces make
combinators compiler.cfg compiler.cfg.rpo compiler.instructions
compiler.instructions.syntax ;
IN: compiler.cfg.linearization
! Convert CFG IR to machine IR.
SYMBOL: frame-size
: compute-frame-size ( rpo -- )
[ instructions>> [ %frame-required? ] filter ] map concat
[ f ] [ [ n>> ] map supremum ] if-empty
frame-size set ;
GENERIC: linearize-insn ( basic-block insn -- )
: linearize-insns ( basic-block -- )
dup instructions>> [ linearize-insn ] with each ; inline
M: insn linearize-insn , drop ;
M: %frame-required linearize-insn 2drop ;
M: %prologue linearize-insn
2drop frame-size get [ _prologue ] when* ;
M: %epilogue linearize-insn
2drop frame-size get [ _epilogue ] when* ;
: useless-branch? ( basic-block successor -- ? )
#! If our successor immediately follows us in RPO, then we
#! don't need to branch.
[ number>> 1+ ] [ number>> ] bi* = ; inline
: branch-to-return? ( successor -- ? )
#! A branch to a block containing just a return is cloned.
instructions>> dup length 2 = [
[ first %epilogue? ] [ second %return? ] bi and
] [ drop f ] if ;
: emit-branch ( basic-block successor -- )
{
{ [ 2dup useless-branch? ] [ 2drop ] }
{ [ dup branch-to-return? ] [ nip linearize-insns ] }
[ nip label>> _branch ]
} cond ;
M: %branch linearize-insn
drop dup successors>> first emit-branch ;
: conditional ( basic-block -- basic-block successor1 label2 )
dup successors>> first2 swap label>> ; inline
: boolean-conditional ( basic-block insn -- basic-block successor vreg label2 )
[ conditional ] [ vreg>> ] bi* swap ; inline
M: %branch-f linearize-insn
boolean-conditional _branch-f emit-branch ;
M: %branch-t linearize-insn
boolean-conditional _branch-t emit-branch ;
M: %if-intrinsic linearize-insn
[ conditional ] [ [ quot>> ] [ vregs>> ] bi ] bi*
_if-intrinsic emit-branch ;
M: %boolean-intrinsic linearize-insn
[
"false" define-label
"end" define-label
"false" get over [ quot>> ] [ vregs>> ] bi _if-intrinsic
t over out>> %load-literal
"end" get _branch
"false" resolve-label
f over out>> %load-literal
"end" resolve-label
] with-scope
2drop ;
: linearize-basic-block ( bb -- )
[ label>> _label ] [ linearize-insns ] bi ;
: linearize-basic-blocks ( rpo -- insns )
[ [ linearize-basic-block ] each ] { } make ;
: build-mr ( cfg -- mr )
[
entry>> reverse-post-order [
[ compute-frame-size ]
[ linearize-basic-blocks ] bi
] with-scope
] [ word>> ] [ label>> ] tri <mr> ;

21
unfinished/compiler/cfg/rpo/rpo.factor Normal file
View File

@ -0,0 +1,21 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces make math sequences
compiler.instructions ;
IN: compiler.cfg.rpo
: post-order-traversal ( basic-block -- )
dup visited>> [ drop ] [
t >>visited
<label> >>label
[ successors>> [ post-order-traversal ] each ] [ , ] bi
] if ;
: post-order ( procedure -- blocks )
[ post-order-traversal ] { } make ;
: number-blocks ( blocks -- )
[ >>number drop ] each-index ;
: reverse-post-order ( procedure -- blocks )
post-order <reversed> dup number-blocks ; inline

54
unfinished/compiler/instructions/instructions.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs accessors arrays kernel sequences
compiler.instructions.syntax ;
USING: assocs accessors arrays kernel sequences namespaces
math compiler.instructions.syntax ;
IN: compiler.instructions
! Virtual CPU instructions, used by CFG and machine IRs
@ -17,9 +17,6 @@ INSN: %inc-r n ;
INSN: %load-literal obj vreg ;
! Calling convention
INSN: %prologue ;
INSN: %epilogue ;
INSN: %frame-required n ;
INSN: %return ;
! Subroutine calls
@ -31,15 +28,6 @@ INSN: %intrinsic quot vregs ;
INSN: %dispatch-label label ;
INSN: %dispatch ;
! Unconditional branch to successor (CFG only)
INSN: %branch ;
! Conditional branches (CFG only)
INSN: %branch-f < %cond-branch ;
INSN: %branch-t < %cond-branch ;
INSN: %if-intrinsic quot vregs ;
INSN: %boolean-intrinsic quot vregs out ;
! Boxing and unboxing
INSN: %copy < %unary ;
INSN: %copy-float < %unary ;
@ -64,9 +52,45 @@ M: insn uses-vregs drop f ;
M: %peek uses-vregs vreg>> 1array ;
M: %replace uses-vregs vreg>> 1array ;
M: %load-literal uses-vregs vreg>> 1array ;
M: %cond-branch uses-vregs vreg>> 1array ;
M: %unary uses-vregs [ dst>> ] [ src>> ] bi 2array ;
M: %intrinsic uses-vregs vregs>> values ;
! Instructions used by CFG IR only.
INSN: %prologue ;
INSN: %epilogue ;
INSN: %frame-required n ;
INSN: %branch ;
INSN: %branch-f < %cond-branch ;
INSN: %branch-t < %cond-branch ;
INSN: %if-intrinsic quot vregs ;
INSN: %boolean-intrinsic quot vregs out ;
M: %cond-branch uses-vregs vreg>> 1array ;
M: %if-intrinsic uses-vregs vregs>> values ;
M: %boolean-intrinsic uses-vregs
[ vregs>> values ] [ out>> ] bi suffix ;
! Instructions used by machine IR only.
INSN: _prologue n ;
INSN: _epilogue n ;
TUPLE: label id ;
INSN: _label label ;
: <label> ( -- label ) \ <label> counter label boa ;
: define-label ( name -- ) <label> swap set ;
: resolve-label ( label/name -- )
dup label? [ get ] unless _label ;
TUPLE: _cond-branch vreg label ;
INSN: _branch label ;
INSN: _branch-f < _cond-branch ;
INSN: _branch-t < _cond-branch ;
INSN: _if-intrinsic label quot vregs ;
M: _cond-branch uses-vregs vreg>> 1array ;
M: _if-intrinsic uses-vregs vregs>> values ;

72
unfinished/compiler/machine/builder/builder.factor
View File

@ -1,72 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math accessors sequences namespaces make
compiler.cfg compiler.instructions compiler.machine ;
IN: compiler.machine.builder
! Convert CFG IR to machine IR.
SYMBOL: block-counter
: number-basic-block ( basic-block -- )
#! Make this fancy later.
dup number>> [ drop ] [
<label> >>label
block-counter [ dup 1+ ] change >>number
[ , ] [
successors>> <reversed>
[ number-basic-block ] each
] bi
] if ;
: flatten-basic-blocks ( procedure -- blocks )
[
0 block-counter
[ number-basic-block ]
with-variable
] { } make ;
GENERIC: linearize* ( basic-block insn -- )
M: object linearize* , drop ;
M: %branch linearize*
drop successors>> first label>> _branch ;
: conditional ( basic-block -- label1 label2 )
successors>> first2 [ label>> ] bi@ swap ; inline
: boolean-conditional ( basic-block insn -- label1 vreg label2 )
[ conditional ] [ vreg>> ] bi* swap ; inline
M: %branch-f linearize*
boolean-conditional _branch-f _branch ;
M: %branch-t linearize*
boolean-conditional _branch-t _branch ;
M: %if-intrinsic linearize*
[ conditional ] [ [ quot>> ] [ vregs>> ] bi ] bi*
_if-intrinsic _branch ;
M: %boolean-intrinsic linearize*
[
"false" define-label
"end" define-label
"false" get over [ quot>> ] [ vregs>> ] bi _if-intrinsic
t over out>> %load-literal
"end" get _branch
"false" resolve-label
f over out>> %load-literal
"end" resolve-label
] with-scope
2drop ;
: build-machine ( procedure -- insns )
[
entry>> flatten-basic-blocks [
[ label>> _label ]
[ dup instructions>> [ linearize* ] with each ]
bi
] each
] { } make ;

27
unfinished/compiler/machine/machine.factor
View File

@ -1,27 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs accessors arrays namespaces kernel math
sequences compiler.instructions compiler.instructions.syntax ;
IN: compiler.machine
! Machine representation. Flat list of instructions, all
! registers allocated, with labels and jumps.
INSN: _prologue n ;
INSN: _epilogue n ;
INSN: _label label ;
: <label> ( -- label ) \ <label> counter ;
: define-label ( name -- ) <label> swap set ;
: resolve-label ( label/name -- ) dup integer? [ get ] unless _label ;
TUPLE: _cond-branch vreg label ;
INSN: _branch label ;
INSN: _branch-f < _cond-branch ;
INSN: _branch-t < _cond-branch ;
INSN: _if-intrinsic label quot vregs ;
M: _cond-branch uses-vregs vreg>> 1array ;
M: _if-intrinsic uses-vregs vregs>> values ;

4
unfinished/compiler/machine/optimizer/optimizer-tests.factor
View File

@ -1,4 +0,0 @@
IN: compiler.machine.optimizer.tests
USING: compiler.machine.optimizer tools.test ;
\ optimize-machine must-infer

39
unfinished/compiler/machine/optimizer/optimizer.factor
View File

@ -1,39 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math namespaces make sequences
sequences.next
compiler.instructions
compiler.instructions.syntax
compiler.machine ;
IN: compiler.machine.optimizer
: frame-required ( insns -- n/f )
[ %frame-required? ] filter
[ f ] [ [ n>> ] map supremum ] if-empty ;
GENERIC: optimize* ( next insn -- )
: useless-branch? ( next insn -- ? )
over _label? [ [ label>> ] bi@ = ] [ 2drop f ] if ;
M: _branch optimize*
#! Remove unconditional branches to labels immediately
#! following.
tuck useless-branch? [ drop ] [ , ] if ;
M: %prologue optimize*
2drop \ frame-required get [ _prologue ] when* ;
M: %epilogue optimize*
2drop \ frame-required get [ _epilogue ] when* ;
M: %frame-required optimize* 2drop ;
M: insn optimize* nip , ;
: optimize-machine ( insns -- insns )
[
[ frame-required \ frame-required set ]
[ [ optimize* ] each-next ]
bi
] { } make ;