diff --git a/unfinished/compiler/cfg/builder/builder-tests.factor b/unfinished/compiler/cfg/builder/builder-tests.factor index ddc7d13f25..a9f3f2eaa9 100644 --- a/unfinished/compiler/cfg/builder/builder-tests.factor +++ b/unfinished/compiler/cfg/builder/builder-tests.factor @@ -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 diff --git a/unfinished/compiler/cfg/builder/builder.factor b/unfinished/compiler/cfg/builder/builder.factor index 0e13491a08..86e69a50b7 100755 --- a/unfinished/compiler/cfg/builder/builder.factor +++ b/unfinished/compiler/cfg/builder/builder.factor @@ -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 - procedures get push ; + 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 diff --git a/unfinished/compiler/cfg/cfg.factor b/unfinished/compiler/cfg/cfg.factor index 92a5700af4..9acf0897b9 100644 --- a/unfinished/compiler/cfg/cfg.factor +++ b/unfinished/compiler/cfg/cfg.factor @@ -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 +C: 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 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 diff --git a/unfinished/compiler/cfg/debugger/debugger.factor b/unfinished/compiler/cfg/debugger/debugger.factor new file mode 100644 index 0000000000..65b0b97476 --- /dev/null +++ b/unfinished/compiler/cfg/debugger/debugger.factor @@ -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 ; diff --git a/unfinished/compiler/machine/linear-scan/allocation/allocation.factor b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor similarity index 96% rename from unfinished/compiler/machine/linear-scan/allocation/allocation.factor rename to unfinished/compiler/cfg/linear-scan/allocation/allocation.factor index 9d964c98d7..37e1d512cd 100644 --- a/unfinished/compiler/machine/linear-scan/allocation/allocation.factor +++ b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor @@ -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 diff --git a/unfinished/compiler/machine/linear-scan/linear-scan.factor b/unfinished/compiler/cfg/linear-scan/linear-scan.factor similarity index 60% rename from unfinished/compiler/machine/linear-scan/linear-scan.factor rename to unfinished/compiler/cfg/linear-scan/linear-scan.factor index 260e0afded..307eecf53a 100644 --- a/unfinished/compiler/machine/linear-scan/linear-scan.factor +++ b/unfinished/compiler/cfg/linear-scan/linear-scan.factor @@ -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 - - diff --git a/unfinished/compiler/machine/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor similarity index 95% rename from unfinished/compiler/machine/linear-scan/live-intervals/live-intervals.factor rename to unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index d5e1543a1c..6a3514c4e2 100644 --- a/unfinished/compiler/machine/linear-scan/live-intervals/live-intervals.factor +++ b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -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 ; diff --git a/unfinished/compiler/cfg/linearization/linearization.factor b/unfinished/compiler/cfg/linearization/linearization.factor new file mode 100644 index 0000000000..2aa7c66777 --- /dev/null +++ b/unfinished/compiler/cfg/linearization/linearization.factor @@ -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 ; diff --git a/unfinished/compiler/cfg/rpo/rpo.factor b/unfinished/compiler/cfg/rpo/rpo.factor new file mode 100644 index 0000000000..d5280a8142 --- /dev/null +++ b/unfinished/compiler/cfg/rpo/rpo.factor @@ -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 +