compiler.cfg.scheduling: update to support multiple-output instructions

basis/compiler/cfg/dependence/dependence.factor

@@ -24,7 +24,7 @@ TUPLE: node
     children parent
     registers parent-index ;
 
-M: node equal?  [ number>> ] bi@ = ;
+M: node equal? over node? [ [ number>> ] bi@ = ] [ 2drop f ] if ;
 
 M: node hashcode* nip number>> ;
 
@@ -56,12 +56,9 @@ UNION: slot-insn
 
 UNION: memory-insn
     ##load-memory ##load-memory-imm
-    ##store-memory ##store-memory-imm ;
-
-UNION: alien-call-insn
-    ##save-context
-    ##alien-invoke ##alien-indirect ##alien-callback
-    ##unary-float-function ##binary-float-function ;
+    ##store-memory ##store-memory-imm
+    alien-call-insn
+    slot-insn ;
 
 : chain ( node var -- )
     dup get [
@@ -71,24 +68,14 @@ UNION: alien-call-insn
 
 GENERIC: add-control-edge ( node insn -- )
 
-M: stack-insn add-control-edge
-    loc>> chain ;
+M: stack-insn add-control-edge loc>> chain ;
 
-M: memory-insn add-control-edge
-    drop memory-insn chain ;
-
-M: slot-insn add-control-edge
-    drop slot-insn chain ;
-
-M: alien-call-insn add-control-edge
-    drop alien-call-insn chain ;
+M: memory-insn add-control-edge drop memory-insn chain ;
 
 M: object add-control-edge 2drop ;
 
 : add-control-edges ( nodes -- )
-    [
-        [ dup insn>> add-control-edge ] each
-    ] with-scope ;
+    [ [ dup insn>> add-control-edge ] each ] with-scope ;
 
 : set-follows ( nodes -- )
     [

basis/compiler/cfg/finalization/finalization.factor

@@ -1,15 +1,15 @@
 ! Copyright (C) 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel compiler.cfg.gc-checks
-compiler.cfg.representations compiler.cfg.save-contexts
-compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame
-compiler.cfg.linear-scan
+USING: kernel compiler.cfg.representations
+compiler.cfg.scheduling compiler.cfg.gc-checks
+compiler.cfg.save-contexts compiler.cfg.ssa.destruction
+compiler.cfg.build-stack-frame compiler.cfg.linear-scan
 compiler.cfg.stacks.uninitialized ;
 IN: compiler.cfg.finalization
 
 : finalize-cfg ( cfg -- cfg' )
     select-representations
-    ! schedule-instructions
+    schedule-instructions
     insert-gc-checks
     dup compute-uninitialized-sets
     insert-save-contexts

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

@@ -1,4 +1,5 @@
-USING: compiler.cfg.scheduling vocabs.loader namespaces tools.test ;
+USING: compiler.cfg.scheduling compiler.cfg.instructions
+vocabs.loader namespaces tools.test arrays kernel ;
 IN: compiler.cfg.scheduling.tests
 
 ! Recompile compiler.cfg.scheduling with extra tests,
@@ -9,3 +10,31 @@ t check-scheduling? [
     [ ] [ "compiler.cfg.scheduling" reload ] unit-test
     [ ] [ "compiler.cfg.dependence" reload ] unit-test
 ] with-variable
+
+[
+    { }
+    { }
+    { T{ ##test-branch } }
+] [
+    V{ T{ ##test-branch } }
+    split-3-ways
+    [ >array ] tri@
+] unit-test
+
+[
+    { T{ ##inc-d } T{ ##inc-r } T{ ##callback-inputs } }
+    { T{ ##add } T{ ##sub } T{ ##mul } }
+    { T{ ##test-branch } }
+] [
+    V{
+        T{ ##inc-d }
+        T{ ##inc-r }
+        T{ ##callback-inputs }
+        T{ ##add }
+        T{ ##sub }
+        T{ ##mul }
+        T{ ##test-branch }
+    }
+    split-3-ways
+    [ >array ] tri@
+] unit-test

basis/compiler/cfg/scheduling/scheduling.factor

@@ -52,21 +52,33 @@ ERROR: bad-delete-at key assoc ;
         , (reorder)
     ] when* ;
 
-: cut-by ( seq quot -- before after )
-    dupd find drop [ cut ] [ f ] if* ; inline
+UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ;
 
-UNION: initial-insn
-    ##phi ##inc-d ##inc-r ;
+UNION: final-insn
+##branch
+conditional-branch-insn
+##epilogue ##return
+##callback-outputs ;
 
-: split-3-ways ( insns -- first middle last )
-    [ initial-insn? not ] cut-by unclip-last ;
+: initial-insn-end ( insns -- n )
+    [ initial-insn? not ] find drop 0 or ;
+
+: final-insn-start ( insns -- n )
+    [ final-insn? not ] find-last drop [ 1 + ] [ 0 ] if* ;
+
+:: split-3-ways ( insns -- first middle last )
+    insns initial-insn-end :> a
+    insns final-insn-start :> b
+    insns a head-slice
+    a b insns <slice>
+    insns b tail-slice ;
 
 : reorder ( insns -- insns' )
     split-3-ways [
         build-dependence-graph
         build-fan-in-trees
         [ (reorder) ] V{ } make reverse
-    ] dip suffix append ;
+    ] dip 3append ;
 
 ERROR: not-all-instructions-were-scheduled old-bb new-bb ;
 
@@ -78,16 +90,16 @@ f check-scheduling? set-global
     [ [ length ] bi@ = ] [ [ unique ] bi@ = ] 2bi and
     [ old-bb new-bb not-all-instructions-were-scheduled ] unless ;
 
-ERROR: definition-after-usage vreg old-bb new-bb ;
+ERROR: definition-after-usage vregs old-bb new-bb ;
 
 :: check-usages ( new-bb old-bb -- )
     HS{ } clone :> useds
     new-bb instructions>> split-3-ways drop nip
     [| insn |
         insn uses-vregs [ useds adjoin ] each
-        insn defs-vreg :> def-reg
-        def-reg useds in?
-        [ def-reg old-bb new-bb definition-after-usage ] when
+        insn defs-vregs :> defs-vregs
+        defs-vregs useds intersects?
+        [ defs-vregs old-bb new-bb definition-after-usage ] when
     ] each ;
 
 : check-scheduling ( new-bb old-bb -- )
@@ -124,7 +136,7 @@ ERROR: definition-after-usage vreg old-bb new-bb ;
 
 : might-spill? ( bb -- ? )
     [ live-in assoc-size ]
-    [ instructions>> [ defs-vreg ] count ] bi
+    [ instructions>> [ defs-vregs length ] map-sum ] bi
     + num-registers >= ;
 
 : schedule-instructions ( cfg -- cfg' )