From 5a78956956444abe0e05e4a00095978387d6d3ca Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 21 Jun 2009 00:20:01 -0500
Subject: [PATCH] compiler.cfg.linear-scan: Working on resolve pass
---
.../linear-scan/assignment/assignment.factor | 28 +-
.../cfg/linear-scan/linear-scan-tests.factor | 636 +++++++++---------
.../cfg/linear-scan/linear-scan.factor | 16 +-
.../cfg/linear-scan/resolve/resolve.factor | 104 ++-
4 files changed, 429 insertions(+), 355 deletions(-)
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index bf2a56adbd..e55f42e774 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -40,16 +40,23 @@ ERROR: already-spilled ;
2dup key? [ already-spilled ] [ set-at ] if ;
: insert-spill ( live-interval -- )
- [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ;
+ {
+ [ reg>> ]
+ [ vreg>> reg-class>> ]
+ [ spill-to>> ]
+ [ end>> ]
+ } cleave f swap \ _spill boa , ;
: handle-spill ( live-interval -- )
dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ;
: insert-copy ( live-interval -- )
- [ split-next>> reg>> ]
- [ reg>> ]
- [ vreg>> reg-class>> ]
- tri _copy ;
+ {
+ [ split-next>> reg>> ]
+ [ reg>> ]
+ [ vreg>> reg-class>> ]
+ [ end>> ]
+ } cleave f swap \ _copy boa , ;
: handle-copy ( live-interval -- )
dup [ spill-to>> not ] [ split-next>> ] bi and
@@ -68,7 +75,12 @@ ERROR: already-reloaded ;
2dup key? [ delete-at ] [ already-reloaded ] if ;
: insert-reload ( live-interval -- )
- [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ;
+ {
+ [ reg>> ]
+ [ vreg>> reg-class>> ]
+ [ reload-from>> ]
+ [ end>> ]
+ } cleave f swap \ _reload boa , ;
: handle-reload ( live-interval -- )
dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ;
@@ -141,6 +153,6 @@ M: insn assign-registers-in-insn drop ;
] V{ } make
] change-instructions drop ;
-: assign-registers ( rpo live-intervals -- )
- init-assignment
+: assign-registers ( live-intervals rpo -- )
+ [ init-assignment ] dip
[ assign-registers-in-block ] each ;
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index b43294818b..b4f6302049 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -10,6 +10,8 @@ compiler.cfg.registers
compiler.cfg.liveness
compiler.cfg.predecessors
compiler.cfg.rpo
+compiler.cfg.linearization
+compiler.cfg.debugger
compiler.cfg.linear-scan
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
@@ -410,7 +412,7 @@ SYMBOL: max-uses
[ ] [ 10 20 2 400 random-test ] unit-test
[ ] [ 10 20 4 300 random-test ] unit-test
-USING: math.private compiler.cfg.debugger ;
+USING: math.private ;
[ ] [
[ float+ float>fixnum 3 fixnum*fast ]
@@ -1415,196 +1417,152 @@ USING: math.private compiler.cfg.debugger ;
intersect-inactive
] unit-test
+: test-bb ( insns n -- )
+ [ <basic-block> swap >>number swap >>instructions ] keep set ;
+
! Bug in live spill slots calculation
-T{ basic-block
- { id 205651 }
- { number 0 }
- { instructions V{ T{ ##prologue } T{ ##branch } } }
-} 0 set
+V{ T{ ##prologue } T{ ##branch } } 0 test-bb
-T{ basic-block
- { id 205652 }
- { number 1 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 703128 }
- { loc D 1 }
- }
- T{ ##peek
- { dst V int-regs 703129 }
- { loc D 0 }
- }
- T{ ##copy
- { dst V int-regs 703134 }
- { src V int-regs 703128 }
- }
- T{ ##copy
- { dst V int-regs 703135 }
- { src V int-regs 703129 }
- }
- T{ ##compare-imm-branch
- { src1 V int-regs 703128 }
- { src2 5 }
- { cc cc/= }
- }
- }
- }
-} 1 set
+V{
+ T{ ##peek
+ { dst V int-regs 703128 }
+ { loc D 1 }
+ }
+ T{ ##peek
+ { dst V int-regs 703129 }
+ { loc D 0 }
+ }
+ T{ ##copy
+ { dst V int-regs 703134 }
+ { src V int-regs 703128 }
+ }
+ T{ ##copy
+ { dst V int-regs 703135 }
+ { src V int-regs 703129 }
+ }
+ T{ ##compare-imm-branch
+ { src1 V int-regs 703128 }
+ { src2 5 }
+ { cc cc/= }
+ }
+} 1 test-bb
-T{ basic-block
- { id 205653 }
- { number 2 }
- { instructions
- V{
- T{ ##copy
- { dst V int-regs 703134 }
- { src V int-regs 703129 }
- }
- T{ ##copy
- { dst V int-regs 703135 }
- { src V int-regs 703128 }
- }
- T{ ##branch }
- }
- }
-} 2 set
+V{
+ T{ ##copy
+ { dst V int-regs 703134 }
+ { src V int-regs 703129 }
+ }
+ T{ ##copy
+ { dst V int-regs 703135 }
+ { src V int-regs 703128 }
+ }
+ T{ ##branch }
+} 2 test-bb
-T{ basic-block
- { id 205655 }
- { number 3 }
- { instructions
- V{
- T{ ##replace
- { src V int-regs 703134 }
- { loc D 0 }
- }
- T{ ##replace
- { src V int-regs 703135 }
- { loc D 1 }
- }
- T{ ##epilogue }
- T{ ##return }
- }
- }
-} 3 set
+V{
+ T{ ##replace
+ { src V int-regs 703134 }
+ { loc D 0 }
+ }
+ T{ ##replace
+ { src V int-regs 703135 }
+ { loc D 1 }
+ }
+ T{ ##epilogue }
+ T{ ##return }
+} 3 test-bb
1 get 1vector 0 get (>>successors)
2 get 3 get V{ } 2sequence 1 get (>>successors)
3 get 1vector 2 get (>>successors)
+SYMBOL: linear-scan-result
+
:: test-linear-scan-on-cfg ( regs -- )
[ ] [
cfg new 0 get >>entry
compute-predecessors
compute-liveness
- reverse-post-order
+ dup reverse-post-order
{ { int-regs regs } } (linear-scan)
+ flatten-cfg 1array mr.
] unit-test ;
{ 1 2 } test-linear-scan-on-cfg
! Bug in inactive interval handling
! [ rot dup [ -rot ] when ]
-T{ basic-block
- { id 201486 }
- { number 0 }
- { instructions V{ T{ ##prologue } T{ ##branch } } }
-} 0 set
+V{ T{ ##prologue } T{ ##branch } } 0 test-bb
-T{ basic-block
- { id 201487 }
- { number 1 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 689473 }
- { loc D 2 }
- }
- T{ ##peek
- { dst V int-regs 689474 }
- { loc D 1 }
- }
- T{ ##peek
- { dst V int-regs 689475 }
- { loc D 0 }
- }
- T{ ##compare-imm-branch
- { src1 V int-regs 689473 }
- { src2 5 }
- { cc cc/= }
- }
- }
- }
-} 1 set
+V{
+ T{ ##peek
+ { dst V int-regs 689473 }
+ { loc D 2 }
+ }
+ T{ ##peek
+ { dst V int-regs 689474 }
+ { loc D 1 }
+ }
+ T{ ##peek
+ { dst V int-regs 689475 }
+ { loc D 0 }
+ }
+ T{ ##compare-imm-branch
+ { src1 V int-regs 689473 }
+ { src2 5 }
+ { cc cc/= }
+ }
+} 1 test-bb
-T{ basic-block
- { id 201488 }
- { number 2 }
- { instructions
- V{
- T{ ##copy
- { dst V int-regs 689481 }
- { src V int-regs 689475 }
- }
- T{ ##copy
- { dst V int-regs 689482 }
- { src V int-regs 689474 }
- }
- T{ ##copy
- { dst V int-regs 689483 }
- { src V int-regs 689473 }
- }
- T{ ##branch }
- }
- }
-} 2 set
+V{
+ T{ ##copy
+ { dst V int-regs 689481 }
+ { src V int-regs 689475 }
+ }
+ T{ ##copy
+ { dst V int-regs 689482 }
+ { src V int-regs 689474 }
+ }
+ T{ ##copy
+ { dst V int-regs 689483 }
+ { src V int-regs 689473 }
+ }
+ T{ ##branch }
+} 2 test-bb
-T{ basic-block
- { id 201489 }
- { number 3 }
- { instructions
- V{
- T{ ##copy
- { dst V int-regs 689481 }
- { src V int-regs 689473 }
- }
- T{ ##copy
- { dst V int-regs 689482 }
- { src V int-regs 689475 }
- }
- T{ ##copy
- { dst V int-regs 689483 }
- { src V int-regs 689474 }
- }
- T{ ##branch }
- }
- }
-} 3 set
+V{
+ T{ ##copy
+ { dst V int-regs 689481 }
+ { src V int-regs 689473 }
+ }
+ T{ ##copy
+ { dst V int-regs 689482 }
+ { src V int-regs 689475 }
+ }
+ T{ ##copy
+ { dst V int-regs 689483 }
+ { src V int-regs 689474 }
+ }
+ T{ ##branch }
+} 3 test-bb
-T{ basic-block
- { id 201490 }
- { number 4 }
- { instructions
- V{
- T{ ##replace
- { src V int-regs 689481 }
- { loc D 0 }
- }
- T{ ##replace
- { src V int-regs 689482 }
- { loc D 1 }
- }
- T{ ##replace
- { src V int-regs 689483 }
- { loc D 2 }
- }
- T{ ##epilogue }
- T{ ##return }
- }
- }
-} 4 set
+V{
+ T{ ##replace
+ { src V int-regs 689481 }
+ { loc D 0 }
+ }
+ T{ ##replace
+ { src V int-regs 689482 }
+ { loc D 1 }
+ }
+ T{ ##replace
+ { src V int-regs 689483 }
+ { loc D 2 }
+ }
+ T{ ##epilogue }
+ T{ ##return }
+} 4 test-bb
: test-diamond ( -- )
1 get 1vector 0 get (>>successors)
@@ -1625,102 +1583,78 @@ T{ basic-block
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
-T{ basic-block
- { id 201538 }
- { number 1 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 689600 }
- { loc D 1 }
- }
- T{ ##peek
- { dst V int-regs 689601 }
- { loc D 0 }
- }
- T{ ##compare-imm-branch
- { src1 V int-regs 689600 }
- { src2 5 }
- { cc cc/= }
- }
- }
- }
-} 1 set
+V{
+ T{ ##peek
+ { dst V int-regs 689600 }
+ { loc D 1 }
+ }
+ T{ ##peek
+ { dst V int-regs 689601 }
+ { loc D 0 }
+ }
+ T{ ##compare-imm-branch
+ { src1 V int-regs 689600 }
+ { src2 5 }
+ { cc cc/= }
+ }
+} 1 test-bb
-T{ basic-block
- { id 201539 }
- { number 2 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 689604 }
- { loc D 2 }
- }
- T{ ##copy
- { dst V int-regs 689607 }
- { src V int-regs 689604 }
- }
- T{ ##copy
- { dst V int-regs 689608 }
- { src V int-regs 689600 }
- }
- T{ ##copy
- { dst V int-regs 689610 }
- { src V int-regs 689601 }
- }
- T{ ##branch }
- }
- }
-} 2 set
+V{
+ T{ ##peek
+ { dst V int-regs 689604 }
+ { loc D 2 }
+ }
+ T{ ##copy
+ { dst V int-regs 689607 }
+ { src V int-regs 689604 }
+ }
+ T{ ##copy
+ { dst V int-regs 689608 }
+ { src V int-regs 689600 }
+ }
+ T{ ##copy
+ { dst V int-regs 689610 }
+ { src V int-regs 689601 }
+ }
+ T{ ##branch }
+} 2 test-bb
-T{ basic-block
- { id 201540 }
- { number 3 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 689609 }
- { loc D 2 }
- }
- T{ ##copy
- { dst V int-regs 689607 }
- { src V int-regs 689600 }
- }
- T{ ##copy
- { dst V int-regs 689608 }
- { src V int-regs 689601 }
- }
- T{ ##copy
- { dst V int-regs 689610 }
- { src V int-regs 689609 }
- }
- T{ ##branch }
- }
- }
-} 3 set
+V{
+ T{ ##peek
+ { dst V int-regs 689609 }
+ { loc D 2 }
+ }
+ T{ ##copy
+ { dst V int-regs 689607 }
+ { src V int-regs 689600 }
+ }
+ T{ ##copy
+ { dst V int-regs 689608 }
+ { src V int-regs 689601 }
+ }
+ T{ ##copy
+ { dst V int-regs 689610 }
+ { src V int-regs 689609 }
+ }
+ T{ ##branch }
+} 3 test-bb
-T{ basic-block
- { id 201541 }
- { number 4 }
- { instructions
- V{
- T{ ##replace
- { src V int-regs 689607 }
- { loc D 0 }
- }
- T{ ##replace
- { src V int-regs 689608 }
- { loc D 1 }
- }
- T{ ##replace
- { src V int-regs 689610 }
- { loc D 2 }
- }
- T{ ##epilogue }
- T{ ##return }
- }
- }
-} 4 set
+V{
+ T{ ##replace
+ { src V int-regs 689607 }
+ { loc D 0 }
+ }
+ T{ ##replace
+ { src V int-regs 689608 }
+ { loc D 1 }
+ }
+ T{ ##replace
+ { src V int-regs 689610 }
+ { loc D 2 }
+ }
+ T{ ##epilogue }
+ T{ ##return }
+} 4 test-bb
test-diamond
@@ -1729,76 +1663,130 @@ test-diamond
! compute-live-registers was inaccurate since it didn't take
! lifetime holes into account
-T{ basic-block
- { id 0 }
- { number 0 }
- { instructions V{ T{ ##prologue } T{ ##branch } } }
-} 0 set
+V{ T{ ##prologue } T{ ##branch } } 0 test-bb
-T{ basic-block
- { id 1 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 0 }
- { loc D 0 }
- }
- T{ ##compare-imm-branch
- { src1 V int-regs 0 }
- { src2 5 }
- { cc cc/= }
- }
- }
- }
-} 1 set
+V{
+ T{ ##peek
+ { dst V int-regs 0 }
+ { loc D 0 }
+ }
+ T{ ##compare-imm-branch
+ { src1 V int-regs 0 }
+ { src2 5 }
+ { cc cc/= }
+ }
+} 1 test-bb
-T{ basic-block
- { id 2 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 1 }
- { loc D 1 }
- }
- T{ ##copy
- { dst V int-regs 2 }
- { src V int-regs 1 }
- }
- T{ ##branch }
- }
- }
-} 2 set
+V{
+ T{ ##peek
+ { dst V int-regs 1 }
+ { loc D 1 }
+ }
+ T{ ##copy
+ { dst V int-regs 2 }
+ { src V int-regs 1 }
+ }
+ T{ ##branch }
+} 2 test-bb
-T{ basic-block
- { id 3 }
- { instructions
- V{
- T{ ##peek
- { dst V int-regs 3 }
- { loc D 2 }
- }
- T{ ##copy
- { dst V int-regs 2 }
- { src V int-regs 3 }
- }
- T{ ##branch }
- }
- }
-} 3 set
+V{
+ T{ ##peek
+ { dst V int-regs 3 }
+ { loc D 2 }
+ }
+ T{ ##copy
+ { dst V int-regs 2 }
+ { src V int-regs 3 }
+ }
+ T{ ##branch }
+} 3 test-bb
-T{ basic-block
- { id 4 }
- { instructions
- V{
- T{ ##replace
- { src V int-regs 2 }
- { loc D 0 }
- }
- T{ ##return }
- }
- }
-} 4 set
+V{
+ T{ ##replace
+ { src V int-regs 2 }
+ { loc D 0 }
+ }
+ T{ ##return }
+} 4 test-bb
test-diamond
-{ 1 2 3 4 } test-linear-scan-on-cfg
\ No newline at end of file
+{ 1 2 3 4 } test-linear-scan-on-cfg
+
+! Inactive interval handling: splitting active interval
+! if it fits in lifetime hole only partially
+
+V{ T{ ##peek f V int-regs 3 R 1 } T{ ##branch } } 0 test-bb
+
+V{
+ T{ ##peek f V int-regs 2 R 0 }
+ T{ ##compare-imm-branch f V int-regs 2 5 cc= }
+} 1 test-bb
+
+V{
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##branch }
+} 2 test-bb
+
+
+V{
+ T{ ##peek f V int-regs 1 D 1 }
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##replace f V int-regs 1 D 2 }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##replace f V int-regs 3 R 2 }
+ T{ ##replace f V int-regs 0 D 0 }
+ T{ ##return }
+} 4 test-bb
+
+test-diamond
+
+{ 1 2 } test-linear-scan-on-cfg
+
+USING: classes ;
+
+[ ] [
+ 1 get instructions>> first regs>> V int-regs 0 swap at
+ 2 get instructions>> first regs>> V int-regs 1 swap at assert=
+] unit-test
+
+[ _copy ] [ 3 get instructions>> second class ] unit-test
+
+! Resolve pass; make sure the spilling is done correctly
+V{ T{ ##peek f V int-regs 3 R 1 } T{ ##branch } } 0 test-bb
+
+V{
+ T{ ##peek f V int-regs 2 R 0 }
+ T{ ##compare-imm-branch f V int-regs 2 5 cc= }
+} 1 test-bb
+
+V{
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##replace f V int-regs 3 R 1 }
+ T{ ##peek f V int-regs 1 D 1 }
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##replace f V int-regs 1 D 2 }
+ T{ ##replace f V int-regs 0 D 2 }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##replace f V int-regs 3 R 2 }
+ T{ ##return }
+} 4 test-bb
+
+test-diamond
+
+{ 1 2 } test-linear-scan-on-cfg
+
+[ _spill ] [ 2 get instructions>> first class ] unit-test
+
+[ _spill ] [ 3 get instructions>> second class ] unit-test
+
+[ _reload ] [ 4 get instructions>> first class ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index 3a0a7f8770..2d3ad41b22 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces make
+USING: kernel accessors namespaces make locals
cpu.architecture
compiler.cfg
compiler.cfg.rpo
@@ -9,7 +9,8 @@ compiler.cfg.linear-scan.numbering
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.assignment
+compiler.cfg.linear-scan.resolve ;
IN: compiler.cfg.linear-scan
! References:
@@ -26,12 +27,11 @@ IN: compiler.cfg.linear-scan
! by Omri Traub, Glenn Holloway, Michael D. Smith
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435
-: (linear-scan) ( rpo machine-registers -- )
- [
- dup number-instructions
- dup compute-live-intervals
- ] dip
- allocate-registers assign-registers ;
+:: (linear-scan) ( rpo machine-registers -- )
+ rpo number-instructions
+ rpo compute-live-intervals machine-registers allocate-registers
+ rpo assign-registers
+ rpo resolve-data-flow ;
: linear-scan ( cfg -- cfg' )
[
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index df2dbb1198..002914cd7b 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -1,34 +1,108 @@
! Copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences
-compiler.cfg.linear-scan.live-intervals compiler.cfg.liveness ;
+classes.tuple classes.parser parser fry words make arrays
+combinators compiler.cfg.linear-scan.live-intervals
+compiler.cfg.liveness compiler.cfg.instructions ;
IN: compiler.cfg.linear-scan.resolve
+<<
+
+TUPLE: operation from to reg-class ;
+
+SYNTAX: OPERATION:
+ CREATE-CLASS dup save-location
+ [ operation { } define-tuple-class ]
+ [
+ [ scan-word scan-word ] keep
+ '[
+ [ [ _ execute ] [ _ execute ] bi* ]
+ [ vreg>> reg-class>> ]
+ bi _ boa ,
+ ] (( from to -- )) define-declared
+ ] bi ;
+
+>>
+
+OPERATION: memory->memory spill-to>> reload-from>>
+OPERATION: register->memory reg>> reload-from>>
+OPERATION: memory->register spill-to>> reg>>
+OPERATION: register->register reg>> reg>>
+
: add-mapping ( from to -- )
- 2drop
- ;
+ dup reload-from>> [
+ over spill-to>> [ memory->memory ] [ register->memory ] if
+ ] [
+ over spill-to>> [ memory->register ] [ register->register ] if
+ ] if ;
: resolve-value-data-flow ( bb to vreg -- )
live-intervals get at
[ [ block-to ] dip child-interval-at ]
[ [ block-from ] dip child-interval-at ]
- bi-curry bi* 2dup = [ 2drop ] [
- add-mapping
+ bi-curry bi* 2dup eq? [ 2drop ] [ add-mapping ] if ;
+
+: compute-mappings ( bb to -- mappings )
+ [
+ dup live-in keys
+ [ resolve-value-data-flow ] with with each
+ ] { } make ;
+
+GENERIC: >insn ( operation -- )
+
+: >operation< ( operation -- from to reg-class )
+ [ from>> ] [ to>> ] [ reg-class>> ] tri ; inline
+
+M: memory->memory >insn
+ [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
+
+M: register->memory >insn
+ [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
+
+M: memory->register >insn
+ [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ;
+
+M: register->register >insn
+ [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
+
+: mapping-instructions ( mappings -- insns )
+ [ [ >insn ] each ] { } make ;
+
+: fork? ( from to -- ? )
+ [ successors>> length 1 >= ]
+ [ predecessors>> length 1 = ] bi* and ; inline
+
+: insert-position/fork ( from to -- before after )
+ nip instructions>> [ >array ] [ dup delete-all ] bi swap ;
+
+: join? ( from to -- ? )
+ [ successors>> length 1 = ]
+ [ predecessors>> length 1 >= ] bi* and ; inline
+
+: insert-position/join ( from to -- before after )
+ drop instructions>> { } ;
+
+: insert-position ( bb to -- before after )
+ {
+ { [ 2dup fork? ] [ insert-position/fork ] }
+ { [ 2dup join? ] [ insert-position/join ] }
+ } cond ;
+
+: 3append-here ( seq2 seq1 seq3 -- )
+ #! Mutate seq1
+ swap '[ _ push-all ] bi@ ;
+
+: perform-mappings ( mappings bb to -- )
+ pick empty? [ 3drop ] [
+ [ mapping-instructions ] 2dip
+ insert-position 3append-here
] if ;
-: resolve-mappings ( bb to -- )
- 2drop
- ;
-
: resolve-edge-data-flow ( bb to -- )
- [ dup live-in [ resolve-value-data-flow ] with with each ]
- [ resolve-mappings ]
- 2bi ;
+ [ compute-mappings ] [ perform-mappings ] 2bi ;
: resolve-block-data-flow ( bb -- )
- dup successors>> [
- resolve-edge-data-flow
- ] with each ;
+ dup successors>> [ resolve-edge-data-flow ] with each ;
: resolve-data-flow ( rpo -- )
[ resolve-block-data-flow ] each ;
\ No newline at end of file