Count integer and float spills separately, build stack frame after register allocation since spilling requires a stack frame

unfinished/compiler/cfg/cfg.factor

@@ -19,6 +19,10 @@ successors ;
         V{ } clone >>instructions
         V{ } clone >>successors ;
 
-TUPLE: mr instructions word label ;
+TUPLE: mr instructions word label frame-size spill-counts ;
 
-C: <mr> mr
+: <mr> ( instructions word label -- mr )
+    mr new
+        swap >>label
+        swap >>word
+        swap >>instructions ;

unfinished/compiler/cfg/instructions/instructions.factor

@@ -100,8 +100,8 @@ M: ##if-intrinsic defs-vregs intrinsic-defs-vregs ;
 M: ##if-intrinsic uses-vregs intrinsic-uses-vregs ;
 
 ! Instructions used by machine IR only.
-INSN: _prologue n ;
+INSN: _prologue ;
-INSN: _epilogue n ;
+INSN: _epilogue ;
 
 INSN: _label id ;
 
@@ -117,5 +117,8 @@ M: _cond-branch uses-vregs src>> >vreg 1array ;
 M: _if-intrinsic defs-vregs intrinsic-defs-vregs ;
 M: _if-intrinsic uses-vregs intrinsic-uses-vregs ;
 
-INSN: _spill src n ;
+INSN: _spill-integer src n ;
-INSN: _reload dst n ;
+INSN: _reload-integer dst n ;
+
+INSN: _spill-float src n ;
+INSN: _reload-float dst n ;

unfinished/compiler/cfg/linear-scan/allocation/allocation.factor

@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces sequences math math.order kernel assocs
 accessors vectors fry heaps
+compiler.cfg.registers
 compiler.cfg.linear-scan.live-intervals
 compiler.backend ;
 IN: compiler.cfg.linear-scan.allocation
@@ -68,10 +69,10 @@ SYMBOL: progress
     [ peek >>reg drop ] [ pop >>reg add-active ] if ;
 
 ! Spilling
-SYMBOL: spill-counter
+SYMBOL: spill-counts
 
-: next-spill-location ( -- n )
+: next-spill-location ( reg-class -- n )
-    spill-counter [ dup 1+ ] change ;
+    spill-counts get [ dup 1+ ] change-at ;
 
 : interval-to-spill ( -- live-interval )
     #! We spill the interval with the most distant use location.
@@ -141,7 +142,7 @@ SYMBOL: spill-counter
     V{ } clone active-intervals set
     <min-heap> unhandled-intervals set
     [ reverse >vector ] assoc-map free-registers set
-    0 spill-counter set
+    H{ { int-regs 0 } { double-float-regs 0 } } clone spill-counts set
     -1 progress set ;
 
 : handle-interval ( live-interval -- )
@@ -152,8 +153,6 @@ SYMBOL: spill-counter
 
 : allocate-registers ( live-intervals machine-registers -- live-intervals )
     #! This modifies the input live-intervals.
-    [
+    init-allocator
-        init-allocator
+    dup init-unhandled
-        dup init-unhandled
+    (allocate-registers) ;
-        (allocate-registers)
-    ] with-scope ;

unfinished/compiler/cfg/linear-scan/assignment/assignment.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math assocs namespaces sequences heaps
-fry make
+fry make combinators
 compiler.cfg.registers
 compiler.cfg.instructions
 compiler.cfg.linear-scan.live-intervals ;
@@ -34,7 +34,13 @@ SYMBOL: unhandled-intervals
     [ add-unhandled ] each ;
 
 : insert-spill ( live-interval -- )
-    [ reg>> ] [ spill-to>> ] bi dup [ _spill ] [ 2drop ] if ;
+    [ reg>> ] [ spill-to>> ] [ vreg>> reg-class>> ] tri
+    over [
+        {
+            { int-regs [ _spill-integer ] }
+            { double-float-regs [ _spill-float ] }
+        } case
+    ] [ 3drop ] if ;
 
 : expire-old-intervals ( n -- )
     active-intervals get
@@ -43,7 +49,13 @@ SYMBOL: unhandled-intervals
     [ insert-spill ] each ;
 
 : insert-reload ( live-interval -- )
-    [ reg>> ] [ reload-from>> ] bi dup [ _reload ] [ 2drop ] if ;
+    [ reg>> ] [ reload-from>> ] [ vreg>> reg-class>> ] tri
+    over [
+        {
+            { int-regs [ _reload-integer ] }
+            { double-float-regs [ _reload-float ] }
+        } case
+    ] [ 3drop ] if ;
 
 : activate-new-intervals ( n -- )
     #! Any live intervals which start on the current instruction

unfinished/compiler/cfg/linear-scan/linear-scan.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors
+USING: kernel accessors namespaces
 compiler.backend
 compiler.cfg
 compiler.cfg.linear-scan.live-intervals
@@ -24,7 +24,10 @@ IN: compiler.cfg.linear-scan
 
 : linear-scan ( mr -- mr' )
     [
-        dup compute-live-intervals
+        [
-        machine-registers allocate-registers
+            dup compute-live-intervals
-        assign-registers
+            machine-registers allocate-registers
-    ] change-instructions ;
+            assign-registers
+        ] change-instructions
+        spill-counts get >>spill-counts
+    ] with-scope ;

unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor

@@ -43,7 +43,6 @@ SYMBOL: live-intervals
 
 : compute-live-intervals ( instructions -- live-intervals )
     H{ } clone [
-        live-intervals [
+        live-intervals set
-            [ compute-live-intervals* ] each-index
+        [ compute-live-intervals* ] each-index
-        ] with-variable
     ] keep finalize-live-intervals ;

unfinished/compiler/cfg/linearization/linearization.factor

@@ -9,13 +9,6 @@ compiler.cfg.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 -- )
@@ -23,14 +16,6 @@ GENERIC: linearize-insn ( basic-block insn -- )
 
 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.
@@ -78,9 +63,6 @@ M: ##if-intrinsic linearize-insn
     [ [ linearize-basic-block ] each ] { } make ;
 
 : build-mr ( cfg -- mr )
-    [
+    [ entry>> reverse-post-order linearize-basic-blocks ]
-        entry>> reverse-post-order [
+    [ word>> ] [ label>> ]
-            [ compute-frame-size ]
+    tri <mr> ;
-            [ linearize-basic-blocks ] bi
-        ] with-scope
-    ] [ word>> ] [ label>> ] tri <mr> ;

unfinished/compiler/cfg/stack-frame/stack-frame.factor

@@ -0,0 +1,59 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces accessors math.order assocs kernel sequences
+make compiler.cfg.instructions compiler.cfg.instructions.syntax
+compiler.cfg.registers ;
+IN: compiler.cfg.stack-frame
+
+SYMBOL: frame-required?
+
+SYMBOL: frame-size
+
+SYMBOL: spill-counts
+
+: init-stack-frame-builder ( -- )
+    frame-required? off
+    0 frame-size set ;
+
+GENERIC: compute-frame-size* ( insn -- )
+
+M: ##frame-required compute-frame-size*
+    frame-required? on
+    n>> frame-size [ max ] change ;
+
+M: _spill-integer compute-frame-size*
+    drop frame-required? on ;
+
+M: _spill-float compute-frame-size*
+    drop frame-required? on ;
+
+M: insn compute-frame-size* drop ;
+
+: compute-frame-size ( insns -- )
+    [ compute-frame-size* ] each ;
+
+GENERIC: insert-pro/epilogues* ( insn -- )
+
+M: ##frame-required insert-pro/epilogues* drop ;
+
+M: ##prologue insert-pro/epilogues*
+    drop frame-required? get [ _prologue ] when ;
+
+M: ##epilogue insert-pro/epilogues*
+    drop frame-required? get [ _epilogue ] when ;
+
+M: insn insert-pro/epilogues* , ;
+
+: insert-pro/epilogues ( insns -- insns )
+    [ [ insert-pro/epilogues* ] each ] { } make ;
+
+: build-stack-frame ( mr -- mr )
+    [
+        init-stack-frame-builder
+        [
+            [ compute-frame-size ]
+            [ insert-pro/epilogues ]
+            bi
+        ] change-instructions
+        frame-size get >>frame-size
+    ] with-scope ;

unfinished/compiler/codegen/codegen.factor

@@ -71,10 +71,10 @@ M: _label generate-insn
     id>> lookup-label , ;
 
 M: _prologue generate-insn
-    n>> %prologue ;
+    drop %prologue ;
 
 M: _epilogue generate-insn
-    n>> %epilogue ;
+    drop %epilogue ;
 
 M: ##load-literal generate-insn
     [ obj>> ] [ dst>> v>operand ] bi load-literal ;

unfinished/compiler/new/new.factor

@@ -7,7 +7,7 @@ stack-checker stack-checker.state stack-checker.inlining
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder
 compiler.cfg.linearization compiler.cfg.linear-scan
-compiler.codegen ;
+compiler.cfg.stack-frame compiler.codegen ;
 IN: compiler.new
 
 SYMBOL: compile-queue
@@ -79,7 +79,13 @@ SYMBOL: +failed+
     bi ;
 
 : backend ( nodes word -- )
-    build-cfg [ build-mr linear-scan generate save-asm ] each ;
+    build-cfg [
+        build-mr
+        linear-scan
+        build-stack-frame
+        generate
+        save-asm
+    ] each ;
 
 : (compile) ( word -- )
     '[