diff --git a/unfinished/compiler/cfg/cfg.factor b/unfinished/compiler/cfg/cfg.factor index 54b991bff1..140d406c4c 100644 --- a/unfinished/compiler/cfg/cfg.factor +++ b/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 +: ( instructions word label -- mr ) + mr new + swap >>label + swap >>word + swap >>instructions ; diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor index 415f964acf..9bb576dcb3 100644 --- a/unfinished/compiler/cfg/instructions/instructions.factor +++ b/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: _epilogue n ; +INSN: _prologue ; +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: _reload dst n ; +INSN: _spill-integer src n ; +INSN: _reload-integer dst n ; + +INSN: _spill-float src n ; +INSN: _reload-float dst n ; diff --git a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor index 0bfcc8bcd0..4a9646c88a 100644 --- a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/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 ) - spill-counter [ dup 1+ ] change ; +: next-spill-location ( reg-class -- n ) + 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 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 - dup init-unhandled - (allocate-registers) - ] with-scope ; + init-allocator + dup init-unhandled + (allocate-registers) ; diff --git a/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor b/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor index 8b53ee9531..ffe8e6b687 100644 --- a/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/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 diff --git a/unfinished/compiler/cfg/linear-scan/linear-scan.factor b/unfinished/compiler/cfg/linear-scan/linear-scan.factor index 80737badc3..f62e3a39d1 100644 --- a/unfinished/compiler/cfg/linear-scan/linear-scan.factor +++ b/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 - assign-registers - ] change-instructions ; + [ + dup compute-live-intervals + machine-registers allocate-registers + assign-registers + ] change-instructions + spill-counts get >>spill-counts + ] with-scope ; diff --git a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index d6ee979fe5..a0699b80bd 100644 --- a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/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 [ - [ compute-live-intervals* ] each-index - ] with-variable + live-intervals set + [ compute-live-intervals* ] each-index ] keep finalize-live-intervals ; diff --git a/unfinished/compiler/cfg/linearization/linearization.factor b/unfinished/compiler/cfg/linearization/linearization.factor index fd21b5d3b6..24730cd17f 100644 --- a/unfinished/compiler/cfg/linearization/linearization.factor +++ b/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 [ - [ compute-frame-size ] - [ linearize-basic-blocks ] bi - ] with-scope - ] [ word>> ] [ label>> ] tri ; + [ entry>> reverse-post-order linearize-basic-blocks ] + [ word>> ] [ label>> ] + tri ; diff --git a/unfinished/compiler/cfg/stack-frame/stack-frame.factor b/unfinished/compiler/cfg/stack-frame/stack-frame.factor new file mode 100644 index 0000000000..56282cfb09 --- /dev/null +++ b/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 ; diff --git a/unfinished/compiler/codegen/codegen.factor b/unfinished/compiler/codegen/codegen.factor index 9ed7b3132f..15ebd691bf 100644 --- a/unfinished/compiler/codegen/codegen.factor +++ b/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 ; diff --git a/unfinished/compiler/new/new.factor b/unfinished/compiler/new/new.factor index 9b640b8d84..fd402916a0 100644 --- a/unfinished/compiler/new/new.factor +++ b/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 -- ) '[