Insert _loop-entry in linearization pass instead of in CFG builder, so that optimizations don't have to worry about it

basis/compiler/cfg/builder/builder.factor

@@ -86,7 +86,6 @@ GENERIC: emit-node ( node -- )
     basic-block get swap loops get set-at ;
 
 : emit-loop ( node -- )
-    ##loop-entry
     ##branch
     begin-basic-block
     [ label>> id>> remember-loop ] [ child>> emit-nodes ] bi ;

basis/compiler/cfg/checker/checker.factor

@@ -2,14 +2,17 @@
 ! 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.utilities
-combinators.short-circuit accessors math sequences sets assocs ;
+compiler.cfg.mr combinators.short-circuit accessors math sequences
+sets assocs ;
 IN: compiler.cfg.checker
 
 ERROR: bad-kill-block bb ;
 
 : check-kill-block ( bb -- )
     dup instructions>> first2
-    swap ##epilogue? [ [ ##return? ] [ ##callback-return? ] bi or ] [ ##branch? ] if
+    swap ##epilogue? [
+        { [ ##return? ] [ ##callback-return? ] [ ##jump? ] } 1||
+    ] [ ##branch? ] if
     [ drop ] [ bad-kill-block ] if ;
 
 ERROR: last-insn-not-a-jump bb ;
@@ -26,14 +29,6 @@ ERROR: last-insn-not-a-jump bb ;
         [ ##no-tco? ]
     } 1|| [ drop ] [ last-insn-not-a-jump ] if ;
 
-ERROR: bad-loop-entry bb ;
-
-: check-loop-entry ( bb -- )
-    dup instructions>> dup length 2 >= [
-        2 head* [ ##loop-entry? ] any?
-        [ bad-loop-entry ] [ drop ] if
-    ] [ 2drop ] if ;
-
 ERROR: bad-kill-insn bb ;
 
 : check-kill-instructions ( bb -- )
@@ -41,10 +36,9 @@ ERROR: bad-kill-insn bb ;
     [ bad-kill-insn ] [ drop ] if ;
 
 : check-normal-block ( bb -- )
-    [ check-loop-entry ]
     [ check-last-instruction ]
     [ check-kill-instructions ]
-    tri ;
+    bi ;
 
 ERROR: bad-successors ;
 
@@ -70,5 +64,5 @@ ERROR: undefined-values uses defs ;
 
 : check-cfg ( cfg -- )
     [ [ check-basic-block ] each-basic-block ]
-    [ flatten-cfg check-mr ]
+    [ build-mr check-mr ]
     bi ;

basis/compiler/cfg/instructions/instructions.factor

@@ -170,8 +170,6 @@ INSN: ##epilogue ;
 
 INSN: ##branch ;
 
-INSN: ##loop-entry ;
-
 INSN: ##phi < ##pure inputs ;
 
 ! Conditionals
@@ -201,6 +199,7 @@ INSN: _epilogue stack-frame ;
 INSN: _label id ;
 
 INSN: _branch label ;
+INSN: _loop-entry ;
 
 INSN: _dispatch src temp ;
 INSN: _dispatch-label label ;

basis/compiler/cfg/linearization/linearization.factor

@@ -6,7 +6,8 @@ compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.comparisons
 compiler.cfg.stack-frame
-compiler.cfg.instructions ;
+compiler.cfg.instructions
+compiler.cfg.utilities ;
 IN: compiler.cfg.linearization
 
 ! Convert CFG IR to machine IR.
@@ -24,7 +25,11 @@ M: insn linearize-insn , drop ;
     #! don't need to branch.
     [ number>> ] bi@ 1 - = ; inline
 
-: emit-branch ( basic-block successor -- )
+: emit-loop-entry? ( bb -- ? )
+    dup predecessors>> [ swap back-edge? ] with any? ;
+
+: emit-branch ( bb successor -- )
+    dup emit-loop-entry? [ _loop-entry ] when
     2dup useless-branch? [ 2drop ] [ nip number>> _branch ] if ;
 
 M: ##branch linearize-insn
@@ -32,11 +37,11 @@ M: ##branch linearize-insn
 
 : successors ( bb -- first second ) successors>> first2 ; inline
 
-: (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc )
+: (binary-conditional) ( bb insn -- bb successor1 successor2 src1 src2 cc )
     [ dup successors ]
     [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
 
-: binary-conditional ( basic-block insn -- basic-block successor label2 src1 src2 cc )
+: binary-conditional ( bb insn -- bb successor label2 src1 src2 cc )
     [ (binary-conditional) ]
     [ drop dup successors>> second useless-branch? ] 2bi
     [ [ swap number>> ] 3dip ] [ [ number>> ] 3dip negate-cc ] if ;
@@ -53,7 +58,7 @@ M: ##compare-imm-branch linearize-insn
 M: ##compare-float-branch linearize-insn
     [ binary-conditional _compare-float-branch ] with-regs emit-branch ;
 
-: overflow-conditional ( basic-block insn -- basic-block successor label2 dst src1 src2 )
+: overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 )
     [ dup successors number>> ]
     [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline
 

basis/compiler/cfg/optimizer/optimizer-tests.factor

@@ -1,8 +1,8 @@
-USING: accessors arrays compiler.cfg.checker
-compiler.cfg.debugger compiler.cfg.def-use
-compiler.cfg.instructions fry kernel kernel.private math
-math.partial-dispatch math.private sbufs sequences sequences.private sets
-slots.private strings strings.private tools.test vectors layouts ;
+USING: accessors arrays compiler.cfg.checker compiler.cfg.debugger
+compiler.cfg.def-use compiler.cfg.instructions compiler.cfg.optimizer
+fry kernel kernel.private math math.partial-dispatch math.private
+sbufs sequences sequences.private sets slots.private strings
+strings.private tools.test vectors layouts ;
 IN: compiler.cfg.optimizer.tests
 
 ! Miscellaneous tests
@@ -45,7 +45,7 @@ IN: compiler.cfg.optimizer.tests
         set-string-nth-fast
     ]
 } [
-    [ [ ] ] dip '[ _ test-mr first check-mr ] unit-test
+    [ [ ] ] dip '[ _ test-cfg first optimize-cfg check-cfg ] unit-test
 ] each
 
 cell 8 = [

basis/compiler/cfg/optimizer/optimizer.factor

@@ -5,7 +5,6 @@ compiler.cfg.tco
 compiler.cfg.predecessors
 compiler.cfg.useless-conditionals
 compiler.cfg.dcn
-compiler.cfg.dominance
 compiler.cfg.ssa
 compiler.cfg.branch-splitting
 compiler.cfg.block-joining
@@ -36,7 +35,6 @@ SYMBOL: check-optimizer?
         join-blocks
         compute-predecessors
         deconcatenatize
-        compute-dominance
         construct-ssa
         alias-analysis
         value-numbering

basis/compiler/codegen/codegen.factor

@@ -245,7 +245,7 @@ M: _gc generate-insn
         [ gc-root-count>> ]
     } cleave %gc ;
 
-M: ##loop-entry generate-insn drop %loop-entry ;
+M: _loop-entry generate-insn drop %loop-entry ;
 
 M: ##alien-global generate-insn
     [ dst>> register ] [ symbol>> ] [ library>> ] tri