compiler.cfg.linear-scan: Working on resolve pass

diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index bf2a56adbdfd1ab1bed6a90081de60d3c6bb1ecd..e55f42e77476545a591b90acf36d57793b2e2a40 100644 (file)
--- 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 b43294818b5dea09a633a25de3fc2bf1661d9286..b4f6302049649bfc6d794da2874909446963ac5b 100644 (file)
--- 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
+
+! 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 3 4 } test-linear-scan-on-cfg
\ No newline at end of file
+{ 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 3a0a7f877002d19ba3fc6d32e833ca928a368dab..2d3ad41b223f31c375a054ef84eef5047e2e6e49 100644 (file)
--- 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 df2dbb1198add417e12870a7d3283360fb332383..002914cd7bd86a703e5c7437e69abbe404730cc1 100644 (file)
--- 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
-    ] if ;
+    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 ;
 
-: resolve-mappings ( bb to -- )
-    2drop
-    ;
+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-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