Split off the notion of a register representation from a register class

basis/alien/arrays/arrays.factor

@@ -31,7 +31,7 @@ M: array c-type-boxer-quot drop [ ] ;
 
 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
 
-M: value-type c-type-reg-class drop int-regs ;
+M: value-type c-type-rep drop int-rep ;
 
 M: value-type c-type-getter
     drop [ swap <displaced-alien> ] ;
@@ -72,8 +72,8 @@ M: string-type box-return
 M: string-type stack-size
     drop "void*" stack-size ;
 
-M: string-type c-type-reg-class
+M: string-type c-type-rep
-    drop int-regs ;
+    drop int-rep ;
 
 M: string-type c-type-boxer
     drop "void*" c-type-boxer ;

basis/alien/c-types/c-types.factor

@@ -21,7 +21,7 @@ unboxer
 { unboxer-quot callable }
 { getter callable }
 { setter callable }
-{ reg-class initial: int-regs }
+{ rep initial: int-rep }
 size
 align
 stack-align? ;
@@ -98,11 +98,11 @@ M: c-type c-type-unboxer-quot unboxer-quot>> ;
 
 M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
 
-GENERIC: c-type-reg-class ( name -- reg-class )
+GENERIC: c-type-rep ( name -- rep )
 
-M: c-type c-type-reg-class reg-class>> ;
+M: c-type c-type-rep rep>> ;
 
-M: string c-type-reg-class c-type c-type-reg-class ;
+M: string c-type-rep c-type c-type-rep ;
 
 GENERIC: c-type-getter ( name -- quot )
 
@@ -129,13 +129,11 @@ M: c-type c-type-stack-align? stack-align?>> ;
 M: string c-type-stack-align? c-type c-type-stack-align? ;
 
 : c-type-box ( n type -- )
-    dup c-type-reg-class
+    [ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi
-    swap c-type-boxer [ "No boxer" throw ] unless*
     %box ;
 
 : c-type-unbox ( n ctype -- )
-    dup c-type-reg-class
+    [ c-type-rep ] [ c-type-unboxer [ "No unboxer" throw ] unless* ] bi
-    swap c-type-unboxer [ "No unboxer" throw ] unless*
     %unbox ;
 
 GENERIC: box-parameter ( n ctype -- )
@@ -426,7 +424,7 @@ CONSTANT: primitive-types
         4 >>align
         "box_float" >>boxer
         "to_float" >>unboxer
-        single-float-regs >>reg-class
+        single-float-rep >>rep
         [ >float ] >>unboxer-quot
     "float" define-primitive-type
 
@@ -438,7 +436,7 @@ CONSTANT: primitive-types
         8 >>align
         "box_double" >>boxer
         "to_double" >>unboxer
-        double-float-regs >>reg-class
+        double-float-rep >>rep
         [ >float ] >>unboxer-quot
     "double" define-primitive-type
 

basis/compiler/cfg/alias-analysis/alias-analysis.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math namespaces assocs hashtables sequences arrays
-accessors vectors combinators sets classes compiler.cfg
+accessors vectors combinators sets classes cpu.architecture compiler.cfg
 compiler.cfg.registers compiler.cfg.instructions
 compiler.cfg.copy-prop compiler.cfg.rpo compiler.cfg.liveness ;
 IN: compiler.cfg.alias-analysis
@@ -226,7 +226,7 @@ M: ##read analyze-aliases*
     call-next-method
     dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
     2dup live-slot dup [
-        2nip \ ##copy new-insn analyze-aliases* nip
+        2nip int-rep \ ##copy new-insn analyze-aliases* nip
     ] [
         drop remember-slot
     ] if ;

basis/compiler/cfg/build-stack-frame/build-stack-frame.factor

@@ -1,15 +1,13 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces accessors math.order assocs kernel sequences
-combinators make classes words cpu.architecture
+combinators make classes words cpu.architecture layouts
 compiler.cfg.instructions compiler.cfg.registers
 compiler.cfg.stack-frame ;
 IN: compiler.cfg.build-stack-frame
 
 SYMBOL: frame-required?
 
-SYMBOL: spill-counts
-
 GENERIC: compute-stack-frame* ( insn -- )
 
 : request-stack-frame ( stack-frame -- )
@@ -30,11 +28,11 @@ M: ##call compute-stack-frame*
 
 M: _gc compute-stack-frame*
     frame-required? on
-    stack-frame new swap gc-root-size>> >>gc-root-size
+    stack-frame new swap gc-root-size>> cells >>gc-root-size
     request-stack-frame ;
 
-M: _spill-counts compute-stack-frame*
+M: _spill-area-size compute-stack-frame*
-    counts>> stack-frame get (>>spill-counts) ;
+    n>> stack-frame get (>>spill-area-size) ;
 
 M: insn compute-stack-frame*
     class frame-required? word-prop [
@@ -45,7 +43,7 @@ M: insn compute-stack-frame*
 
 : compute-stack-frame ( insns -- )
     frame-required? off
-    T{ stack-frame } clone stack-frame set
+    stack-frame new stack-frame set
     [ compute-stack-frame* ] each
     stack-frame get dup stack-frame-size >>total-size drop ;
 

basis/compiler/cfg/cfg.factor

@@ -19,9 +19,13 @@ M: basic-block hashcode* nip id>> ;
         V{ } clone >>predecessors
         \ basic-block counter >>id ;
 
-TUPLE: cfg { entry basic-block } word label spill-counts post-order ;
+TUPLE: cfg { entry basic-block } word label spill-area-size post-order ;
 
-: <cfg> ( entry word label -- cfg ) f f cfg boa ;
+: <cfg> ( entry word label -- cfg )
+    cfg new
+        swap >>label
+        swap >>word
+        swap >>entry ;
 
 : cfg-changed ( cfg -- cfg ) f >>post-order ; inline
 

basis/compiler/cfg/dce/dce-tests.factor

@@ -11,62 +11,62 @@ IN: compiler.cfg.dce.tests
     entry>> instructions>> ; 
 
 [ V{
-    T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 1 } { val 8 } }
-    T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
+    T{ ##load-immediate { dst V int-rep 2 } { val 16 } }
-    T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
+    T{ ##add { dst V int-rep 3 } { src1 V int-rep 1 } { src2 V int-rep 2 } }
-    T{ ##replace { src V int-regs 3 } { loc D 0 } }
+    T{ ##replace { src V int-rep 3 } { loc D 0 } }
 } ] [ V{
-    T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 1 } { val 8 } }
-    T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
+    T{ ##load-immediate { dst V int-rep 2 } { val 16 } }
-    T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
+    T{ ##add { dst V int-rep 3 } { src1 V int-rep 1 } { src2 V int-rep 2 } }
-    T{ ##replace { src V int-regs 3 } { loc D 0 } }
+    T{ ##replace { src V int-rep 3 } { loc D 0 } }
 } test-dce ] unit-test
 
 [ V{ } ] [ V{
-    T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 1 } { val 8 } }
-    T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
+    T{ ##load-immediate { dst V int-rep 2 } { val 16 } }
-    T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
+    T{ ##add { dst V int-rep 3 } { src1 V int-rep 1 } { src2 V int-rep 2 } }
 } test-dce ] unit-test
 
 [ V{ } ] [ V{
-    T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 3 } { val 8 } }
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
 } test-dce ] unit-test
 
 [ V{ } ] [ V{
-    T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 3 } { val 8 } }
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
-    T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+    T{ ##set-slot-imm { obj V int-rep 1 } { src V int-rep 3 } }
 } test-dce ] unit-test
 
 [ V{
-    T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 3 } { val 8 } }
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
-    T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+    T{ ##set-slot-imm { obj V int-rep 1 } { src V int-rep 3 } }
-    T{ ##replace { src V int-regs 1 } { loc D 0 } }
+    T{ ##replace { src V int-rep 1 } { loc D 0 } }
 } ] [ V{
-    T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 3 } { val 8 } }
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
-    T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+    T{ ##set-slot-imm { obj V int-rep 1 } { src V int-rep 3 } }
-    T{ ##replace { src V int-regs 1 } { loc D 0 } }
+    T{ ##replace { src V int-rep 1 } { loc D 0 } }
 } test-dce ] unit-test
 
 [ V{
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
-    T{ ##replace { src V int-regs 1 } { loc D 0 } }
+    T{ ##replace { src V int-rep 1 } { loc D 0 } }
 } ] [ V{
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
-    T{ ##replace { src V int-regs 1 } { loc D 0 } }
+    T{ ##replace { src V int-rep 1 } { loc D 0 } }
 } test-dce ] unit-test
 
 [ V{
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
-    T{ ##replace { src V int-regs 1 } { loc D 0 } }
+    T{ ##replace { src V int-rep 1 } { loc D 0 } }
-    T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 3 } { val 8 } }
-    T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+    T{ ##set-slot-imm { obj V int-rep 1 } { src V int-rep 3 } }
 } ] [ V{
-    T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+    T{ ##allot { dst V int-rep 1 } { temp V int-rep 2 } }
-    T{ ##replace { src V int-regs 1 } { loc D 0 } }
+    T{ ##replace { src V int-rep 1 } { loc D 0 } }
-    T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+    T{ ##load-immediate { dst V int-rep 3 } { val 8 } }
-    T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+    T{ ##set-slot-imm { obj V int-rep 1 } { src V int-rep 3 } }
 } test-dce ] unit-test

basis/compiler/cfg/debugger/debugger.factor

@@ -43,7 +43,7 @@ M: word test-cfg
 ! Prettyprinting
 M: vreg pprint*
     <block
-    \ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
+    \ V pprint-word [ rep>> pprint* ] [ n>> pprint* ] bi
     block> ;
 
 : pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;

basis/compiler/cfg/def-use/def-use-tests.factor

@@ -10,23 +10,23 @@ compiler.cfg.instructions
 compiler.cfg.registers ;
 
 V{
-    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-rep 0 D 0 }
-    T{ ##peek f V int-regs 1 D 0 }
+    T{ ##peek f V int-rep 1 D 0 }
-    T{ ##peek f V int-regs 2 D 0 }
+    T{ ##peek f V int-rep 2 D 0 }
 } 1 test-bb
 V{
-    T{ ##replace f V int-regs 2 D 0 }
+    T{ ##replace f V int-rep 2 D 0 }
 } 2 test-bb
 1 2 edge
 V{
-    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##replace f V int-rep 0 D 0 }
 } 3 test-bb
 2 3 edge
 V{ } 4 test-bb
 V{ } 5 test-bb
 3 { 4 5 } edges
 V{
-    T{ ##phi f V int-regs 2 H{ { 2 V int-regs 0 } { 3 V int-regs 1 } } }
+    T{ ##phi f V int-rep 2 H{ { 2 V int-rep 0 } { 3 V int-rep 1 } } }
 } 6 test-bb
 4 6 edge
 5 6 edge

basis/compiler/cfg/gc-checks/gc-checks-tests.factor

@@ -12,11 +12,11 @@ namespaces accessors sequences ;
 
 V{
     T{ ##inc-d f 3 }
-    T{ ##replace f V int-regs 0 D 1 }
+    T{ ##replace f V int-rep 0 D 1 }
 } 0 test-bb
 
 V{
-    T{ ##box-float f V int-regs 0 V int-regs 1 }
+    T{ ##box-float f V int-rep 0 V int-rep 1 }
 } 1 test-bb
 
 0 1 edge

basis/compiler/cfg/gc-checks/gc-checks.factor

@@ -16,7 +16,7 @@ IN: compiler.cfg.gc-checks
 
 : insert-gc-check ( bb -- )
     dup '[
-        i i f _ uninitialized-locs \ ##gc new-insn
+        i i f f _ uninitialized-locs \ ##gc new-insn
         prefix
     ] change-instructions drop ;
 

basis/compiler/cfg/hats/hats.factor

@@ -1,24 +1,24 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays kernel layouts math namespaces
+USING: accessors arrays byte-arrays kernel layouts math namespaces
 sequences classes.tuple cpu.architecture compiler.cfg.registers
 compiler.cfg.instructions ;
 IN: compiler.cfg.hats
 
-: i ( -- vreg ) int-regs next-vreg ; inline
+: i ( -- vreg ) int-rep next-vreg ; inline
 : ^^i ( -- vreg vreg ) i dup ; inline
 : ^^i1 ( obj -- vreg vreg obj ) [ ^^i ] dip ; inline
 : ^^i2 ( obj obj -- vreg vreg obj obj ) [ ^^i ] 2dip ; inline
 : ^^i3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^i ] 3dip ; inline
 
-: d ( -- vreg ) double-float-regs next-vreg ; inline
+: d ( -- vreg ) double-float-rep next-vreg ; inline
 : ^^d  ( -- vreg vreg ) d dup ; inline
 : ^^d1 ( obj -- vreg vreg obj ) [ ^^d ] dip ; inline
 : ^^d2 ( obj obj -- vreg vreg obj obj ) [ ^^d ] 2dip ; inline
 : ^^d3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^d ] 3dip ; inline
 
 : ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline
-: ^^copy ( src -- dst ) ^^i1 ##copy ; inline
+: ^^copy ( src -- dst ) ^^i1 dup rep>> ##copy ; inline
 : ^^slot ( obj slot tag -- dst ) ^^i3 i ##slot ; inline
 : ^^slot-imm ( obj slot tag -- dst ) ^^i3 ##slot-imm ; inline
 : ^^set-slot ( src obj slot tag -- ) i ##set-slot ; inline

basis/compiler/cfg/instructions/instructions.factor

@@ -112,8 +112,7 @@ INSN: ##float>integer < ##unary ;
 INSN: ##integer>float < ##unary ;
 
 ! Boxing and unboxing
-INSN: ##copy < ##unary ;
+INSN: ##copy < ##unary rep ;
-INSN: ##copy-float < ##unary ;
 INSN: ##unbox-float < ##unary ;
 INSN: ##unbox-any-c-ptr < ##unary/temp ;
 INSN: ##box-float < ##unary/temp ;
@@ -190,7 +189,7 @@ INSN: ##fixnum-add < ##fixnum-overflow ;
 INSN: ##fixnum-sub < ##fixnum-overflow ;
 INSN: ##fixnum-mul < ##fixnum-overflow ;
 
-INSN: ##gc temp1 temp2 live-values uninitialized-locs ;
+INSN: ##gc temp1 temp2 data-values tagged-values uninitialized-locs ;
 
 ! Instructions used by machine IR only.
 INSN: _prologue stack-frame ;
@@ -219,14 +218,13 @@ INSN: _fixnum-mul < _fixnum-overflow ;
 
 TUPLE: spill-slot n ; C: <spill-slot> spill-slot
 
-INSN: _gc temp1 temp2 gc-roots gc-root-count gc-root-size uninitialized-locs ;
+INSN: _gc temp1 temp2 data-values tagged-values gc-root-size uninitialized-locs ;
 
 ! These instructions operate on machine registers and not
 ! virtual registers
-INSN: _spill src class n ;
+INSN: _spill src rep n ;
-INSN: _reload dst class n ;
+INSN: _reload dst rep n ;
-INSN: _copy dst src class ;
+INSN: _spill-area-size n ;
-INSN: _spill-counts counts ;
 
 ! Instructions that use vregs
 UNION: vreg-insn

basis/compiler/cfg/intrinsics/alien/alien.factor

@@ -90,18 +90,18 @@ IN: compiler.cfg.intrinsics.alien
 : emit-alien-cell-setter ( node -- )
     [ ##set-alien-cell ] inline-alien-cell-setter ;
 
-: emit-alien-float-getter ( node reg-class -- )
+: emit-alien-float-getter ( node rep -- )
     '[
         _ {
-            { single-float-regs [ ^^alien-float ] }
+            { single-float-rep [ ^^alien-float ] }
-            { double-float-regs [ ^^alien-double ] }
+            { double-float-rep [ ^^alien-double ] }
         } case ^^box-float
     ] inline-alien-getter ;
 
-: emit-alien-float-setter ( node reg-class -- )
+: emit-alien-float-setter ( node rep -- )
     '[
         _ {
-            { single-float-regs [ ##set-alien-float ] }
+            { single-float-rep [ ##set-alien-float ] }
-            { double-float-regs [ ##set-alien-double ] }
+            { double-float-rep [ ##set-alien-double ] }
         } case
     ] inline-alien-float-setter ;

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -153,8 +153,8 @@ IN: compiler.cfg.intrinsics
         { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
         { \ alien.accessors:alien-cell [ emit-alien-cell-getter ] }
         { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
-        { \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter ] }
+        { \ alien.accessors:alien-float [ single-float-rep emit-alien-float-getter ] }
-        { \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter ] }
+        { \ alien.accessors:set-alien-float [ single-float-rep emit-alien-float-setter ] }
-        { \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter ] }
+        { \ alien.accessors:alien-double [ double-float-rep emit-alien-float-getter ] }
-        { \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter ] }
+        { \ alien.accessors:set-alien-double [ double-float-rep emit-alien-float-setter ] }
     } case ;

basis/compiler/cfg/linear-scan/allocation/state/state.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators cpu.architecture fry heaps
 kernel math math.order namespaces sequences vectors
-compiler.cfg.linear-scan.live-intervals ;
+compiler.cfg compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.allocation.state
 
 ! Start index of current live interval. We ensure that all
@@ -26,7 +26,7 @@ SYMBOL: registers
 SYMBOL: active-intervals
 
 : active-intervals-for ( vreg -- seq )
-    reg-class>> active-intervals get at ;
+    rep>> reg-class-of active-intervals get at ;
 
 : add-active ( live-interval -- )
     dup vreg>> active-intervals-for push ;
@@ -41,7 +41,7 @@ SYMBOL: active-intervals
 SYMBOL: inactive-intervals
 
 : inactive-intervals-for ( vreg -- seq )
-    reg-class>> inactive-intervals get at ;
+    rep>> reg-class-of inactive-intervals get at ;
 
 : add-inactive ( live-interval -- )
     dup vreg>> inactive-intervals-for push ;
@@ -112,22 +112,18 @@ SYMBOL: unhandled-intervals
     [ dup start>> unhandled-intervals get heap-push ]
     bi ;
 
-CONSTANT: reg-classes { int-regs double-float-regs }
-
 : reg-class-assoc ( quot -- assoc )
     [ reg-classes ] dip { } map>assoc ; inline
 
-! Mapping from register classes to spill counts
+: next-spill-slot ( rep -- n )
-SYMBOL: spill-counts
+    rep-size cfg get
-
+    [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop ;
-: next-spill-slot ( reg-class -- n )
-    spill-counts get [ dup 1 + ] change-at ;
 
 ! Mapping from vregs to spill slots
 SYMBOL: spill-slots
 
 : assign-spill-slot ( vreg -- n )
-    spill-slots get [ reg-class>> next-spill-slot ] cache ;
+    spill-slots get [ rep>> next-spill-slot ] cache ;
 
 : init-allocator ( registers -- )
     registers set
@@ -135,7 +131,7 @@ SYMBOL: spill-slots
     [ V{ } clone ] reg-class-assoc active-intervals set
     [ V{ } clone ] reg-class-assoc inactive-intervals set
     V{ } clone handled-intervals set
-    [ 0 ] reg-class-assoc spill-counts set
+    cfg get 0 >>spill-area-size drop
     H{ } clone spill-slots set
     -1 progress set ;
 
@@ -145,7 +141,7 @@ SYMBOL: spill-slots
 
 ! A utility used by register-status and spill-status words
 : free-positions ( new -- assoc )
-    vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
+    vreg>> rep>> reg-class-of registers get at [ 1/0. ] H{ } map>assoc ;
 
 : add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
 

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

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math assocs namespaces sequences heaps
-fry make combinators sets locals
+fry make combinators sets locals arrays
 cpu.architecture
 compiler.cfg
 compiler.cfg.rpo
@@ -52,7 +52,7 @@ SYMBOL: register-live-outs
     init-unhandled ;
 
 : insert-spill ( live-interval -- )
-    [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ;
+    [ reg>> ] [ vreg>> rep>> ] [ spill-to>> ] tri _spill ;
 
 : handle-spill ( live-interval -- )
     dup spill-to>> [ insert-spill ] [ drop ] if ;
@@ -72,7 +72,7 @@ SYMBOL: register-live-outs
     pending-interval-heap get (expire-old-intervals) ;
 
 : insert-reload ( live-interval -- )
-    [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ;
+    [ reg>> ] [ vreg>> rep>> ] [ reload-from>> ] tri _reload ;
 
 : handle-reload ( live-interval -- )
     dup reload-from>> [ insert-reload ] [ drop ] if ;
@@ -103,11 +103,36 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
 M: vreg-insn assign-registers-in-insn
     [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;
 
+! TODO: needs tagged-rep
+
+: trace-on-gc ( assoc -- assoc' )
+    ! When a GC occurs, virtual registers which contain tagged data
+    ! are traced by the GC. Outputs a sequence physical registers.
+    [ drop rep>> int-rep eq? ] { } assoc-filter-as values ;
+
+: spill-on-gc? ( vreg reg -- ? )
+    [ rep>> int-rep? not ] [ spill-slot? not ] bi* and ;
+
+: spill-on-gc ( assoc -- assoc' )
+    ! When a GC occurs, virtual registers which contain untagged data,
+    ! and are stored in physical registers, are saved to their spill
+    ! slots. Outputs sequence of triples:
+    ! - physical register
+    ! - spill slot
+    ! - representation
+    [
+        [
+            2dup spill-on-gc?
+            [ swap [ assign-spill-slot ] [ rep>> ] bi 3array , ] [ 2drop ] if
+        ] assoc-each
+    ] { } make ;
+
 M: ##gc assign-registers-in-insn
-    ! This works because ##gc is always the first instruction
+    ! Since ##gc is always the first instruction in a block, the set of
-    ! in a block.
+    ! values live at the ##gc is just live-in.
     dup call-next-method
-    basic-block get register-live-ins get at >>live-values
+    basic-block get register-live-ins get at
+    [ trace-on-gc >>tagged-values ] [ spill-on-gc >>data-values ] bi
     drop ;
 
 M: insn assign-registers-in-insn drop ;

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

@@ -39,6 +39,5 @@ IN: compiler.cfg.linear-scan
 : linear-scan ( cfg -- cfg' )
     [
         dup machine-registers (linear-scan)
-        spill-counts get >>spill-counts
         cfg-changed
     ] with-scope ;

basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor

@@ -1,65 +1,67 @@
 IN: compiler.cfg.linear-scan.resolve.tests
 USING: compiler.cfg.linear-scan.resolve tools.test kernel namespaces
+accessors
+compiler.cfg
 compiler.cfg.instructions cpu.architecture make sequences
 compiler.cfg.linear-scan.allocation.state ;
 
 [
     {
-        { { T{ spill-slot f 0 } int-regs } { 1 int-regs } }
+        { { T{ spill-slot f 0 } int-rep } { 1 int-rep } }
     }
 ] [
     [
-        0 <spill-slot> 1 int-regs add-mapping
+        0 <spill-slot> 1 int-rep add-mapping
     ] { } make
 ] unit-test
 
 [
     {
-        T{ _reload { dst 1 } { class int-regs } { n 0 } }
+        T{ _reload { dst 1 } { rep int-rep } { n 0 } }
     }
 ] [
     [
-        { T{ spill-slot f 0 } int-regs } { 1 int-regs } >insn
+        { T{ spill-slot f 0 } int-rep } { 1 int-rep } >insn
     ] { } make
 ] unit-test
 
 [
     {
-        T{ _spill { src 1 } { class int-regs } { n 0 } }
+        T{ _spill { src 1 } { rep int-rep } { n 0 } }
     }
 ] [
     [
-        { 1 int-regs } { T{ spill-slot f 0 } int-regs } >insn
+        { 1 int-rep } { T{ spill-slot f 0 } int-rep } >insn
     ] { } make
 ] unit-test
 
 [
     {
-        T{ _copy { src 1 } { dst 2 } { class int-regs } }
+        T{ ##copy { src 1 } { dst 2 } { rep int-rep } }
     }
 ] [
     [
-        { 1 int-regs } { 2 int-regs } >insn
+        { 1 int-rep } { 2 int-rep } >insn
     ] { } make
 ] unit-test
 
-H{ { int-regs 10 } { float-regs 20 } } clone spill-counts set
+cfg new 8 >>spill-area-size cfg set
 H{ } clone spill-temps set
 
 [
     t
 ] [
-    { { { 0 int-regs } { 1 int-regs } } { { 1 int-regs } { 0 int-regs } } }
+    { { { 0 int-rep } { 1 int-rep } } { { 1 int-rep } { 0 int-rep } } }
     mapping-instructions {
         {
-            T{ _spill { src 0 } { class int-regs } { n 10 } }
+            T{ _spill { src 0 } { rep int-rep } { n 8 } }
-            T{ _copy { dst 0 } { src 1 } { class int-regs } }
+            T{ ##copy { dst 0 } { src 1 } { rep int-rep } }
-            T{ _reload { dst 1 } { class int-regs } { n 10 } }
+            T{ _reload { dst 1 } { rep int-rep } { n 8 } }
         }
         {
-            T{ _spill { src 1 } { class int-regs } { n 10 } }
+            T{ _spill { src 1 } { rep int-rep } { n 8 } }
-            T{ _copy { dst 1 } { src 0 } { class int-regs } }
+            T{ ##copy { dst 1 } { src 0 } { rep int-rep } }
-            T{ _reload { dst 0 } { class int-regs } { n 10 } }
+            T{ _reload { dst 0 } { rep int-rep } { n 8 } }
         }
     } member?
 ] unit-test

basis/compiler/cfg/linear-scan/resolve/resolve.factor

@@ -14,16 +14,16 @@ IN: compiler.cfg.linear-scan.resolve
 
 SYMBOL: spill-temps
 
-: spill-temp ( reg-class -- n )
+: spill-temp ( rep -- n )
     spill-temps get [ next-spill-slot ] cache ;
 
-: add-mapping ( from to reg-class -- )
+: add-mapping ( from to rep -- )
     '[ _ 2array ] bi@ 2array , ;
 
 :: resolve-value-data-flow ( bb to vreg -- )
     vreg bb vreg-at-end
     vreg to vreg-at-start
-    2dup = [ 2drop ] [ vreg reg-class>> add-mapping ] if ;
+    2dup = [ 2drop ] [ vreg rep>> add-mapping ] if ;
 
 : compute-mappings ( bb to -- mappings )
     dup live-in dup assoc-empty? [ 3drop f ] [
@@ -43,7 +43,7 @@ SYMBOL: spill-temps
     drop [ first2 ] [ second spill-temp ] bi _spill ;
 
 : register->register ( from to -- )
-    swap [ first ] [ first2 ] bi* _copy ;
+    swap [ first ] [ first2 ] bi* ##copy ;
 
 SYMBOL: temp
 

basis/compiler/cfg/linearization/linearization.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math accessors sequences namespaces make
-combinators assocs arrays locals cpu.architecture
+combinators assocs arrays locals layouts cpu.architecture
 compiler.cfg
 compiler.cfg.comparisons
 compiler.cfg.stack-frame
@@ -70,44 +70,17 @@ M: ##dispatch linearize-insn
     [ successors>> [ block-number _dispatch-label ] each ]
     bi* ;
 
-: (compute-gc-roots) ( n live-values -- n )
+: gc-root-offsets ( registers -- alist )
-    [
+    ! Outputs a sequence of { offset register/spill-slot } pairs
-        [ nip 2array , ]
+    [ length iota [ cell * ] map ] keep zip ;
-        [ drop reg-class>> reg-size + ]
-        3bi
-    ] assoc-each ;
-
-: oop-values ( regs -- regs' )
-    [ drop reg-class>> int-regs eq? ] assoc-filter ;
-
-: data-values ( regs -- regs' )
-    [ drop reg-class>> double-float-regs eq? ] assoc-filter ;
-
-: compute-gc-roots ( live-values -- alist )
-    [
-        [ 0 ] dip
-        ! we put float registers last; the GC doesn't actually scan them
-        [ oop-values (compute-gc-roots) ]
-        [ data-values (compute-gc-roots) ] bi
-        drop
-    ] { } make ;
-
-: count-gc-roots ( live-values -- n )
-    ! Size of GC root area, minus the float registers
-    oop-values assoc-size ;
 
 M: ##gc linearize-insn
     nip
     {
         [ temp1>> ]
         [ temp2>> ]
-        [
+        [ data-values>> ]
-            live-values>>
+        [ tagged-values>> gc-root-offsets dup length ]
-            [ compute-gc-roots ]
-            [ count-gc-roots ]
-            [ gc-roots-size ]
-            tri
-        ]
         [ uninitialized-locs>> ]
     } cleave
     _gc ;
@@ -115,7 +88,7 @@ M: ##gc linearize-insn
 : linearize-basic-blocks ( cfg -- insns )
     [
         [ linearization-order [ linearize-basic-block ] each ]
-        [ spill-counts>> _spill-counts ]
+        [ spill-area-size>> _spill-area-size ]
         bi
     ] { } make ;
 

basis/compiler/cfg/liveness/liveness-tests.factor

@@ -12,20 +12,20 @@ IN: compiler.cfg.liveness.tests
 ! Sanity check...
 
 V{
-    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-rep 0 D 0 }
-    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##replace f V int-rep 0 D 0 }
-    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-rep 1 D 1 }
-    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##peek f V int-rep 1 D 1 }
     T{ ##branch }
 } 1 test-bb
 
 V{
-    T{ ##replace f V int-regs 2 D 0 }
+    T{ ##replace f V int-rep 2 D 0 }
     T{ ##branch }
 } 2 test-bb
 
 V{
-    T{ ##replace f V int-regs 3 D 0 }
+    T{ ##replace f V int-rep 3 D 0 }
     T{ ##return }
 } 3 test-bb
 
@@ -35,9 +35,9 @@ test-liveness
 
 [
     H{
-        { V int-regs 1 V int-regs 1 }
+        { V int-rep 1 V int-rep 1 }
-        { V int-regs 2 V int-regs 2 }
+        { V int-rep 2 V int-rep 2 }
-        { V int-regs 3 V int-regs 3 }
+        { V int-rep 3 V int-rep 3 }
     }
 ]
 [ 1 get live-in ]
@@ -46,12 +46,12 @@ unit-test
 ! Tricky case; defs must be killed before uses
 
 V{
-    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-rep 0 D 0 }
     T{ ##branch }
 } 1 test-bb
 
 V{
-    T{ ##add-imm f V int-regs 0 V int-regs 0 10 }
+    T{ ##add-imm f V int-rep 0 V int-rep 0 10 }
     T{ ##return }
 } 2 test-bb
 
@@ -59,4 +59,4 @@ V{
 
 test-liveness
 
-[ H{ { V int-regs 0 V int-regs 0 } } ] [ 2 get live-in ] unit-test
+[ H{ { V int-rep 0 V int-rep 0 } } ] [ 2 get live-in ] unit-test

basis/compiler/cfg/mr/mr.factor

@@ -1,12 +1,14 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: compiler.cfg.linearization compiler.cfg.gc-checks
+USING: kernel namespaces compiler.cfg compiler.cfg.linearization
-compiler.cfg.linear-scan compiler.cfg.build-stack-frame
+compiler.cfg.gc-checks compiler.cfg.linear-scan
-compiler.cfg.rpo ;
+compiler.cfg.build-stack-frame ;
 IN: compiler.cfg.mr
 
 : build-mr ( cfg -- mr )
-    insert-gc-checks
+    dup cfg [
-    linear-scan
+        insert-gc-checks
-    flatten-cfg
+        linear-scan
-    build-stack-frame ;
+        flatten-cfg
+        build-stack-frame
+    ] with-variable ;

basis/compiler/cfg/optimizer/optimizer.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences accessors combinators namespaces
+compiler.cfg
 compiler.cfg.tco
 compiler.cfg.useless-conditionals
 compiler.cfg.branch-splitting
@@ -29,7 +30,7 @@ SYMBOL: check-optimizer?
 : optimize-cfg ( cfg -- cfg' )
     ! Note that compute-predecessors has to be called several times.
     ! The passes that need this document it.
-    [
+    dup cfg [
         optimize-tail-calls
         delete-useless-conditionals
         compute-predecessors
@@ -47,4 +48,4 @@ SYMBOL: check-optimizer?
         destruct-ssa
         delete-empty-blocks
         ?check
-    ] with-scope ;
+    ] with-variable ;

basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor

@@ -11,53 +11,53 @@ SYMBOL: temp
 
 [
     {
-        T{ ##copy f V int-regs 4 V int-regs 2 }
+        T{ ##copy f V int-rep 4 V int-rep 2 int-rep }
-        T{ ##copy f V int-regs 2 V int-regs 1 }
+        T{ ##copy f V int-rep 2 V int-rep 1 int-rep }
-        T{ ##copy f V int-regs 1 V int-regs 4 }
+        T{ ##copy f V int-rep 1 V int-rep 4 int-rep }
     }
 ] [
     H{
-        { V int-regs 1 V int-regs 2 }
+        { V int-rep 1 V int-rep 2 }
-        { V int-regs 2 V int-regs 1 }
+        { V int-rep 2 V int-rep 1 }
     } test-parallel-copy
 ] unit-test
 
 [
     {
-        T{ ##copy f V int-regs 1 V int-regs 2 }
+        T{ ##copy f V int-rep 1 V int-rep 2 int-rep }
-        T{ ##copy f V int-regs 3 V int-regs 4 }
+        T{ ##copy f V int-rep 3 V int-rep 4 int-rep }
     }
 ] [
     H{
-        { V int-regs 1 V int-regs 2 }
+        { V int-rep 1 V int-rep 2 }
-        { V int-regs 3 V int-regs 4 }
+        { V int-rep 3 V int-rep 4 }
     } test-parallel-copy
 ] unit-test
 
 [
     {
-        T{ ##copy f V int-regs 1 V int-regs 3 }
+        T{ ##copy f V int-rep 1 V int-rep 3 int-rep }
-        T{ ##copy f V int-regs 2 V int-regs 1 }
+        T{ ##copy f V int-rep 2 V int-rep 1 int-rep }
     }
 ] [
     H{
-        { V int-regs 1 V int-regs 3 }
+        { V int-rep 1 V int-rep 3 }
-        { V int-regs 2 V int-regs 3 }
+        { V int-rep 2 V int-rep 3 }
     } test-parallel-copy
 ] unit-test
 
 [
     {
-        T{ ##copy f V int-regs 4 V int-regs 3 }
+        T{ ##copy f V int-rep 4 V int-rep 3 int-rep }
-        T{ ##copy f V int-regs 3 V int-regs 2 }
+        T{ ##copy f V int-rep 3 V int-rep 2 int-rep }
-        T{ ##copy f V int-regs 2 V int-regs 1 }
+        T{ ##copy f V int-rep 2 V int-rep 1 int-rep }
-        T{ ##copy f V int-regs 1 V int-regs 4 }
+        T{ ##copy f V int-rep 1 V int-rep 4 int-rep }
     }
 ] [
     {
-        { V int-regs 2 V int-regs 1 }
+        { V int-rep 2 V int-rep 1 }
-        { V int-regs 3 V int-regs 2 }
+        { V int-rep 3 V int-rep 2 }
-        { V int-regs 1 V int-regs 3 }
+        { V int-rep 1 V int-rep 3 }
-        { V int-regs 4 V int-regs 3 }
+        { V int-rep 4 V int-rep 3 }
     } test-parallel-copy
 ] unit-test

basis/compiler/cfg/parallel-copy/parallel-copy.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs compiler.cfg.hats compiler.cfg.instructions
+USING: assocs cpu.architecture compiler.cfg.hats
-deques dlists fry kernel locals namespaces sequences
+compiler.cfg.instructions deques dlists fry kernel locals namespaces
-hashtables ;
+sequences hashtables ;
 IN: compiler.cfg.parallel-copy
 
 ! Revisiting Out-of-SSA Translation for Correctness, Code Quality, and Efficiency
@@ -57,4 +57,4 @@ PRIVATE>
         ] slurp-deque
     ] with-scope ; inline
 
-: parallel-copy ( mapping -- ) i [ ##copy ] parallel-mapping ;
+: parallel-copy ( mapping -- ) i [ int-rep ##copy ] parallel-mapping ;

basis/compiler/cfg/registers/registers.factor

@@ -4,7 +4,7 @@ USING: accessors namespaces kernel arrays parser math math.order ;
 IN: compiler.cfg.registers
 
 ! Virtual registers, used by CFG and machine IRs
-TUPLE: vreg { reg-class read-only } { n fixnum read-only } ;
+TUPLE: vreg { rep read-only } { n fixnum read-only } ;
 
 M: vreg equal? over vreg? [ [ n>> ] bi@ eq? ] [ 2drop f ] if ;
 
@@ -12,7 +12,7 @@ M: vreg hashcode* nip n>> ;
 
 SYMBOL: vreg-counter
 
-: next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ;
+: next-vreg ( rep -- vreg ) \ vreg-counter counter vreg boa ;
 
 ! Stack locations -- 'n' is an index starting from the top of the stack
 ! going down. So 0 is the top of the stack, 1 is what would be the top

basis/compiler/cfg/renaming/renaming.factor

@@ -11,6 +11,6 @@ SYMBOL: renamings
     renamings get ?at drop ;
 
 : fresh-value ( vreg -- vreg' )
-    reg-class>> next-vreg ;
+    rep>> next-vreg ;
 
 RENAMING: rename [ rename-value ] [ rename-value ] [ fresh-value ]

basis/compiler/cfg/ssa/construction/construction-tests.factor

@@ -13,24 +13,24 @@ IN: compiler.cfg.ssa.construction.tests
 reset-counters
 
 V{
-    T{ ##load-immediate f V int-regs 1 100 }
+    T{ ##load-immediate f V int-rep 1 100 }
-    T{ ##add-imm f V int-regs 2 V int-regs 1 50 }
+    T{ ##add-imm f V int-rep 2 V int-rep 1 50 }
-    T{ ##add-imm f V int-regs 2 V int-regs 2 10 }
+    T{ ##add-imm f V int-rep 2 V int-rep 2 10 }
     T{ ##branch }
 } 0 test-bb
 
 V{
-    T{ ##load-immediate f V int-regs 3 3 }
+    T{ ##load-immediate f V int-rep 3 3 }
     T{ ##branch }
 } 1 test-bb
 
 V{
-    T{ ##load-immediate f V int-regs 3 4 }
+    T{ ##load-immediate f V int-rep 3 4 }
     T{ ##branch }
 } 2 test-bb
 
 V{
-    T{ ##replace f V int-regs 3 D 0 }
+    T{ ##replace f V int-rep 3 D 0 }
     T{ ##return }
 } 3 test-bb
 
@@ -40,6 +40,7 @@ V{
 
 : test-ssa ( -- )
     cfg new 0 get >>entry
+    dup cfg set
     compute-predecessors
     construct-ssa
     drop ;
@@ -48,23 +49,23 @@ V{
 
 [
     V{
-        T{ ##load-immediate f V int-regs 1 100 }
+        T{ ##load-immediate f V int-rep 1 100 }
-        T{ ##add-imm f V int-regs 2 V int-regs 1 50 }
+        T{ ##add-imm f V int-rep 2 V int-rep 1 50 }
-        T{ ##add-imm f V int-regs 3 V int-regs 2 10 }
+        T{ ##add-imm f V int-rep 3 V int-rep 2 10 }
         T{ ##branch }
     }
 ] [ 0 get instructions>> ] unit-test
 
 [
     V{
-        T{ ##load-immediate f V int-regs 4 3 }
+        T{ ##load-immediate f V int-rep 4 3 }
         T{ ##branch }
     }
 ] [ 1 get instructions>> ] unit-test
 
 [
     V{
-        T{ ##load-immediate f V int-regs 5 4 }
+        T{ ##load-immediate f V int-rep 5 4 }
         T{ ##branch }
     }
 ] [ 2 get instructions>> ] unit-test
@@ -74,8 +75,8 @@ V{
 
 [
     V{
-        T{ ##phi f V int-regs 6 H{ { 1 V int-regs 4 } { 2 V int-regs 5 } } }
+        T{ ##phi f V int-rep 6 H{ { 1 V int-rep 4 } { 2 V int-rep 5 } } }
-        T{ ##replace f V int-regs 6 D 0 }
+        T{ ##replace f V int-rep 6 D 0 }
         T{ ##return }
     }
 ] [
@@ -87,9 +88,9 @@ reset-counters
 
 V{ } 0 test-bb
 V{ } 1 test-bb
-V{ T{ ##peek f V int-regs 0 D 0 } } 2 test-bb
+V{ T{ ##peek f V int-rep 0 D 0 } } 2 test-bb
-V{ T{ ##peek f V int-regs 0 D 0 } } 3 test-bb
+V{ T{ ##peek f V int-rep 0 D 0 } } 3 test-bb
-V{ T{ ##replace f V int-regs 0 D 0 } } 4 test-bb
+V{ T{ ##replace f V int-rep 0 D 0 } } 4 test-bb
 V{ } 5 test-bb
 V{ } 6 test-bb
 
@@ -104,8 +105,8 @@ V{ } 6 test-bb
 
 [
     V{
-        T{ ##phi f V int-regs 3 H{ { 2 V int-regs 1 } { 3 V int-regs 2 } } }
+        T{ ##phi f V int-rep 3 H{ { 2 V int-rep 1 } { 3 V int-rep 2 } } }
-        T{ ##replace f V int-regs 3 D 0 }
+        T{ ##replace f V int-rep 3 D 0 }
     }
 ] [
     4 get instructions>>

basis/compiler/cfg/ssa/construction/construction.factor

@@ -9,6 +9,7 @@ compiler.cfg.liveness
 compiler.cfg.registers
 compiler.cfg.dominance
 compiler.cfg.instructions
+compiler.cfg.renaming
 compiler.cfg.renaming.functor
 compiler.cfg.ssa.construction.tdmsc ;
 IN: compiler.cfg.ssa.construction
@@ -75,7 +76,7 @@ SYMBOLS: stacks pushed ;
     H{ } clone stacks set ;
 
 : gen-name ( vreg -- vreg' )
-    [ reg-class>> next-vreg dup ] keep
+    [ fresh-value dup ] keep
     dup pushed get 2dup key?
     [ 2drop stacks get at set-last ]
     [ conjoin stacks get push-at ]

basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor

@@ -5,7 +5,7 @@ tools.test vectors sets ;
 IN: compiler.cfg.ssa.construction.tdmsc.tests
 
 : test-tdmsc ( -- )
-    cfg new 0 get >>entry
+    cfg new 0 get >>entry dup cfg set
     compute-predecessors
     dup compute-dominance
     compute-merge-sets ;

basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor

@@ -93,7 +93,6 @@ HINTS: filter-by { bit-array object } ;
 PRIVATE>
 
 : compute-merge-sets ( cfg -- )
-    dup cfg set
     H{ } clone visited set
     [ compute-levels ]
     [ init-merge-sets ]

basis/compiler/cfg/ssa/cssa/cssa.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel locals
+cpu.architecture
 compiler.cfg.rpo
 compiler.cfg.hats
 compiler.cfg.utilities
@@ -11,7 +12,7 @@ IN: compiler.cfg.ssa.cssa
 
 :: insert-copy ( bb src -- bb dst )
     i :> dst
-    bb [ dst src ##copy ] add-instructions
+    bb [ dst src int-rep ##copy ] add-instructions
     bb dst ;
 
 : convert-phi ( ##phi -- )

basis/compiler/cfg/ssa/destruction/destruction.factor

@@ -58,13 +58,9 @@ SYMBOL: copies
 
 GENERIC: prepare-insn ( insn -- )
 
-: prepare-copy ( insn -- )
+M: ##copy prepare-insn
     [ dst>> ] [ src>> ] bi 2array copies get push ;
 
-M: ##copy prepare-insn prepare-copy ;
-
-M: ##copy-float prepare-insn prepare-copy ;
-
 M: ##phi prepare-insn
     [ dst>> ] [ inputs>> values ] bi
     [ eliminate-copy ] with each ;
@@ -85,10 +81,8 @@ M: insn prepare-insn drop ;
         [ 2drop ] [ eliminate-copy ] if
     ] assoc-each ;
 
-UNION: copy-insn ##copy ##copy-float ;
-
 : useless-copy? ( ##copy -- ? )
-    dup copy-insn? [ [ dst>> ] [ src>> ] bi eq? ] [ drop f ] if ;
+    dup ##copy? [ [ dst>> ] [ src>> ] bi eq? ] [ drop f ] if ;
 
 : perform-renaming ( cfg -- )
     leader-map get keys [ dup leader ] H{ } map>assoc renamings set

basis/compiler/cfg/ssa/interference/interference-tests.factor

@@ -16,19 +16,19 @@ IN: compiler.cfg.ssa.interference.tests
     compute-live-ranges ;
 
 V{
-    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-rep 0 D 0 }
-    T{ ##peek f V int-regs 2 D 0 }
+    T{ ##peek f V int-rep 2 D 0 }
-    T{ ##copy f V int-regs 1 V int-regs 0 }
+    T{ ##copy f V int-rep 1 V int-rep 0 }
-    T{ ##copy f V int-regs 3 V int-regs 2 }
+    T{ ##copy f V int-rep 3 V int-rep 2 }
     T{ ##branch }
 } 0 test-bb
 
 V{
-    T{ ##peek f V int-regs 4 D 0 }
+    T{ ##peek f V int-rep 4 D 0 }
-    T{ ##peek f V int-regs 5 D 0 }
+    T{ ##peek f V int-rep 5 D 0 }
-    T{ ##replace f V int-regs 3 D 0 }
+    T{ ##replace f V int-rep 3 D 0 }
-    T{ ##peek f V int-regs 6 D 0 }
+    T{ ##peek f V int-rep 6 D 0 }
-    T{ ##replace f V int-regs 5 D 0 }
+    T{ ##replace f V int-rep 5 D 0 }
     T{ ##return }
 } 1 test-bb
 
@@ -36,17 +36,17 @@ V{
 
 [ ] [ test-interference ] unit-test
 
-[ f ] [ V int-regs 0 V int-regs 1 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 0 V int-rep 1 vregs-interfere? ] unit-test
-[ f ] [ V int-regs 1 V int-regs 0 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 1 V int-rep 0 vregs-interfere? ] unit-test
-[ f ] [ V int-regs 2 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 2 V int-rep 3 vregs-interfere? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 2 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 3 V int-rep 2 vregs-interfere? ] unit-test
-[ t ] [ V int-regs 0 V int-regs 2 vregs-interfere? ] unit-test
+[ t ] [ V int-rep 0 V int-rep 2 vregs-interfere? ] unit-test
-[ t ] [ V int-regs 2 V int-regs 0 vregs-interfere? ] unit-test
+[ t ] [ V int-rep 2 V int-rep 0 vregs-interfere? ] unit-test
-[ f ] [ V int-regs 1 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 1 V int-rep 3 vregs-interfere? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 1 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 3 V int-rep 1 vregs-interfere? ] unit-test
-[ t ] [ V int-regs 3 V int-regs 4 vregs-interfere? ] unit-test
+[ t ] [ V int-rep 3 V int-rep 4 vregs-interfere? ] unit-test
-[ t ] [ V int-regs 4 V int-regs 3 vregs-interfere? ] unit-test
+[ t ] [ V int-rep 4 V int-rep 3 vregs-interfere? ] unit-test
-[ t ] [ V int-regs 3 V int-regs 5 vregs-interfere? ] unit-test
+[ t ] [ V int-rep 3 V int-rep 5 vregs-interfere? ] unit-test
-[ t ] [ V int-regs 5 V int-regs 3 vregs-interfere? ] unit-test
+[ t ] [ V int-rep 5 V int-rep 3 vregs-interfere? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 6 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 3 V int-rep 6 vregs-interfere? ] unit-test
-[ f ] [ V int-regs 6 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-rep 6 V int-rep 3 vregs-interfere? ] unit-test

basis/compiler/cfg/ssa/liveness/liveness-tests.factor

@@ -28,17 +28,17 @@ IN: compiler.cfg.ssa.liveness
     precompute-liveness ;
 
 V{
-    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-rep 0 D 0 }
-    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##replace f V int-rep 0 D 0 }
-    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-rep 1 D 1 }
 } 0 test-bb
 
 V{
-    T{ ##replace f V int-regs 2 D 0 }
+    T{ ##replace f V int-rep 2 D 0 }
 } 1 test-bb
 
 V{
-    T{ ##replace f V int-regs 3 D 0 }
+    T{ ##replace f V int-rep 3 D 0 }
 } 2 test-bb
 
 0 { 1 2 } edges
@@ -57,78 +57,78 @@ V{
 [ t ] [ 1 self-T_q ] unit-test
 [ t ] [ 2 self-T_q ] unit-test
 
-[ f ] [ V int-regs 0 0 get live-in? ] unit-test
+[ f ] [ V int-rep 0 0 get live-in? ] unit-test
-[ t ] [ V int-regs 1 0 get live-in? ] unit-test
+[ t ] [ V int-rep 1 0 get live-in? ] unit-test
-[ t ] [ V int-regs 2 0 get live-in? ] unit-test
+[ t ] [ V int-rep 2 0 get live-in? ] unit-test
-[ t ] [ V int-regs 3 0 get live-in? ] unit-test
+[ t ] [ V int-rep 3 0 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 0 get live-out? ] unit-test
+[ f ] [ V int-rep 0 0 get live-out? ] unit-test
-[ f ] [ V int-regs 1 0 get live-out? ] unit-test
+[ f ] [ V int-rep 1 0 get live-out? ] unit-test
-[ t ] [ V int-regs 2 0 get live-out? ] unit-test
+[ t ] [ V int-rep 2 0 get live-out? ] unit-test
-[ t ] [ V int-regs 3 0 get live-out? ] unit-test
+[ t ] [ V int-rep 3 0 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 1 get live-in? ] unit-test
+[ f ] [ V int-rep 0 1 get live-in? ] unit-test
-[ f ] [ V int-regs 1 1 get live-in? ] unit-test
+[ f ] [ V int-rep 1 1 get live-in? ] unit-test
-[ t ] [ V int-regs 2 1 get live-in? ] unit-test
+[ t ] [ V int-rep 2 1 get live-in? ] unit-test
-[ f ] [ V int-regs 3 1 get live-in? ] unit-test
+[ f ] [ V int-rep 3 1 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 1 get live-out? ] unit-test
+[ f ] [ V int-rep 0 1 get live-out? ] unit-test
-[ f ] [ V int-regs 1 1 get live-out? ] unit-test
+[ f ] [ V int-rep 1 1 get live-out? ] unit-test
-[ f ] [ V int-regs 2 1 get live-out? ] unit-test
+[ f ] [ V int-rep 2 1 get live-out? ] unit-test
-[ f ] [ V int-regs 3 1 get live-out? ] unit-test
+[ f ] [ V int-rep 3 1 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 2 get live-in? ] unit-test
+[ f ] [ V int-rep 0 2 get live-in? ] unit-test
-[ f ] [ V int-regs 1 2 get live-in? ] unit-test
+[ f ] [ V int-rep 1 2 get live-in? ] unit-test
-[ f ] [ V int-regs 2 2 get live-in? ] unit-test
+[ f ] [ V int-rep 2 2 get live-in? ] unit-test
-[ t ] [ V int-regs 3 2 get live-in? ] unit-test
+[ t ] [ V int-rep 3 2 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 2 get live-out? ] unit-test
+[ f ] [ V int-rep 0 2 get live-out? ] unit-test
-[ f ] [ V int-regs 1 2 get live-out? ] unit-test
+[ f ] [ V int-rep 1 2 get live-out? ] unit-test
-[ f ] [ V int-regs 2 2 get live-out? ] unit-test
+[ f ] [ V int-rep 2 2 get live-out? ] unit-test
-[ f ] [ V int-regs 3 2 get live-out? ] unit-test
+[ f ] [ V int-rep 3 2 get live-out? ] unit-test
 
 V{ } 0 test-bb
 V{ } 1 test-bb
 V{ } 2 test-bb
 V{ } 3 test-bb
 V{
-    T{ ##phi f V int-regs 2 H{ { 2 V int-regs 0 } { 3 V int-regs 1 } } }
+    T{ ##phi f V int-rep 2 H{ { 2 V int-rep 0 } { 3 V int-rep 1 } } }
 } 4 test-bb
 test-diamond
 
 [ ] [ test-liveness ] unit-test
 
-[ t ] [ V int-regs 0 1 get live-in? ] unit-test
+[ t ] [ V int-rep 0 1 get live-in? ] unit-test
-[ t ] [ V int-regs 1 1 get live-in? ] unit-test
+[ t ] [ V int-rep 1 1 get live-in? ] unit-test
-[ f ] [ V int-regs 2 1 get live-in? ] unit-test
+[ f ] [ V int-rep 2 1 get live-in? ] unit-test
 
-[ t ] [ V int-regs 0 1 get live-out? ] unit-test
+[ t ] [ V int-rep 0 1 get live-out? ] unit-test
-[ t ] [ V int-regs 1 1 get live-out? ] unit-test
+[ t ] [ V int-rep 1 1 get live-out? ] unit-test
-[ f ] [ V int-regs 2 1 get live-out? ] unit-test
+[ f ] [ V int-rep 2 1 get live-out? ] unit-test
 
-[ t ] [ V int-regs 0 2 get live-in? ] unit-test
+[ t ] [ V int-rep 0 2 get live-in? ] unit-test
-[ f ] [ V int-regs 1 2 get live-in? ] unit-test
+[ f ] [ V int-rep 1 2 get live-in? ] unit-test
-[ f ] [ V int-regs 2 2 get live-in? ] unit-test
+[ f ] [ V int-rep 2 2 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 2 get live-out? ] unit-test
+[ f ] [ V int-rep 0 2 get live-out? ] unit-test
-[ f ] [ V int-regs 1 2 get live-out? ] unit-test
+[ f ] [ V int-rep 1 2 get live-out? ] unit-test
-[ f ] [ V int-regs 2 2 get live-out? ] unit-test
+[ f ] [ V int-rep 2 2 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 3 get live-in? ] unit-test
+[ f ] [ V int-rep 0 3 get live-in? ] unit-test
-[ t ] [ V int-regs 1 3 get live-in? ] unit-test
+[ t ] [ V int-rep 1 3 get live-in? ] unit-test
-[ f ] [ V int-regs 2 3 get live-in? ] unit-test
+[ f ] [ V int-rep 2 3 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 3 get live-out? ] unit-test
+[ f ] [ V int-rep 0 3 get live-out? ] unit-test
-[ f ] [ V int-regs 1 3 get live-out? ] unit-test
+[ f ] [ V int-rep 1 3 get live-out? ] unit-test
-[ f ] [ V int-regs 2 3 get live-out? ] unit-test
+[ f ] [ V int-rep 2 3 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 4 get live-in? ] unit-test
+[ f ] [ V int-rep 0 4 get live-in? ] unit-test
-[ f ] [ V int-regs 1 4 get live-in? ] unit-test
+[ f ] [ V int-rep 1 4 get live-in? ] unit-test
-[ f ] [ V int-regs 2 4 get live-in? ] unit-test
+[ f ] [ V int-rep 2 4 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 4 get live-out? ] unit-test
+[ f ] [ V int-rep 0 4 get live-out? ] unit-test
-[ f ] [ V int-regs 1 4 get live-out? ] unit-test
+[ f ] [ V int-rep 1 4 get live-out? ] unit-test
-[ f ] [ V int-regs 2 4 get live-out? ] unit-test
+[ f ] [ V int-rep 2 4 get live-out? ] unit-test
 
 ! This is the CFG in Figure 3 from the paper
 V{ } 0 test-bb
@@ -137,23 +137,23 @@ V{ } 1 test-bb
 V{ } 2 test-bb
 1 2 edge
 V{
-    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-rep 0 D 0 }
-    T{ ##peek f V int-regs 1 D 0 }
+    T{ ##peek f V int-rep 1 D 0 }
-    T{ ##peek f V int-regs 2 D 0 }
+    T{ ##peek f V int-rep 2 D 0 }
 } 3 test-bb
 V{ } 11 test-bb
 2 { 3 11 } edges
 V{
-    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##replace f V int-rep 0 D 0 }
 } 4 test-bb
 V{ } 8 test-bb
 3 { 8 4 } edges
 V{
-    T{ ##replace f V int-regs 1 D 0 }
+    T{ ##replace f V int-rep 1 D 0 }
 } 9 test-bb
 8 9 edge
 V{
-    T{ ##replace f V int-regs 2 D 0 }
+    T{ ##replace f V int-rep 2 D 0 }
 } 5 test-bb
 4 5 edge
 V{ } 10 test-bb
@@ -203,90 +203,90 @@ V{ } 7 test-bb
 [ f ] [ 10 get back-edge-target? ] unit-test
 [ f ] [ 11 get back-edge-target? ] unit-test
 
-[ f ] [ V int-regs 0 1 get live-in? ] unit-test
+[ f ] [ V int-rep 0 1 get live-in? ] unit-test
-[ f ] [ V int-regs 1 1 get live-in? ] unit-test
+[ f ] [ V int-rep 1 1 get live-in? ] unit-test
-[ f ] [ V int-regs 2 1 get live-in? ] unit-test
+[ f ] [ V int-rep 2 1 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 1 get live-out? ] unit-test
+[ f ] [ V int-rep 0 1 get live-out? ] unit-test
-[ f ] [ V int-regs 1 1 get live-out? ] unit-test
+[ f ] [ V int-rep 1 1 get live-out? ] unit-test
-[ f ] [ V int-regs 2 1 get live-out? ] unit-test
+[ f ] [ V int-rep 2 1 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 2 get live-in? ] unit-test
+[ f ] [ V int-rep 0 2 get live-in? ] unit-test
-[ f ] [ V int-regs 1 2 get live-in? ] unit-test
+[ f ] [ V int-rep 1 2 get live-in? ] unit-test
-[ f ] [ V int-regs 2 2 get live-in? ] unit-test
+[ f ] [ V int-rep 2 2 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 2 get live-out? ] unit-test
+[ f ] [ V int-rep 0 2 get live-out? ] unit-test
-[ f ] [ V int-regs 1 2 get live-out? ] unit-test
+[ f ] [ V int-rep 1 2 get live-out? ] unit-test
-[ f ] [ V int-regs 2 2 get live-out? ] unit-test
+[ f ] [ V int-rep 2 2 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 3 get live-in? ] unit-test
+[ f ] [ V int-rep 0 3 get live-in? ] unit-test
-[ f ] [ V int-regs 1 3 get live-in? ] unit-test
+[ f ] [ V int-rep 1 3 get live-in? ] unit-test
-[ f ] [ V int-regs 2 3 get live-in? ] unit-test
+[ f ] [ V int-rep 2 3 get live-in? ] unit-test
 
-[ t ] [ V int-regs 0 3 get live-out? ] unit-test
+[ t ] [ V int-rep 0 3 get live-out? ] unit-test
-[ t ] [ V int-regs 1 3 get live-out? ] unit-test
+[ t ] [ V int-rep 1 3 get live-out? ] unit-test
-[ t ] [ V int-regs 2 3 get live-out? ] unit-test
+[ t ] [ V int-rep 2 3 get live-out? ] unit-test
 
-[ t ] [ V int-regs 0 4 get live-in? ] unit-test
+[ t ] [ V int-rep 0 4 get live-in? ] unit-test
-[ f ] [ V int-regs 1 4 get live-in? ] unit-test
+[ f ] [ V int-rep 1 4 get live-in? ] unit-test
-[ t ] [ V int-regs 2 4 get live-in? ] unit-test
+[ t ] [ V int-rep 2 4 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 4 get live-out? ] unit-test
+[ f ] [ V int-rep 0 4 get live-out? ] unit-test
-[ f ] [ V int-regs 1 4 get live-out? ] unit-test
+[ f ] [ V int-rep 1 4 get live-out? ] unit-test
-[ t ] [ V int-regs 2 4 get live-out? ] unit-test
+[ t ] [ V int-rep 2 4 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 5 get live-in? ] unit-test
+[ f ] [ V int-rep 0 5 get live-in? ] unit-test
-[ f ] [ V int-regs 1 5 get live-in? ] unit-test
+[ f ] [ V int-rep 1 5 get live-in? ] unit-test
-[ t ] [ V int-regs 2 5 get live-in? ] unit-test
+[ t ] [ V int-rep 2 5 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 5 get live-out? ] unit-test
+[ f ] [ V int-rep 0 5 get live-out? ] unit-test
-[ f ] [ V int-regs 1 5 get live-out? ] unit-test
+[ f ] [ V int-rep 1 5 get live-out? ] unit-test
-[ t ] [ V int-regs 2 5 get live-out? ] unit-test
+[ t ] [ V int-rep 2 5 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 6 get live-in? ] unit-test
+[ f ] [ V int-rep 0 6 get live-in? ] unit-test
-[ f ] [ V int-regs 1 6 get live-in? ] unit-test
+[ f ] [ V int-rep 1 6 get live-in? ] unit-test
-[ t ] [ V int-regs 2 6 get live-in? ] unit-test
+[ t ] [ V int-rep 2 6 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 6 get live-out? ] unit-test
+[ f ] [ V int-rep 0 6 get live-out? ] unit-test
-[ f ] [ V int-regs 1 6 get live-out? ] unit-test
+[ f ] [ V int-rep 1 6 get live-out? ] unit-test
-[ t ] [ V int-regs 2 6 get live-out? ] unit-test
+[ t ] [ V int-rep 2 6 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 7 get live-in? ] unit-test
+[ f ] [ V int-rep 0 7 get live-in? ] unit-test
-[ f ] [ V int-regs 1 7 get live-in? ] unit-test
+[ f ] [ V int-rep 1 7 get live-in? ] unit-test
-[ f ] [ V int-regs 2 7 get live-in? ] unit-test
+[ f ] [ V int-rep 2 7 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 7 get live-out? ] unit-test
+[ f ] [ V int-rep 0 7 get live-out? ] unit-test
-[ f ] [ V int-regs 1 7 get live-out? ] unit-test
+[ f ] [ V int-rep 1 7 get live-out? ] unit-test
-[ f ] [ V int-regs 2 7 get live-out? ] unit-test
+[ f ] [ V int-rep 2 7 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 8 get live-in? ] unit-test
+[ f ] [ V int-rep 0 8 get live-in? ] unit-test
-[ t ] [ V int-regs 1 8 get live-in? ] unit-test
+[ t ] [ V int-rep 1 8 get live-in? ] unit-test
-[ t ] [ V int-regs 2 8 get live-in? ] unit-test
+[ t ] [ V int-rep 2 8 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 8 get live-out? ] unit-test
+[ f ] [ V int-rep 0 8 get live-out? ] unit-test
-[ t ] [ V int-regs 1 8 get live-out? ] unit-test
+[ t ] [ V int-rep 1 8 get live-out? ] unit-test
-[ t ] [ V int-regs 2 8 get live-out? ] unit-test
+[ t ] [ V int-rep 2 8 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 9 get live-in? ] unit-test
+[ f ] [ V int-rep 0 9 get live-in? ] unit-test
-[ t ] [ V int-regs 1 9 get live-in? ] unit-test
+[ t ] [ V int-rep 1 9 get live-in? ] unit-test
-[ t ] [ V int-regs 2 9 get live-in? ] unit-test
+[ t ] [ V int-rep 2 9 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 9 get live-out? ] unit-test
+[ f ] [ V int-rep 0 9 get live-out? ] unit-test
-[ t ] [ V int-regs 1 9 get live-out? ] unit-test
+[ t ] [ V int-rep 1 9 get live-out? ] unit-test
-[ t ] [ V int-regs 2 9 get live-out? ] unit-test
+[ t ] [ V int-rep 2 9 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 10 get live-in? ] unit-test
+[ f ] [ V int-rep 0 10 get live-in? ] unit-test
-[ t ] [ V int-regs 1 10 get live-in? ] unit-test
+[ t ] [ V int-rep 1 10 get live-in? ] unit-test
-[ t ] [ V int-regs 2 10 get live-in? ] unit-test
+[ t ] [ V int-rep 2 10 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 10 get live-out? ] unit-test
+[ f ] [ V int-rep 0 10 get live-out? ] unit-test
-[ t ] [ V int-regs 1 10 get live-out? ] unit-test
+[ t ] [ V int-rep 1 10 get live-out? ] unit-test
-[ t ] [ V int-regs 2 10 get live-out? ] unit-test
+[ t ] [ V int-rep 2 10 get live-out? ] unit-test
 
-[ f ] [ V int-regs 0 11 get live-in? ] unit-test
+[ f ] [ V int-rep 0 11 get live-in? ] unit-test
-[ f ] [ V int-regs 1 11 get live-in? ] unit-test
+[ f ] [ V int-rep 1 11 get live-in? ] unit-test
-[ f ] [ V int-regs 2 11 get live-in? ] unit-test
+[ f ] [ V int-rep 2 11 get live-in? ] unit-test
 
-[ f ] [ V int-regs 0 11 get live-out? ] unit-test
+[ f ] [ V int-rep 0 11 get live-out? ] unit-test
-[ f ] [ V int-regs 1 11 get live-out? ] unit-test
+[ f ] [ V int-rep 1 11 get live-out? ] unit-test
-[ f ] [ V int-regs 2 11 get live-out? ] unit-test
+[ f ] [ V int-rep 2 11 get live-out? ] unit-test

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

@@ -9,41 +9,27 @@ TUPLE: stack-frame
 { return integer }
 { total-size integer }
 { gc-root-size integer }
-spill-counts ;
+{ spill-area-size integer } ;
 
 ! Stack frame utilities
 : param-base ( -- n )
     stack-frame get [ params>> ] [ return>> ] bi + ;
 
-: spill-float-offset ( n -- offset )
+: spill-offset ( n -- offset )
-    double-float-regs reg-size * ;
-
-: spill-integer-base ( -- n )
-    stack-frame get spill-counts>> double-float-regs [ swap at ] keep reg-size *
     param-base + ;
 
-: spill-integer-offset ( n -- offset )
-    cells spill-integer-base + ;
-
-: spill-area-size ( stack-frame -- n )
-    spill-counts>> [ swap reg-size * ] { } assoc>map sum ;
-
 : gc-root-base ( -- n )
-    stack-frame get spill-area-size
+    stack-frame get spill-area-size>> param-base + ;
-    param-base + ;
 
 : gc-root-offset ( n -- n' ) gc-root-base + ;
 
-: gc-roots-size ( live-values -- n )
-    keys [ reg-class>> reg-size ] sigma ;
-
 : (stack-frame-size) ( stack-frame -- n )
     [
         {
-            [ spill-area-size ]
-            [ gc-root-size>> ]
             [ params>> ]
             [ return>> ]
+            [ gc-root-size>> ]
+            [ spill-area-size>> ]
         } cleave
     ] sum-outputs ;
 

basis/compiler/cfg/stacks/uninitialized/uninitialized-tests.factor

@@ -14,14 +14,14 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##replace f V int-rep 0 D 0 }
-    T{ ##replace f V int-regs 0 D 1 }
+    T{ ##replace f V int-rep 0 D 1 }
-    T{ ##replace f V int-regs 0 D 2 }
+    T{ ##replace f V int-rep 0 D 2 }
     T{ ##inc-r f 1 }
 } 1 test-bb
 
 V{
-    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-rep 0 D 0 }
     T{ ##inc-d f 1 }
 } 2 test-bb
 

basis/compiler/cfg/tco/tco.factor

@@ -63,6 +63,5 @@ IN: compiler.cfg.tco
     ] [ drop ] if ;
 
 : optimize-tail-calls ( cfg -- cfg' )
-    dup cfg set
     dup [ optimize-tail-call ] each-basic-block
     cfg-changed ;

basis/compiler/cfg/two-operand/two-operand-tests.factor

@@ -6,11 +6,22 @@ compiler.cfg.registers cpu.architecture namespaces tools.test ;
 
 [
     V{
-        T{ ##copy f V int-regs 1 V int-regs 2 }
+        T{ ##copy f V int-rep 1 V int-rep 2 int-rep }
-        T{ ##sub f V int-regs 1 V int-regs 1 V int-regs 3 }
+        T{ ##sub f V int-rep 1 V int-rep 1 V int-rep 3 }
     }
 ] [
     {
-        T{ ##sub f V int-regs 1 V int-regs 2 V int-regs 3 }
+        T{ ##sub f V int-rep 1 V int-rep 2 V int-rep 3 }
+    } (convert-two-operand)
+] unit-test
+
+[
+    V{
+        T{ ##copy f V double-float-rep 1 V double-float-rep 2 double-float-rep }
+        T{ ##sub-float f V double-float-rep 1 V double-float-rep 1 V double-float-rep 3 }
+    }
+] [
+    {
+        T{ ##sub-float f V double-float-rep 1 V double-float-rep 2 V double-float-rep 3 }
     } (convert-two-operand)
 ] unit-test

basis/compiler/cfg/two-operand/two-operand.factor

@@ -44,10 +44,7 @@ UNION: two-operand-insn
 GENERIC: convert-two-operand* ( insn -- )
 
 : emit-copy ( dst src -- )
-    dup reg-class>> {
+    dup rep>> ##copy ; inline
-        { int-regs [ ##copy ] }
-        { double-float-regs [ ##copy-float ] }
-    } case ; inline
 
 M: two-operand-insn convert-two-operand*
     [ [ dst>> ] [ src1>> ] bi emit-copy ]

basis/compiler/cfg/value-numbering/simplify/simplify.factor

@@ -23,7 +23,6 @@ M: unary-expr simplify*
     #! its source VN.
     [ in>> vn>expr ] [ op>> ] bi {
         { \ ##copy [ ] }
-        { \ ##copy-float [ ] }
         { \ ##unbox-float [ simplify-unbox-float ] }
         { \ ##unbox-alien [ simplify-unbox-alien ] }
         { \ ##unbox-any-c-ptr [ simplify-unbox-alien ] }

basis/compiler/cfg/value-numbering/value-numbering.factor

@@ -14,7 +14,7 @@ IN: compiler.cfg.value-numbering
 ! Local value numbering. Predecessors must be recomputed after this
 : >copy ( insn -- insn/##copy )
     dup dst>> dup vreg>vn vn>vreg
-    2dup eq? [ 2drop ] [ \ ##copy new-insn nip ] if ;
+    2dup eq? [ 2drop ] [ dup rep>> \ ##copy new-insn nip ] if ;
 
 : rewrite-loop ( insn -- insn' )
     dup rewrite [ rewrite-loop ] [ ] ?if ;

basis/compiler/codegen/codegen.factor

@@ -173,12 +173,12 @@ M: ##div-float generate-insn dst/src1/src2 %div-float ;
 M: ##integer>float generate-insn dst/src %integer>float ;
 M: ##float>integer generate-insn dst/src %float>integer ;
 
-M: ##copy             generate-insn dst/src %copy ;
+M: ##copy generate-insn [ dst/src ] [ rep>> ] bi %copy ;
-M: ##copy-float       generate-insn dst/src %copy-float ;
+
-M: ##unbox-float      generate-insn dst/src %unbox-float ;
+M: ##unbox-float     generate-insn dst/src %unbox-float ;
-M: ##unbox-any-c-ptr  generate-insn dst/src/temp %unbox-any-c-ptr ;
+M: ##unbox-any-c-ptr generate-insn dst/src/temp %unbox-any-c-ptr ;
-M: ##box-float        generate-insn dst/src/temp %box-float ;
+M: ##box-float       generate-insn dst/src/temp %box-float ;
-M: ##box-alien        generate-insn dst/src/temp %box-alien ;
+M: ##box-alien       generate-insn dst/src/temp %box-alien ;
 
 M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ;
 M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;
@@ -226,31 +226,37 @@ M: ##write-barrier generate-insn
 GENERIC# save-gc-root 1 ( gc-root operand temp -- )
 
 M:: spill-slot save-gc-root ( gc-root operand temp -- )
-    temp operand n>> %reload-integer
+    temp operand n>> int-rep %reload
     gc-root temp %save-gc-root ;
 
 M: object save-gc-root drop %save-gc-root ;
 
 : save-gc-roots ( gc-roots temp -- ) '[ _ save-gc-root ] assoc-each ;
 
+: save-data-regs ( data-regs -- ) [ first3 %spill ] each ;
+
 GENERIC# load-gc-root 1 ( gc-root operand temp -- )
 
 M:: spill-slot load-gc-root ( gc-root operand temp -- )
     gc-root temp %load-gc-root
-    temp operand n>> %spill-integer ;
+    temp operand n>> int-rep %spill ;
 
 M: object load-gc-root drop %load-gc-root ;
 
 : load-gc-roots ( gc-roots temp -- ) '[ _ load-gc-root ] assoc-each ;
 
+: load-data-regs ( data-regs -- ) [ first3 %reload ] each ;
+
 M: _gc generate-insn
     "no-gc" define-label
     {
         [ [ "no-gc" get ] dip [ temp1>> ] [ temp2>> ] bi %check-nursery ]
         [ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
-        [ [ gc-roots>> ] [ temp1>> ] bi save-gc-roots ]
+        [ data-values>> save-data-regs ]
-        [ gc-root-count>> %call-gc ]
+        [ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ]
-        [ [ gc-roots>> ] [ temp1>> ] bi load-gc-roots ]
+        [ gc-root-size>> %call-gc ]
+        [ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
+        [ data-values>> load-data-regs ]
     } cleave
     "no-gc" resolve-label ;
 
@@ -261,54 +267,45 @@ M: ##alien-global generate-insn
     %alien-global ;
 
 ! ##alien-invoke
-GENERIC: reg-class-variable ( register-class -- symbol )
+GENERIC: next-fastcall-param ( reg-class -- )
 
-M: reg-class reg-class-variable ;
+: ?dummy-stack-params ( rep -- )
+    dummy-stack-params? [ rep-size cell align stack-params +@ ] [ drop ] if ;
 
-M: float-regs reg-class-variable drop float-regs ;
+: ?dummy-int-params ( rep -- )
+    dummy-int-params? [ rep-size cell /i 1 max int-regs +@ ] [ drop ] if ;
 
-GENERIC: inc-reg-class ( register-class -- )
+: ?dummy-fp-params ( rep -- )
-
-: ?dummy-stack-params ( reg-class -- )
-    dummy-stack-params? [ reg-size cell align stack-params +@ ] [ drop ] if ;
-
-: ?dummy-int-params ( reg-class -- )
-    dummy-int-params? [ reg-size cell /i 1 max int-regs +@ ] [ drop ] if ;
-
-: ?dummy-fp-params ( reg-class -- )
     drop dummy-fp-params? [ float-regs inc ] when ;
 
-M: int-regs inc-reg-class
+M: int-rep next-fastcall-param
-    [ reg-class-variable inc ]
+    int-regs inc [ ?dummy-stack-params ] [ ?dummy-fp-params ] bi ;
-    [ ?dummy-stack-params ]
-    [ ?dummy-fp-params ]
-    tri ;
 
-M: float-regs inc-reg-class
+M: single-float-rep next-fastcall-param
-    [ reg-class-variable inc ]
+    float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
-    [ ?dummy-stack-params ]
-    [ ?dummy-int-params ]
-    tri ;
 
-GENERIC: reg-class-full? ( class -- ? )
+M: double-float-rep next-fastcall-param
+    float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
+
+GENERIC: reg-class-full? ( reg-class -- ? )
 
 M: stack-params reg-class-full? drop t ;
 
-M: object reg-class-full?
+M: reg-class reg-class-full?
-    [ reg-class-variable get ] [ param-regs length ] bi >= ;
+    [ get ] [ param-regs length ] bi >= ;
 
-: spill-param ( reg-class -- n reg-class )
+: alloc-stack-param ( rep -- n reg-class rep )
     stack-params get
-    [ reg-size cell align stack-params +@ ] dip
+    [ rep-size cell align stack-params +@ ] dip
-    stack-params ;
+    stack-params dup ;
 
-: fastcall-param ( reg-class -- n reg-class )
+: alloc-fastcall-param ( rep -- n reg-class rep )
-    [ reg-class-variable get ] [ inc-reg-class ] [ ] tri ;
+    [ reg-class-of [ get ] [ inc ] [ ] tri ] keep ;
 
-: alloc-parameter ( parameter -- reg reg-class )
+: alloc-parameter ( parameter -- reg rep )
-    c-type-reg-class dup reg-class-full?
+    c-type-rep dup reg-class-of reg-class-full?
-    [ spill-param ] [ fastcall-param ] if
+    [ alloc-stack-param ] [ alloc-fastcall-param ] if
-    [ param-reg ] keep ;
+    [ param-reg ] dip ;
 
 : (flatten-int-type) ( size -- seq )
     cell /i "void*" c-type <repetition> ;
@@ -340,12 +337,12 @@ M: long-long-type flatten-value-type ( type -- types )
 : reverse-each-parameter ( parameters quot -- )
     [ [ parameter-sizes nip ] keep ] dip 2reverse-each ; inline
 
-: reset-freg-counts ( -- )
+: reset-fastcall-counts ( -- )
     { int-regs float-regs stack-params } [ 0 swap set ] each ;
 
 : with-param-regs ( quot -- )
     #! In quot you can call alloc-parameter
-    [ reset-freg-counts call ] with-scope ; inline
+    [ reset-fastcall-counts call ] with-scope ; inline
 
 : move-parameters ( node word -- )
     #! Moves values from C stack to registers (if word is
@@ -431,6 +428,7 @@ M: ##alien-indirect generate-insn
     alien-parameters [ box-parameter ] each-parameter ;
 
 : registers>objects ( node -- )
+    ! Generate code for boxing input parameters in a callback.
     [
         dup \ %save-param-reg move-parameters
         "nest_stacks" f %alien-invoke
@@ -528,21 +526,9 @@ M: _compare-float-branch generate-insn
     >binary-branch< %compare-float-branch ;
 
 M: _spill generate-insn
-    [ src>> ] [ n>> ] [ class>> ] tri {
+    [ src>> ] [ n>> ] [ rep>> ] tri %spill ;
-        { int-regs [ %spill-integer ] }
-        { double-float-regs [ %spill-float ] }
-    } case ;
 
 M: _reload generate-insn
-    [ dst>> ] [ n>> ] [ class>> ] tri {
+    [ dst>> ] [ n>> ] [ rep>> ] tri %reload ;
-        { int-regs [ %reload-integer ] }
-        { double-float-regs [ %reload-float ] }
-    } case ;
 
-M: _copy generate-insn
+M: _spill-area-size generate-insn drop ;
-    [ dst>> ] [ src>> ] [ class>> ] tri {
-        { int-regs [ %copy ] }
-        { double-float-regs [ %copy-float ] }
-    } case ;
-
-M: _spill-counts generate-insn drop ;

basis/compiler/tests/low-level-ir.factor

@@ -20,7 +20,7 @@ IN: compiler.tests.low-level-ir
     V{ T{ ##prologue } T{ ##branch } } 0 test-bb
     V{
         T{ ##inc-d f 1 }
-        T{ ##replace f V int-regs 0 D 0 }
+        T{ ##replace f V int-rep 0 D 0 }
         T{ ##branch }
     } [ clone ] map append 1 test-bb
     V{
@@ -35,13 +35,13 @@ IN: compiler.tests.low-level-ir
 ! loading immediates
 [ f ] [
     V{
-        T{ ##load-immediate f V int-regs 0 5 }
+        T{ ##load-immediate f V int-rep 0 5 }
     } compile-test-bb
 ] unit-test
 
 [ "hello" ] [
     V{
-        T{ ##load-reference f V int-regs 0 "hello" }
+        T{ ##load-reference f V int-rep 0 "hello" }
     } compile-test-bb
 ] unit-test
 
@@ -49,72 +49,72 @@ IN: compiler.tests.low-level-ir
 ! one of the sources
 [ t ] [
     V{
-        T{ ##load-immediate f V int-regs 1 $[ 2 cell log2 shift ] }
+        T{ ##load-immediate f V int-rep 1 $[ 2 cell log2 shift ] }
-        T{ ##load-reference f V int-regs 0 { t f t } }
+        T{ ##load-reference f V int-rep 0 { t f t } }
-        T{ ##slot f V int-regs 0 V int-regs 0 V int-regs 1 $[ array tag-number ] V int-regs 2 }
+        T{ ##slot f V int-rep 0 V int-rep 0 V int-rep 1 $[ array tag-number ] V int-rep 2 }
     } compile-test-bb
 ] unit-test
 
 [ t ] [
     V{
-        T{ ##load-reference f V int-regs 0 { t f t } }
+        T{ ##load-reference f V int-rep 0 { t f t } }
-        T{ ##slot-imm f V int-regs 0 V int-regs 0 2 $[ array tag-number ] V int-regs 2 }
+        T{ ##slot-imm f V int-rep 0 V int-rep 0 2 $[ array tag-number ] V int-rep 2 }
     } compile-test-bb
 ] unit-test
 
 [ t ] [
     V{
-        T{ ##load-immediate f V int-regs 1 $[ 2 cell log2 shift ] }
+        T{ ##load-immediate f V int-rep 1 $[ 2 cell log2 shift ] }
-        T{ ##load-reference f V int-regs 0 { t f t } }
+        T{ ##load-reference f V int-rep 0 { t f t } }
-        T{ ##set-slot f V int-regs 0 V int-regs 0 V int-regs 1 $[ array tag-number ] V int-regs 2 }
+        T{ ##set-slot f V int-rep 0 V int-rep 0 V int-rep 1 $[ array tag-number ] V int-rep 2 }
     } compile-test-bb
     dup first eq?
 ] unit-test
 
 [ t ] [
     V{
-        T{ ##load-reference f V int-regs 0 { t f t } }
+        T{ ##load-reference f V int-rep 0 { t f t } }
-        T{ ##set-slot-imm f V int-regs 0 V int-regs 0 2 $[ array tag-number ] }
+        T{ ##set-slot-imm f V int-rep 0 V int-rep 0 2 $[ array tag-number ] }
     } compile-test-bb
     dup first eq?
 ] unit-test
 
 [ 8 ] [
     V{
-        T{ ##load-immediate f V int-regs 0 4 }
+        T{ ##load-immediate f V int-rep 0 4 }
-        T{ ##shl f V int-regs 0 V int-regs 0 V int-regs 0 }
+        T{ ##shl f V int-rep 0 V int-rep 0 V int-rep 0 }
     } compile-test-bb
 ] unit-test
 
 [ 4 ] [
     V{
-        T{ ##load-immediate f V int-regs 0 4 }
+        T{ ##load-immediate f V int-rep 0 4 }
-        T{ ##shl-imm f V int-regs 0 V int-regs 0 3 }
+        T{ ##shl-imm f V int-rep 0 V int-rep 0 3 }
     } compile-test-bb
 ] unit-test
 
 [ 31 ] [
     V{
-        T{ ##load-reference f V int-regs 1 B{ 31 67 52 } }
+        T{ ##load-reference f V int-rep 1 B{ 31 67 52 } }
-        T{ ##unbox-any-c-ptr f V int-regs 0 V int-regs 1 V int-regs 2 }
+        T{ ##unbox-any-c-ptr f V int-rep 0 V int-rep 1 V int-rep 2 }
-        T{ ##alien-unsigned-1 f V int-regs 0 V int-regs 0 }
+        T{ ##alien-unsigned-1 f V int-rep 0 V int-rep 0 }
-        T{ ##shl-imm f V int-regs 0 V int-regs 0 3 }
+        T{ ##shl-imm f V int-rep 0 V int-rep 0 3 }
     } compile-test-bb
 ] unit-test
 
 [ CHAR: l ] [
     V{
-        T{ ##load-reference f V int-regs 0 "hello world" }
+        T{ ##load-reference f V int-rep 0 "hello world" }
-        T{ ##load-immediate f V int-regs 1 3 }
+        T{ ##load-immediate f V int-rep 1 3 }
-        T{ ##string-nth f V int-regs 0 V int-regs 0 V int-regs 1 V int-regs 2 }
+        T{ ##string-nth f V int-rep 0 V int-rep 0 V int-rep 1 V int-rep 2 }
-        T{ ##shl-imm f V int-regs 0 V int-regs 0 3 }
+        T{ ##shl-imm f V int-rep 0 V int-rep 0 3 }
     } compile-test-bb
 ] unit-test
 
 [ 1 ] [
     V{
-        T{ ##load-immediate f V int-regs 0 16 }
+        T{ ##load-immediate f V int-rep 0 16 }
-        T{ ##add-imm f V int-regs 0 V int-regs 0 -8 }
+        T{ ##add-imm f V int-rep 0 V int-rep 0 -8 }
     } compile-test-bb
 ] unit-test
 
@@ -125,15 +125,15 @@ USE: multiline
 
 [ 100 ] [
     V{
-        T{ ##load-immediate f V int-regs 0 100 }
+        T{ ##load-immediate f V int-rep 0 100 }
-        T{ ##integer>bignum f V int-regs 0 V int-regs 0 V int-regs 1 }
+        T{ ##integer>bignum f V int-rep 0 V int-rep 0 V int-rep 1 }
     } compile-test-bb
 ] unit-test
 
 [ 1 ] [
     V{
-        T{ ##load-reference f V int-regs 0 ALIEN: 8 }
+        T{ ##load-reference f V int-rep 0 ALIEN: 8 }
-        T{ ##unbox-any-c-ptr f V int-regs 0 V int-regs 0 V int-regs 1 }
+        T{ ##unbox-any-c-ptr f V int-rep 0 V int-rep 0 V int-rep 1 }
     } compile-test-bb
 ] unit-test
 

basis/cpu/architecture/architecture.factor

@@ -1,43 +1,51 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays generic kernel kernel.private math
 memory namespaces make sequences layouts system hashtables
 classes alien byte-arrays combinators words sets fry ;
 IN: cpu.architecture
 
+! Representations -- these are like low-level types
+
+! Integer registers can contain data with one of these two representations
+SINGLETONS: tagged-rep int-rep ;
+
+! Floating point registers can contain data with
+! one of these representations
+SINGLETONS: single-float-rep double-float-rep ;
+
+UNION: representation tagged-rep int-rep single-float-rep double-float-rep ;
+
 ! Register classes
-SINGLETON: int-regs
+SINGLETONS: int-regs float-regs ;
-SINGLETON: single-float-regs
+
-SINGLETON: double-float-regs
-UNION: float-regs single-float-regs double-float-regs ;
 UNION: reg-class int-regs float-regs ;
+CONSTANT: reg-classes { int-regs float-regs }
 
 ! A pseudo-register class for parameters spilled on the stack
 SINGLETON: stack-params
 
-GENERIC: reg-size ( register-class -- n )
+: reg-class-of ( rep -- reg-class )
+    {
+        { tagged-rep [ int-regs ] }
+        { int-rep [ int-regs ] }
+        { single-float-rep [ float-regs ] }
+        { double-float-rep [ float-regs ] }
+        { stack-params [ stack-params ] }
+    } case ;
 
-M: int-regs reg-size drop cell ;
+: rep-size ( rep -- n )
-
+    {
-M: single-float-regs reg-size drop 4 ;
+        { tagged-rep [ cell ] }
-
+        { int-rep [ cell ] }
-M: double-float-regs reg-size drop 8 ;
+        { single-float-rep [ 4 ] }
-
+        { double-float-rep [ 8 ] }
-M: stack-params reg-size drop cell ;
+        { stack-params [ cell ] }
+    } case ;
 
 ! Mapping from register class to machine registers
 HOOK: machine-registers cpu ( -- assoc )
 
-! Return values of this class go here
-GENERIC: return-reg ( register-class -- reg )
-
-! Sequence of registers used for parameter passing in class
-GENERIC: param-regs ( register-class -- regs )
-
-GENERIC: param-reg ( n register-class -- reg )
-
-M: object param-reg param-regs nth ;
-
 HOOK: two-operand? cpu ( -- ? )
 
 HOOK: %load-immediate cpu ( reg obj -- )
@@ -100,8 +108,7 @@ HOOK: %div-float cpu ( dst src1 src2 -- )
 HOOK: %integer>float cpu ( dst src -- )
 HOOK: %float>integer cpu ( dst src -- )
 
-HOOK: %copy cpu ( dst src -- )
+HOOK: %copy cpu ( dst src rep -- )
-HOOK: %copy-float cpu ( dst src -- )
 HOOK: %unbox-float cpu ( dst src -- )
 HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
 HOOK: %box-float cpu ( dst src temp -- )
@@ -146,15 +153,27 @@ HOOK: %compare-branch cpu ( label cc src1 src2 -- )
 HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- )
 HOOK: %compare-float-branch cpu ( label cc src1 src2 -- )
 
-HOOK: %spill-integer cpu ( src n -- )
+HOOK: %spill cpu ( src n rep -- )
-HOOK: %spill-float cpu ( src n -- )
+HOOK: %reload cpu ( dst n rep -- )
-HOOK: %reload-integer cpu ( dst n -- )
-HOOK: %reload-float cpu ( dst n -- )
 
 HOOK: %loop-entry cpu ( -- )
 
 ! FFI stuff
 
+! Return values of this class go here
+GENERIC: return-reg ( reg-class -- reg )
+
+! Sequence of registers used for parameter passing in class
+GENERIC: param-regs ( reg-class -- regs )
+
+M: stack-params param-regs drop f ;
+
+GENERIC: param-reg ( n reg-class -- reg )
+
+M: reg-class param-reg param-regs nth ;
+
+M: stack-params param-reg drop ;
+
 ! Is this integer small enough to appear in value template
 ! slots?
 HOOK: small-enough? cpu ( n -- ? )
@@ -176,7 +195,7 @@ HOOK: dummy-fp-params? cpu ( -- ? )
 
 HOOK: %prepare-unbox cpu ( -- )
 
-HOOK: %unbox cpu ( n reg-class func -- )
+HOOK: %unbox cpu ( n rep func -- )
 
 HOOK: %unbox-long-long cpu ( n func -- )
 
@@ -184,7 +203,7 @@ HOOK: %unbox-small-struct cpu ( c-type -- )
 
 HOOK: %unbox-large-struct cpu ( n c-type -- )
 
-HOOK: %box cpu ( n reg-class func -- )
+HOOK: %box cpu ( n rep func -- )
 
 HOOK: %box-long-long cpu ( n func -- )
 
@@ -194,9 +213,9 @@ HOOK: %box-small-struct cpu ( c-type -- )
 
 HOOK: %box-large-struct cpu ( n c-type -- )
 
-GENERIC: %save-param-reg ( stack reg reg-class -- )
+HOOK: %save-param-reg cpu ( stack reg rep -- )
 
-GENERIC: %load-param-reg ( stack reg reg-class -- )
+HOOK: %load-param-reg cpu ( stack reg rep -- )
 
 HOOK: %prepare-alien-invoke cpu ( -- )
 
@@ -222,7 +241,3 @@ HOOK: %callback-value cpu ( ctype -- )
 HOOK: %callback-return cpu ( params -- )
 
 M: object %callback-return drop %return ;
-
-M: stack-params param-reg drop ;
-
-M: stack-params param-regs drop f ;

basis/cpu/ppc/ppc.factor

@@ -32,7 +32,7 @@ enable-float-intrinsics
 M: ppc machine-registers
     {
         { int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
-        { double-float-regs $[ 0 29 [a,b] ] }
+        { float-regs $[ 0 29 [a,b] ] }
     } ;
 
 CONSTANT: scratch-reg 30
@@ -493,26 +493,18 @@ M: float-regs return-reg drop 1 ;
 M: int-regs %save-param-reg drop 1 rot local@ STW ;
 M: int-regs %load-param-reg drop 1 rot local@ LWZ ;
 
-GENERIC: STF ( src dst off reg-class -- )
+M: single-float-rep %save-param-reg drop 1 rot local@ STFS ;
+M: single-float-rep %load-param-reg 1 rot local@ LFS ;
 
-M: single-float-regs STF drop STFS ;
+M: double-float-rep %save-param-reg drop 1 rot local@ STFD ;
-M: double-float-regs STF drop STFD ;
+M: double-float-rep %load-param-reg 1 rot local@ LFD ;
 
-M: float-regs %save-param-reg [ 1 rot local@ ] dip STF ;
+M: stack-params %load-param-reg ( stack reg rep -- )
-
-GENERIC: LF ( dst src off reg-class -- )
-
-M: single-float-regs LF drop LFS ;
-M: double-float-regs LF drop LFD ;
-
-M: float-regs %load-param-reg [ 1 rot local@ ] dip LF ;
-
-M: stack-params %load-param-reg ( stack reg reg-class -- )
     drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ;
 
 : next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
 
-M: stack-params %save-param-reg ( stack reg reg-class -- )
+M: stack-params %save-param-reg ( stack reg rep -- )
     #! Funky. Read the parameter from the caller's stack frame.
     #! This word is used in callbacks
     drop
@@ -524,12 +516,12 @@ M: ppc %prepare-unbox ( -- )
     3 ds-reg 0 LWZ
     ds-reg dup cell SUBI ;
 
-M: ppc %unbox ( n reg-class func -- )
+M: ppc %unbox ( n rep func -- )
     ! Value must be in r3
     ! Call the unboxer
     f %alien-invoke
     ! Store the return value on the C stack
-    over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
+    over [ [ reg-class-of return-reg ] keep %save-param-reg ] [ 2drop ] if ;
 
 M: ppc %unbox-long-long ( n func -- )
     ! Value must be in r3:r4
@@ -548,11 +540,11 @@ M: ppc %unbox-large-struct ( n c-type -- )
     ! Call the function
     "to_value_struct" f %alien-invoke ;
 
-M: ppc %box ( n reg-class func -- )
+M: ppc %box ( n rep func -- )
     ! If the source is a stack location, load it into freg #0.
     ! If the source is f, then we assume the value is already in
     ! freg #0.
-    [ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip
+    [ over [ 0 over reg-class-of param-reg swap %load-param-reg ] [ 2drop ] if ] dip
     f %alien-invoke ;
 
 M: ppc %box-long-long ( n func -- )

basis/cpu/x86/32/32.factor

@@ -10,21 +10,18 @@ cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
 IN: cpu.x86.32
 
 ! We implement the FFI for Linux, OS X and Windows all at once.
-! OS X requires that the stack be 16-byte aligned, and we do
+! OS X requires that the stack be 16-byte aligned.
-! this on all platforms, sacrificing some stack space for
-! code simplicity.
 
 M: x86.32 machine-registers
     {
         { int-regs { EAX ECX EDX EBP EBX } }
-        { double-float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } }
+        { float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } }
     } ;
 
 M: x86.32 ds-reg ESI ;
 M: x86.32 rs-reg EDI ;
 M: x86.32 stack-reg ESP ;
-M: x86.32 temp-reg-1 ECX ;
+M: x86.32 temp-reg ECX ;
-M: x86.32 temp-reg-2 EDX ;
 
 M:: x86.32 %dispatch ( src temp -- )
     ! Load jump table base.
@@ -63,29 +60,23 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? )
 ! On x86, parameters are never passed in registers.
 M: int-regs return-reg drop EAX ;
 M: int-regs param-regs drop { } ;
-M: int-regs push-return-reg return-reg PUSH ;
-
-M: int-regs load-return-reg
-    return-reg swap next-stack@ MOV ;
-
-M: int-regs store-return-reg
-    [ stack@ ] [ return-reg ] bi* MOV ;
-
 M: float-regs param-regs drop { } ;
 
-: FSTP ( operand size -- ) 4 = [ FSTPS ] [ FSTPL ] if ;
+GENERIC: push-return-reg ( rep -- )
+GENERIC: load-return-reg ( n rep -- )
+GENERIC: store-return-reg ( n rep -- )
 
-M: float-regs push-return-reg
+M: int-rep push-return-reg drop EAX PUSH ;
-    stack-reg swap reg-size
+M: int-rep load-return-reg drop EAX swap next-stack@ MOV ;
-    [ SUB ] [ [ [] ] dip FSTP ] 2bi ;
+M: int-rep store-return-reg drop stack@ EAX MOV ;
 
-: FLD ( operand size -- ) 4 = [ FLDS ] [ FLDL ] if ;
+M: single-float-rep push-return-reg drop ESP 4 SUB ESP [] FSTPS ;
+M: single-float-rep load-return-reg drop next-stack@ FLDS ;
+M: single-float-rep store-return-reg drop stack@ FSTPS ;
 
-M: float-regs load-return-reg
+M: double-float-rep push-return-reg drop ESP 8 SUB ESP [] FSTPL ;
-    [ next-stack@ ] [ reg-size ] bi* FLD ;
+M: double-float-rep load-return-reg drop next-stack@ FLDL ;
-
+M: double-float-rep store-return-reg drop stack@ FSTPL ;
-M: float-regs store-return-reg
-    [ stack@ ] [ reg-size ] bi* FSTP ;
 
 : align-sub ( n -- )
     [ align-stack ] keep - decr-stack-reg ;
@@ -101,21 +92,21 @@ M: x86.32 %prologue ( n -- )
     0 PUSH rc-absolute-cell rel-this
     3 cells - decr-stack-reg ;
 
-M: object %load-param-reg 3drop ;
+M: x86.32 %load-param-reg 3drop ;
 
-M: object %save-param-reg 3drop ;
+M: x86.32 %save-param-reg 3drop ;
 
-: (%box) ( n reg-class -- )
+: (%box) ( n rep -- )
     #! If n is f, push the return register onto the stack; we
     #! are boxing a return value of a C function. If n is an
     #! integer, push [ESP+n] on the stack; we are boxing a
     #! parameter being passed to a callback from C.
     over [ load-return-reg ] [ 2drop ] if ;
 
-M:: x86.32 %box ( n reg-class func -- )
+M:: x86.32 %box ( n rep func -- )
-    n reg-class (%box)
+    n rep (%box)
-    reg-class reg-size [
+    rep rep-size [
-        reg-class push-return-reg
+        rep push-return-reg
         func f %alien-invoke
     ] with-aligned-stack ;
     
@@ -165,7 +156,7 @@ M: x86.32 %prepare-unbox ( -- )
     EAX ESI [] MOV
     ESI 4 SUB ;
 
-: (%unbox) ( func -- )
+: call-unbox-func ( func -- )
     4 [
         ! Push parameter
         EAX PUSH
@@ -173,17 +164,17 @@ M: x86.32 %prepare-unbox ( -- )
         f %alien-invoke
     ] with-aligned-stack ;
 
-M: x86.32 %unbox ( n reg-class func -- )
+M: x86.32 %unbox ( n rep func -- )
     #! The value being unboxed must already be in EAX.
     #! If n is f, we're unboxing a return value about to be
     #! returned by the callback. Otherwise, we're unboxing
     #! a parameter to a C function about to be called.
-    (%unbox)
+    call-unbox-func
     ! Store the return value on the C stack
     over [ store-return-reg ] [ 2drop ] if ;
 
 M: x86.32 %unbox-long-long ( n func -- )
-    (%unbox)
+    call-unbox-func
     ! Store the return value on the C stack
     [
         dup stack@ EAX MOV

basis/cpu/x86/64/64.factor

@@ -11,7 +11,7 @@ IN: cpu.x86.64
 M: x86.64 machine-registers
     {
         { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
-        { double-float-regs {
+        { float-regs {
             XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
             XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
         } }
@@ -46,20 +46,21 @@ M: int-regs return-reg drop RAX ;
 M: float-regs return-reg drop XMM0 ;
 
 M: x86.64 %prologue ( n -- )
-    temp-reg-1 0 MOV rc-absolute-cell rel-this
+    temp-reg 0 MOV rc-absolute-cell rel-this
     dup PUSH
-    temp-reg-1 PUSH
+    temp-reg PUSH
     stack-reg swap 3 cells - SUB ;
 
-M: stack-params %load-param-reg
+M: stack-params copy-register*
     drop
-    [ R11 swap param@ MOV ] dip
+    {
-    param@ R11 MOV ;
+        { [ dup  integer? ] [ R11 swap next-stack@ MOV  R11 MOV ] }
+        { [ over integer? ] [ R11 swap MOV              param@ R11 MOV ] }
+    } cond ;
 
-M: stack-params %save-param-reg
+M: x86 %save-param-reg [ param@ ] 2dip copy-register ;
-    drop
+
-    R11 swap next-stack@ MOV
+M: x86 %load-param-reg [ swap param@ ] dip copy-register ;
-    param@ R11 MOV ;
 
 : with-return-regs ( quot -- )
     [
@@ -73,20 +74,22 @@ M: x86.64 %prepare-unbox ( -- )
     param-reg-1 R14 [] MOV
     R14 cell SUB ;
 
-M: x86.64 %unbox ( n reg-class func -- )
+M:: x86.64 %unbox ( n rep func -- )
     ! Call the unboxer
-    f %alien-invoke
+    func f %alien-invoke
-    ! Store the return value on the C stack
+    ! Store the return value on the C stack if this is an
-    over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
+    ! alien-invoke, otherwise leave it the return register if
+    ! this is the end of alien-callback
+    n [ n rep reg-class-of return-reg rep %save-param-reg ] when ;
 
 M: x86.64 %unbox-long-long ( n func -- )
-    int-regs swap %unbox ;
+    [ int-rep ] dip %unbox ;
 
 : %unbox-struct-field ( c-type i -- )
     ! Alien must be in param-reg-1.
-    R11 swap cells [+] swap reg-class>> {
+    R11 swap cells [+] swap rep>> reg-class-of {
         { int-regs [ int-regs get pop swap MOV ] }
-        { double-float-regs [ float-regs get pop swap MOVSD ] }
+        { float-regs [ float-regs get pop swap MOVSD ] }
     } case ;
 
 M: x86.64 %unbox-small-struct ( c-type -- )
@@ -109,27 +112,31 @@ M: x86.64 %unbox-large-struct ( n c-type -- )
     ! Copy the struct to the C stack
     "to_value_struct" f %alien-invoke ;
 
-: load-return-value ( reg-class -- )
+: load-return-value ( rep -- )
-    0 over param-reg swap return-reg
+    [ [ 0 ] dip reg-class-of param-reg ]
-    2dup eq? [ 2drop ] [ MOV ] if ;
+    [ reg-class-of return-reg ]
+    [ ]
+    tri copy-register ;
 
-M: x86.64 %box ( n reg-class func -- )
+M:: x86.64 %box ( n rep func -- )
-    rot [
+    n [
-        rot [ 0 swap param-reg ] keep %load-param-reg
+        n
+        0 rep reg-class-of param-reg
+        rep %load-param-reg
     ] [
-        swap load-return-value
+        rep load-return-value
-    ] if*
+    ] if
-    f %alien-invoke ;
+    func f %alien-invoke ;
 
 M: x86.64 %box-long-long ( n func -- )
-    int-regs swap %box ;
+    [ int-rep ] dip %box ;
 
 : box-struct-field@ ( i -- operand ) 1+ cells param@ ;
 
 : %box-struct-field ( c-type i -- )
-    box-struct-field@ swap reg-class>> {
+    box-struct-field@ swap c-type-rep reg-class-of {
         { int-regs [ int-regs get pop MOV ] }
-        { double-float-regs [ float-regs get pop MOVSD ] }
+        { float-regs [ float-regs get pop MOVSD ] }
     } case ;
 
 M: x86.64 %box-small-struct ( c-type -- )

basis/cpu/x86/64/unix/unix.factor

@@ -6,7 +6,8 @@ cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
 compiler.cfg.registers ;
 IN: cpu.x86.64.unix
 
-M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
+M: int-regs param-regs
+    drop { RDI RSI RDX RCX R8 R9 } ;
 
 M: float-regs param-regs
     drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
@@ -15,7 +16,7 @@ M: x86.64 reserved-area-size 0 ;
 
 ! The ABI for passing structs by value is pretty messed up
 << "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type (>>reg-class) >>
+stack-params "__stack_value" c-type (>>rep) >>
 
 : struct-types&offset ( struct-type -- pairs )
     fields>> [
@@ -29,7 +30,7 @@ stack-params "__stack_value" c-type (>>reg-class) >>
 
 : flatten-small-struct ( c-type -- seq )
     struct-types&offset split-struct [
-        [ c-type c-type-reg-class ] map
+        [ c-type c-type-rep reg-class-of ] map
         int-regs swap member? "void*" "double" ? c-type
     ] map ;
 
@@ -53,6 +54,4 @@ M: x86.64 dummy-int-params? f ;
 
 M: x86.64 dummy-fp-params? f ;
 
-M: x86.64 temp-reg-1 R8 ;
+M: x86.64 temp-reg R8 ;
-
-M: x86.64 temp-reg-2 R9 ;

basis/cpu/x86/64/winnt/winnt.factor

@@ -22,9 +22,7 @@ M: x86.64 dummy-int-params? t ;
 
 M: x86.64 dummy-fp-params? t ;
 
-M: x86.64 temp-reg-1 RAX ;
+M: x86.64 temp-reg RAX ;
-
-M: x86.64 temp-reg-2 RCX ;
 
 <<
 "longlong" "ptrdiff_t" typedef

basis/cpu/x86/assembler/operands/operands.factor

@@ -26,15 +26,11 @@ REGISTERS: 128
 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
 
-<PRIVATE
-
-GENERIC: extended? ( op -- ? )
-
-M: object extended? drop f ;
-
 PREDICATE: register < word
     "register" word-prop ;
 
+<PRIVATE
+
 PREDICATE: register-8 < register
     "register-size" word-prop 8 = ;
 
@@ -50,6 +46,10 @@ PREDICATE: register-64 < register
 PREDICATE: register-128 < register
     "register-size" word-prop 128 = ;
 
+GENERIC: extended? ( op -- ? )
+
+M: object extended? drop f ;
+
 M: register extended? "register" word-prop 7 > ;
 
 ! Addressing modes

basis/cpu/x86/x86.factor

@@ -30,9 +30,7 @@ HOOK: reserved-area-size cpu ( -- n )
 
 : param@ ( n -- op ) reserved-area-size + stack@ ;
 
-: spill-integer@ ( n -- op ) spill-integer-offset param@ ;
+: spill@ ( n -- op ) spill-offset param@ ;
-
-: spill-float@ ( n -- op ) spill-float-offset param@ ;
 
 : gc-root@ ( n -- op ) gc-root-offset param@ ;
 
@@ -48,9 +46,11 @@ HOOK: reserved-area-size cpu ( -- n )
 M: x86 stack-frame-size ( stack-frame -- i )
     (stack-frame-size) 3 cells reserved-area-size + + align-stack ;
 
-HOOK: temp-reg-1 cpu ( -- reg )
+! Must be a volatile register not used for parameter passing, for safe
-HOOK: temp-reg-2 cpu ( -- reg )
+! use in calls in and out of C
+HOOK: temp-reg cpu ( -- reg )
 
+! Fastcall calling convention
 HOOK: param-reg-1 cpu ( -- reg )
 HOOK: param-reg-2 cpu ( -- reg )
 
@@ -126,9 +126,6 @@ M: x86 %sar-imm nip SAR ;
 M: x86 %not     drop NOT ;
 M: x86 %log2    BSR ;
 
-: ?MOV ( dst src -- )
-    2dup = [ 2drop ] [ MOV ] if ; inline
-
 :: overflow-template ( label dst src1 src2 insn -- )
     src1 src2 insn call
     label JO ; inline
@@ -210,10 +207,17 @@ M: x86 %div-float nip DIVSD ;
 M: x86 %integer>float CVTSI2SD ;
 M: x86 %float>integer CVTTSD2SI ;
 
-M: x86 %copy ( dst src -- ) ?MOV ;
+GENERIC: copy-register* ( dst src rep -- )
 
-M: x86 %copy-float ( dst src -- )
+M: int-rep copy-register* drop MOV ;
-    2dup = [ 2drop ] [ MOVSD ] if ;
+M: tagged-rep copy-register* drop MOV ;
+M: single-float-rep copy-register* drop MOVSS ;
+M: double-float-rep copy-register* drop MOVSD ;
+
+: copy-register ( dst src rep -- )
+    2over eq? [ 3drop ] [ copy-register* ] if ;
+
+M: x86 %copy ( dst src rep -- ) copy-register ;
 
 M: x86 %unbox-float ( dst src -- )
     float-offset [+] MOVSD ;
@@ -301,6 +305,9 @@ M: x86.64 has-small-reg? 2drop t ;
         [ quot call ] with-save/restore
     ] if ; inline
 
+: ?MOV ( dst src -- )
+    2dup = [ 2drop ] [ MOV ] if ; inline
+
 M:: x86 %string-nth ( dst src index temp -- )
     ! We request a small-reg of size 8 since those of size 16 are
     ! a superset.
@@ -512,39 +519,21 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
         { cc/= [ JNE ] }
     } case ;
 
-M: x86 %spill-integer ( src n -- ) spill-integer@ swap MOV ;
+M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ;
-M: x86 %reload-integer ( dst n -- ) spill-integer@ MOV ;
+M: x86 %reload ( dst n rep -- ) [ spill@ ] dip copy-register ;
-
-M: x86 %spill-float ( src n -- ) spill-float@ swap MOVSD ;
-M: x86 %reload-float ( dst n -- ) spill-float@ MOVSD ;
 
 M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
 
-M: int-regs %save-param-reg drop [ param@ ] dip MOV ;
-M: int-regs %load-param-reg drop swap param@ MOV ;
-
-GENERIC: MOVSS/D ( dst src reg-class -- )
-
-M: single-float-regs MOVSS/D drop MOVSS ;
-M: double-float-regs MOVSS/D drop MOVSD ;
-
-M: float-regs %save-param-reg [ param@ ] 2dip MOVSS/D ;
-M: float-regs %load-param-reg [ swap param@ ] dip MOVSS/D ;
-
-GENERIC: push-return-reg ( reg-class -- )
-GENERIC: load-return-reg ( n reg-class -- )
-GENERIC: store-return-reg ( n reg-class -- )
-
 M: x86 %prepare-alien-invoke
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    temp-reg-1 "stack_chain" f %alien-global
+    temp-reg "stack_chain" f %alien-global
-    temp-reg-1 temp-reg-1 [] MOV
+    temp-reg temp-reg [] MOV
-    temp-reg-1 [] stack-reg MOV
+    temp-reg [] stack-reg MOV
-    temp-reg-1 [] cell SUB
+    temp-reg [] cell SUB
-    temp-reg-1 2 cells [+] ds-reg MOV
+    temp-reg 2 cells [+] ds-reg MOV
-    temp-reg-1 3 cells [+] rs-reg MOV ;
+    temp-reg 3 cells [+] rs-reg MOV ;
 
 M: x86 value-struct? drop t ;