From f19ee61d3ab92368ebc4cdbca6438223bbc23ff5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 28 Jul 2009 07:39:46 -0500 Subject: [PATCH] compiler.cfg.linear-scan: use compiler.cfg.parallel-copy in resolve pass --- .../linear-scan/assignment/assignment.factor | 34 +--- .../cfg/linear-scan/linear-scan.factor | 4 +- .../linear-scan/mapping/mapping-tests.factor | 145 ------------------ .../cfg/linear-scan/mapping/mapping.factor | 142 ----------------- .../cfg/linear-scan/resolve/resolve.factor | 53 +++++-- .../cfg/parallel-copy/parallel-copy.factor | 2 +- 6 files changed, 50 insertions(+), 330 deletions(-) delete mode 100644 basis/compiler/cfg/linear-scan/mapping/mapping-tests.factor delete mode 100644 basis/compiler/cfg/linear-scan/mapping/mapping.factor diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 8e21e7e3fb..370f562fc4 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -9,7 +9,6 @@ compiler.cfg.def-use compiler.cfg.liveness compiler.cfg.registers compiler.cfg.instructions -compiler.cfg.linear-scan.mapping compiler.cfg.linear-scan.allocation compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.live-intervals ; @@ -44,44 +43,25 @@ SYMBOL: register-live-outs H{ } clone register-live-outs set init-unhandled ; +: insert-spill ( live-interval -- ) + [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ; + : handle-spill ( live-interval -- ) - dup spill-to>> [ - [ reg>> ] [ spill-to>> ] [ vreg>> reg-class>> ] tri - register->memory - ] [ drop ] if ; - -: first-split ( live-interval -- live-interval' ) - dup split-before>> [ first-split ] [ ] ?if ; - -: next-interval ( live-interval -- live-interval' ) - split-next>> first-split ; - -: handle-copy ( live-interval -- ) - dup split-next>> [ - [ reg>> ] [ next-interval reg>> ] [ vreg>> reg-class>> ] tri - register->register - ] [ drop ] if ; + dup spill-to>> [ insert-spill ] [ drop ] if ; : (expire-old-intervals) ( n heap -- ) dup heap-empty? [ 2drop ] [ 2dup heap-peek nip <= [ 2drop ] [ - dup heap-pop drop [ handle-spill ] [ handle-copy ] bi + dup heap-pop drop handle-spill (expire-old-intervals) ] if ] if ; : expire-old-intervals ( n -- ) - [ - pending-intervals get (expire-old-intervals) - ] { } make mapping-instructions % ; + pending-intervals get (expire-old-intervals) ; : insert-reload ( live-interval -- ) - { - [ reg>> ] - [ vreg>> reg-class>> ] - [ reload-from>> ] - [ start>> ] - } cleave f swap \ _reload boa , ; + [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ; : handle-reload ( live-interval -- ) dup reload-from>> [ insert-reload ] [ drop ] if ; diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor index b081f2ca6e..51b2f6db1b 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan.factor @@ -11,8 +11,7 @@ compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.allocation compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.assignment -compiler.cfg.linear-scan.resolve -compiler.cfg.linear-scan.mapping ; +compiler.cfg.linear-scan.resolve ; IN: compiler.cfg.linear-scan ! References: @@ -39,7 +38,6 @@ IN: compiler.cfg.linear-scan : linear-scan ( cfg -- cfg' ) [ - init-mapping dup machine-registers (linear-scan) spill-counts get >>spill-counts cfg-changed diff --git a/basis/compiler/cfg/linear-scan/mapping/mapping-tests.factor b/basis/compiler/cfg/linear-scan/mapping/mapping-tests.factor deleted file mode 100644 index d12167574a..0000000000 --- a/basis/compiler/cfg/linear-scan/mapping/mapping-tests.factor +++ /dev/null @@ -1,145 +0,0 @@ -USING: compiler.cfg.instructions -compiler.cfg.linear-scan.allocation.state -compiler.cfg.linear-scan.mapping cpu.architecture kernel -namespaces tools.test ; -IN: compiler.cfg.linear-scan.mapping.tests - -H{ { int-regs 10 } { float-regs 20 } } clone spill-counts set -init-mapping - -[ - { - T{ _copy { dst 5 } { src 4 } { class int-regs } } - T{ _spill { src 1 } { class int-regs } { n 10 } } - T{ _copy { dst 1 } { src 0 } { class int-regs } } - T{ _reload { dst 0 } { class int-regs } { n 10 } } - T{ _spill { src 1 } { class float-regs } { n 20 } } - T{ _copy { dst 1 } { src 0 } { class float-regs } } - T{ _reload { dst 0 } { class float-regs } { n 20 } } - } -] [ - { - T{ register->register { from 0 } { to 1 } { reg-class int-regs } } - T{ register->register { from 1 } { to 0 } { reg-class int-regs } } - T{ register->register { from 0 } { to 1 } { reg-class float-regs } } - T{ register->register { from 1 } { to 0 } { reg-class float-regs } } - T{ register->register { from 4 } { to 5 } { reg-class int-regs } } - } mapping-instructions -] unit-test - -[ - { - T{ _spill { src 2 } { class int-regs } { n 10 } } - T{ _copy { dst 2 } { src 1 } { class int-regs } } - T{ _copy { dst 1 } { src 0 } { class int-regs } } - T{ _reload { dst 0 } { class int-regs } { n 10 } } - } -] [ - { - T{ register->register { from 0 } { to 1 } { reg-class int-regs } } - T{ register->register { from 1 } { to 2 } { reg-class int-regs } } - T{ register->register { from 2 } { to 0 } { reg-class int-regs } } - } mapping-instructions -] unit-test - -[ - { - T{ _spill { src 0 } { class int-regs } { n 10 } } - T{ _copy { dst 0 } { src 2 } { class int-regs } } - T{ _copy { dst 2 } { src 1 } { class int-regs } } - T{ _reload { dst 1 } { class int-regs } { n 10 } } - } -] [ - { - T{ register->register { from 1 } { to 2 } { reg-class int-regs } } - T{ register->register { from 2 } { to 0 } { reg-class int-regs } } - T{ register->register { from 0 } { to 1 } { reg-class int-regs } } - } mapping-instructions -] unit-test - -[ - { - T{ _copy { dst 1 } { src 0 } { class int-regs } } - T{ _copy { dst 2 } { src 0 } { class int-regs } } - } -] [ - { - T{ register->register { from 0 } { to 1 } { reg-class int-regs } } - T{ register->register { from 0 } { to 2 } { reg-class int-regs } } - } mapping-instructions -] unit-test - -[ - { } -] [ - { - T{ register->register { from 4 } { to 4 } { reg-class int-regs } } - } mapping-instructions -] unit-test - -[ - { - T{ _spill { src 3 } { class int-regs } { n 4 } } - T{ _reload { dst 2 } { class int-regs } { n 1 } } - } -] [ - { - T{ register->memory { from 3 } { to T{ spill-slot f 4 } } { reg-class int-regs } } - T{ memory->register { from T{ spill-slot f 1 } } { to 2 } { reg-class int-regs } } - } mapping-instructions -] unit-test - - -[ - { - T{ _copy { dst 1 } { src 0 } { class int-regs } } - T{ _copy { dst 2 } { src 0 } { class int-regs } } - T{ _copy { dst 0 } { src 3 } { class int-regs } } - } -] [ - { - T{ register->register { from 0 } { to 1 } { reg-class int-regs } } - T{ register->register { from 3 } { to 0 } { reg-class int-regs } } - T{ register->register { from 0 } { to 2 } { reg-class int-regs } } - } mapping-instructions -] unit-test - -[ - { - T{ _copy { dst 1 } { src 0 } { class int-regs } } - T{ _copy { dst 2 } { src 0 } { class int-regs } } - T{ _spill { src 4 } { class int-regs } { n 10 } } - T{ _copy { dst 4 } { src 0 } { class int-regs } } - T{ _copy { dst 0 } { src 3 } { class int-regs } } - T{ _reload { dst 3 } { class int-regs } { n 10 } } - } -] [ - { - T{ register->register { from 0 } { to 1 } { reg-class int-regs } } - T{ register->register { from 0 } { to 2 } { reg-class int-regs } } - T{ register->register { from 3 } { to 0 } { reg-class int-regs } } - T{ register->register { from 4 } { to 3 } { reg-class int-regs } } - T{ register->register { from 0 } { to 4 } { reg-class int-regs } } - } mapping-instructions -] unit-test - -[ - { - T{ _copy { dst 2 } { src 0 } { class int-regs } } - T{ _copy { dst 9 } { src 1 } { class int-regs } } - T{ _copy { dst 1 } { src 0 } { class int-regs } } - T{ _spill { src 4 } { class int-regs } { n 10 } } - T{ _copy { dst 4 } { src 0 } { class int-regs } } - T{ _copy { dst 0 } { src 3 } { class int-regs } } - T{ _reload { dst 3 } { class int-regs } { n 10 } } - } -] [ - { - T{ register->register { from 0 } { to 1 } { reg-class int-regs } } - T{ register->register { from 0 } { to 2 } { reg-class int-regs } } - T{ register->register { from 1 } { to 9 } { reg-class int-regs } } - T{ register->register { from 3 } { to 0 } { reg-class int-regs } } - T{ register->register { from 4 } { to 3 } { reg-class int-regs } } - T{ register->register { from 0 } { to 4 } { reg-class int-regs } } - } mapping-instructions -] unit-test diff --git a/basis/compiler/cfg/linear-scan/mapping/mapping.factor b/basis/compiler/cfg/linear-scan/mapping/mapping.factor deleted file mode 100644 index 36678a2f53..0000000000 --- a/basis/compiler/cfg/linear-scan/mapping/mapping.factor +++ /dev/null @@ -1,142 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs classes.parser classes.tuple -combinators compiler.cfg.instructions -compiler.cfg.linear-scan.allocation.state fry hashtables kernel -locals make namespaces parser sequences sets words ; -IN: compiler.cfg.linear-scan.mapping - -SYMBOL: spill-temps - -: spill-temp ( reg-class -- n ) - spill-temps get [ next-spill-slot ] cache ; - -<< - -TUPLE: operation from to reg-class ; - -SYNTAX: OPERATION: - CREATE-CLASS dup save-location - [ operation { } define-tuple-class ] - [ dup '[ _ boa , ] (( from to reg-class -- )) define-declared ] bi ; - ->> - -OPERATION: register->memory -OPERATION: memory->register -OPERATION: register->register - -! This should never come up because of how spill slots are assigned, -! so make it an error. -: memory->memory ( from to reg-class -- ) drop [ n>> ] bi@ assert= ; - -GENERIC: >insn ( operation -- ) - -M: register->memory >insn - [ from>> ] [ reg-class>> ] [ to>> n>> ] tri _spill ; - -M: memory->register >insn - [ to>> ] [ reg-class>> ] [ from>> n>> ] tri _reload ; - -M: register->register >insn - [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ; - -SYMBOL: froms -SYMBOL: tos - -: from-reg ( operation -- seq ) - [ from>> ] [ reg-class>> ] bi 2array ; - -: to-reg ( operation -- seq ) - [ to>> ] [ reg-class>> ] bi 2array ; - -: start? ( operations -- pair ) - from-reg tos get key? not ; - -: independent-assignment? ( operations -- pair ) - to-reg froms get key? not ; - -: set-tos/froms ( operations -- ) - [ [ [ from-reg ] keep ] H{ } map>assoc froms set ] - [ [ [ to-reg ] keep ] H{ } map>assoc tos set ] - bi ; - -:: (trace-chain) ( obj hashtable -- ) - obj to-reg froms get at* [ - dup , - obj over hashtable clone [ maybe-set-at ] keep swap - [ (trace-chain) ] [ 2drop ] if - ] [ - drop - ] if ; - -: trace-chain ( obj -- seq ) - [ - dup , - dup dup associate (trace-chain) - ] { } make prune reverse ; - -: trace-chains ( seq -- seq' ) - [ trace-chain ] map concat ; - -ERROR: resolve-error ; - -: split-cycle ( operations -- chain spilled-operation ) - unclip [ - [ set-tos/froms ] - [ - [ start? ] find nip - [ resolve-error ] unless* trace-chain - ] bi - ] dip ; - -: break-cycle-n ( operations -- operations' ) - split-cycle [ - [ from>> ] - [ reg-class>> spill-temp ] - [ reg-class>> ] - tri \ register->memory boa - ] [ - [ reg-class>> spill-temp ] - [ to>> ] - [ reg-class>> ] - tri \ memory->register boa - ] bi [ 1array ] bi@ surround ; - -: break-cycle ( operations -- operations' ) - dup length { - { 1 [ ] } - [ drop break-cycle-n ] - } case ; - -: (group-cycles) ( seq -- ) - [ - dup set-tos/froms - unclip trace-chain - [ diff ] keep , (group-cycles) - ] unless-empty ; - -: group-cycles ( seq -- seqs ) - [ (group-cycles) ] { } make ; - -: remove-dead-mappings ( seq -- seq' ) - prune [ [ from-reg ] [ to-reg ] bi = not ] filter ; - -: parallel-mappings ( operations -- seq ) - [ - [ independent-assignment? not ] partition % - [ start? not ] partition - [ trace-chain ] map concat dup % - diff group-cycles [ break-cycle ] map concat % - ] { } make remove-dead-mappings ; - -: mapping-instructions ( mappings -- insns ) - [ { } ] [ - [ - [ set-tos/froms ] [ parallel-mappings ] bi - [ [ >insn ] each ] { } make - ] with-scope - ] if-empty ; - -: init-mapping ( -- ) - H{ } clone spill-temps set ; \ No newline at end of file diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index 56beaa5379..baa5099d8f 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -1,26 +1,24 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators -combinators.short-circuit fry kernel locals -make math sequences +combinators.short-circuit fry kernel locals namespaces +make math sequences hashtables compiler.cfg.rpo compiler.cfg.liveness compiler.cfg.utilities compiler.cfg.instructions +compiler.cfg.parallel-copy compiler.cfg.linear-scan.assignment -compiler.cfg.linear-scan.mapping ; +compiler.cfg.linear-scan.allocation.state ; IN: compiler.cfg.linear-scan.resolve +SYMBOL: spill-temps + +: spill-temp ( reg-class -- n ) + spill-temps get [ next-spill-slot ] cache ; + : add-mapping ( from to reg-class -- ) - over spill-slot? [ - pick spill-slot? - [ memory->memory ] - [ register->memory ] if - ] [ - pick spill-slot? - [ memory->register ] - [ register->register ] if - ] if ; + '[ _ 2array ] bi@ 2array , ; :: resolve-value-data-flow ( bb to vreg -- ) vreg bb vreg-at-end @@ -33,6 +31,36 @@ IN: compiler.cfg.linear-scan.resolve [ resolve-value-data-flow ] with with each ] { } make ; +: memory->register ( from to -- ) + swap [ first2 ] [ first n>> ] bi* _reload ; + +: register->memory ( from to -- ) + [ first2 ] [ first n>> ] bi* _spill ; + +: temp->register ( from to -- ) + nip [ first ] [ second ] [ second spill-temp ] tri _reload ; + +: register->temp ( from to -- ) + drop [ first2 ] [ second spill-temp ] bi _spill ; + +: register->register ( from to -- ) + swap [ first ] [ first2 ] bi* _copy ; + +SYMBOL: temp + +: >insn ( from to -- ) + { + { [ over temp eq? ] [ temp->register ] } + { [ dup temp eq? ] [ register->temp ] } + { [ over first spill-slot? ] [ memory->register ] } + { [ dup first spill-slot? ] [ register->memory ] } + [ register->register ] + } cond ; + +: mapping-instructions ( alist -- insns ) + >hashtable + [ temp [ swap >insn ] parallel-mapping ] { } make ; + : perform-mappings ( bb to mappings -- ) dup empty? [ 3drop ] [ mapping-instructions @@ -46,4 +74,5 @@ IN: compiler.cfg.linear-scan.resolve dup successors>> [ resolve-edge-data-flow ] with each ; : resolve-data-flow ( cfg -- ) + H{ } clone spill-temps set [ resolve-block-data-flow ] each-basic-block ; diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy.factor b/basis/compiler/cfg/parallel-copy/parallel-copy.factor index 550928b8ba..f5abc4be60 100644 --- a/basis/compiler/cfg/parallel-copy/parallel-copy.factor +++ b/basis/compiler/cfg/parallel-copy/parallel-copy.factor @@ -23,7 +23,7 @@ SYMBOLS: temp locs preds to-do ready ; temp set to-do set ready set - [ preds set ] + [ [ eq? not ] assoc-filter preds set ] [ [ nip dup ] H{ } assoc-map-as locs set ] [ keys [ init-to-do ] [ init-ready ] bi ] tri ;