diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 53f0557db5..bc0eb74554 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -1,8 +1,8 @@ ! 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 combinators.short-circuit accessors math -sequences sets ; +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 ; IN: compiler.cfg.checker ERROR: last-insn-not-a-jump insn ; @@ -27,11 +27,25 @@ ERROR: bad-loop-entry ; [ bad-loop-entry ] when ] [ drop ] if ; +ERROR: bad-successors ; + +: check-successors ( bb -- ) + dup successors>> [ predecessors>> memq? ] with all? + [ bad-successors ] unless ; + : check-basic-block ( bb -- ) - [ check-last-instruction ] [ check-loop-entry ] bi ; + [ instructions>> check-last-instruction ] + [ instructions>> check-loop-entry ] + [ check-successors ] + tri ; + +ERROR: bad-live-in ; : check-rpo ( rpo -- ) - [ instructions>> check-basic-block ] each ; + [ compute-liveness ] + [ first live-in assoc-empty? [ bad-live-in ] unless ] + [ [ check-basic-block ] each ] + tri ; ERROR: undefined-values uses defs ; diff --git a/basis/compiler/cfg/useless-blocks/useless-blocks-tests.factor b/basis/compiler/cfg/useless-blocks/useless-blocks-tests.factor new file mode 100644 index 0000000000..ebc333b537 --- /dev/null +++ b/basis/compiler/cfg/useless-blocks/useless-blocks-tests.factor @@ -0,0 +1,11 @@ +IN: compiler.cfg.useless-blocks.tests +USING: fry kernel sequences compiler.cfg.useless-blocks compiler.cfg.checker +compiler.cfg.debugger compiler.cfg.predecessors tools.test ; + +{ + [ [ drop 1 ] when ] + [ [ drop 1 ] unless ] +} [ + [ [ ] ] dip + '[ _ test-cfg first dup compute-predecessors dup delete-useless-blocks check-cfg ] unit-test +] each \ No newline at end of file diff --git a/basis/compiler/cfg/useless-blocks/useless-blocks.factor b/basis/compiler/cfg/useless-blocks/useless-blocks.factor index b4999a8074..b6ec1a72ce 100644 --- a/basis/compiler/cfg/useless-blocks/useless-blocks.factor +++ b/basis/compiler/cfg/useless-blocks/useless-blocks.factor @@ -1,10 +1,12 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors sequences combinators classes vectors -compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ; +USING: kernel accessors sequences combinators combinators.short-circuit +classes vectors compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ; IN: compiler.cfg.useless-blocks : update-predecessor-for-delete ( bb -- ) + ! We have to replace occurrences of bb with bb's successor + ! in bb's predecessor's list of successors. dup predecessors>> first [ [ 2dup eq? [ drop successors>> first ] [ nip ] if @@ -12,9 +14,13 @@ IN: compiler.cfg.useless-blocks ] change-successors drop ; : update-successor-for-delete ( bb -- ) - [ predecessors>> first ] - [ successors>> first predecessors>> ] - bi set-first ; + ! We have to replace occurrences of bb with bb's predecessor + ! in bb's sucessor's list of predecessors. + dup successors>> first [ + [ + 2dup eq? [ drop predecessors>> first ] [ nip ] if + ] with map + ] change-predecessors drop ; : delete-basic-block ( bb -- ) [ update-predecessor-for-delete ] @@ -23,12 +29,11 @@ IN: compiler.cfg.useless-blocks : delete-basic-block? ( bb -- ? ) { - { [ dup instructions>> length 1 = not ] [ f ] } - { [ dup predecessors>> length 1 = not ] [ f ] } - { [ dup successors>> length 1 = not ] [ f ] } - { [ dup instructions>> first ##branch? not ] [ f ] } - [ t ] - } cond nip ; + [ instructions>> length 1 = ] + [ predecessors>> length 1 = ] + [ successors>> length 1 = ] + [ instructions>> first ##branch? ] + } 1&& ; : delete-useless-blocks ( cfg -- ) [