compiler: Start using tagged-rep for stuff, and split up compiler.cfg.representations into several sub-vocabularies

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

@@ -238,7 +238,7 @@ M: insn analyze-aliases*
     ! a new value, except boxing instructions haven't been
     ! inserted yet.
     dup defs-vreg [
-        over defs-vreg-rep int-rep eq?
+        over defs-vreg-rep { int-rep tagged-rep } member?
         [ set-heap-ac ] [ set-new-ac ] if
     ] when* ;
 

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

@@ -32,8 +32,8 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
 
 : insert-gc-check ( bb -- )
     dup dup '[
-        int-rep next-vreg-rep
+        tagged-rep next-vreg-rep
-        int-rep next-vreg-rep
+        tagged-rep next-vreg-rep
         _ allocation-size
         f
         f

basis/compiler/cfg/instructions/instructions.factor

@@ -22,15 +22,15 @@ TUPLE: pure-insn < insn ;
 
 ! Stack operations
 INSN: ##load-immediate
-def: dst/int-rep
+def: dst/tagged-rep
 constant: val ;
 
 INSN: ##load-reference
-def: dst/int-rep
+def: dst/tagged-rep
 constant: obj ;
 
 INSN: ##load-constant
-def: dst/int-rep
+def: dst/tagged-rep
 constant: obj ;
 
 INSN: ##load-double
@@ -38,11 +38,11 @@ def: dst/double-rep
 constant: val ;
 
 INSN: ##peek
-def: dst/int-rep
+def: dst/tagged-rep
 literal: loc ;
 
 INSN: ##replace
-use: src/int-rep
+use: src/tagged-rep
 literal: loc ;
 
 INSN: ##inc-d
@@ -65,34 +65,34 @@ INSN: ##no-tco ;
 
 ! Jump tables
 INSN: ##dispatch
-use: src/int-rep
+use: src/tagged-rep
 temp: temp/int-rep ;
 
 ! Slot access
 INSN: ##slot
-def: dst/int-rep
+def: dst/tagged-rep
-use: obj/int-rep slot/int-rep ;
+use: obj/tagged-rep slot/tagged-rep ;
 
 INSN: ##slot-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: obj/int-rep
+use: obj/tagged-rep
 literal: slot tag ;
 
 INSN: ##set-slot
-use: src/int-rep obj/int-rep slot/int-rep ;
+use: src/tagged-rep obj/tagged-rep slot/tagged-rep ;
 
 INSN: ##set-slot-imm
-use: src/int-rep obj/int-rep
+use: src/tagged-rep obj/tagged-rep
 literal: slot tag ;
 
 ! String element access
 INSN: ##string-nth
-def: dst/int-rep
+def: dst/tagged-rep
-use: obj/int-rep index/int-rep
+use: obj/tagged-rep index/tagged-rep
 temp: temp/int-rep ;
 
 INSN: ##set-string-nth-fast
-use: src/int-rep obj/int-rep index/int-rep
+use: src/tagged-rep obj/tagged-rep index/tagged-rep
 temp: temp/int-rep ;
 
 PURE-INSN: ##copy
@@ -102,105 +102,105 @@ literal: rep ;
 
 ! Integer arithmetic
 PURE-INSN: ##add
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##add-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##sub
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##sub-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##mul
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##mul-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##and
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##and-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##or
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##or-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##xor
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##xor-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##shl
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##shl-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##shr
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##shr-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##sar
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##sar-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2 ;
 
 PURE-INSN: ##min
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##max
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 PURE-INSN: ##not
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep ;
+use: src/tagged-rep ;
 
 PURE-INSN: ##neg
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep ;
+use: src/tagged-rep ;
 
 PURE-INSN: ##log2
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep ;
+use: src/tagged-rep ;
 
 ! Float arithmetic
 PURE-INSN: ##add-float
@@ -253,12 +253,12 @@ use: src/double-rep ;
 
 ! Float/integer conversion
 PURE-INSN: ##float>integer
-def: dst/int-rep
+def: dst/tagged-rep
 use: src/double-rep ;
 
 PURE-INSN: ##integer>float
 def: dst/double-rep
-use: src/int-rep ;
+use: src/tagged-rep ;
 
 ! SIMD operations
 PURE-INSN: ##zero-vector
@@ -340,7 +340,7 @@ use: src1 src2
 literal: rep cc ;
 
 PURE-INSN: ##test-vector
-def: dst/int-rep
+def: dst/tagged-rep
 use: src1
 temp: temp/int-rep
 literal: rep vcc ;
@@ -508,13 +508,13 @@ literal: rep ;
 
 ! Scalar/vector conversion
 PURE-INSN: ##scalar>integer
-def: dst/int-rep
+def: dst/tagged-rep
 use: src
 literal: rep ;
 
 PURE-INSN: ##integer>scalar
 def: dst
-use: src/int-rep
+use: src/tagged-rep
 literal: rep ;
 
 PURE-INSN: ##vector>scalar
@@ -529,26 +529,26 @@ literal: rep ;
 
 ! Boxing and unboxing aliens
 PURE-INSN: ##box-alien
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 temp: temp/int-rep ;
 
 PURE-INSN: ##box-displaced-alien
-def: dst/int-rep
+def: dst/tagged-rep
-use: displacement/int-rep base/int-rep
+use: displacement/tagged-rep base/tagged-rep
 temp: temp/int-rep
 literal: base-class ;
 
 PURE-INSN: ##unbox-any-c-ptr
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep ;
+use: src/tagged-rep ;
 
 : ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
 : ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;
 
 PURE-INSN: ##unbox-alien
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep ;
+use: src/tagged-rep ;
 
 : ##unbox-c-ptr ( dst src class -- )
     {
@@ -560,116 +560,116 @@ use: src/int-rep ;
 
 ! Alien accessors
 INSN: ##alien-unsigned-1
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-unsigned-2
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-unsigned-4
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-signed-1
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-signed-2
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-signed-4
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-cell
-def: dst/int-rep
+def: dst/tagged-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-float
 def: dst/float-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-double
 def: dst/double-rep
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 INSN: ##alien-vector
 def: dst
-use: src/int-rep
+use: src/tagged-rep
 literal: offset rep ;
 
 INSN: ##set-alien-integer-1
-use: src/int-rep
+use: src/tagged-rep
 literal: offset
-use: value/int-rep ;
+use: value/tagged-rep ;
 
 INSN: ##set-alien-integer-2
-use: src/int-rep
+use: src/tagged-rep
 literal: offset
-use: value/int-rep ;
+use: value/tagged-rep ;
 
 INSN: ##set-alien-integer-4
-use: src/int-rep
+use: src/tagged-rep
 literal: offset
-use: value/int-rep ;
+use: value/tagged-rep ;
 
 INSN: ##set-alien-cell
-use: src/int-rep
+use: src/tagged-rep
 literal: offset
-use: value/int-rep ;
+use: value/tagged-rep ;
 
 INSN: ##set-alien-float
-use: src/int-rep
+use: src/tagged-rep
 literal: offset
 use: value/float-rep ;
 
 INSN: ##set-alien-double
-use: src/int-rep
+use: src/tagged-rep
 literal: offset
 use: value/double-rep ;
 
 INSN: ##set-alien-vector
-use: src/int-rep
+use: src/tagged-rep
 literal: offset
 use: value
 literal: rep ;
 
 ! Memory allocation
 INSN: ##allot
-def: dst/int-rep
+def: dst/tagged-rep
 literal: size class
 temp: temp/int-rep ;
 
 INSN: ##write-barrier
-use: src/int-rep slot/int-rep
+use: src/tagged-rep slot/tagged-rep
 temp: temp1/int-rep temp2/int-rep ;
 
 INSN: ##write-barrier-imm
-use: src/int-rep
+use: src/tagged-rep
 literal: slot
 temp: temp1/int-rep temp2/int-rep ;
 
 INSN: ##alien-global
-def: dst/int-rep
+def: dst/tagged-rep
 literal: symbol library ;
 
 INSN: ##vm-field
-def: dst/int-rep
+def: dst/tagged-rep
 literal: offset ;
 
 INSN: ##set-vm-field
-use: src/int-rep
+use: src/tagged-rep
 literal: offset ;
 
 ! FFI
@@ -697,23 +697,23 @@ literal: inputs ;
 
 ! Conditionals
 INSN: ##compare-branch
-use: src1/int-rep src2/int-rep
+use: src1/tagged-rep src2/tagged-rep
 literal: cc ;
 
 INSN: ##compare-imm-branch
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2
 literal: cc ;
 
 PURE-INSN: ##compare
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep
+use: src1/tagged-rep src2/tagged-rep
 literal: cc
 temp: temp/int-rep ;
 
 PURE-INSN: ##compare-imm
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2
 literal: cc
 temp: temp/int-rep ;
@@ -727,29 +727,29 @@ use: src1/double-rep src2/double-rep
 literal: cc ;
 
 PURE-INSN: ##compare-float-ordered
-def: dst/int-rep
+def: dst/tagged-rep
 use: src1/double-rep src2/double-rep
 literal: cc
 temp: temp/int-rep ;
 
 PURE-INSN: ##compare-float-unordered
-def: dst/int-rep
+def: dst/tagged-rep
 use: src1/double-rep src2/double-rep
 literal: cc
 temp: temp/int-rep ;
 
 ! Overflowing arithmetic
 INSN: ##fixnum-add
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 INSN: ##fixnum-sub
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 INSN: ##fixnum-mul
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 INSN: ##gc
 temp: temp1/int-rep temp2/int-rep
@@ -774,7 +774,7 @@ literal: label ;
 INSN: _loop-entry ;
 
 INSN: _dispatch
-use: src/int-rep
+use: src/tagged-rep
 temp: temp ;
 
 INSN: _dispatch-label
@@ -782,40 +782,40 @@ literal: label ;
 
 INSN: _compare-branch
 literal: label
-use: src1/int-rep src2/int-rep
+use: src1/tagged-rep src2/tagged-rep
 literal: cc ;
 
 INSN: _compare-imm-branch
 literal: label
-use: src1/int-rep
+use: src1/tagged-rep
 constant: src2
 literal: cc ;
 
 INSN: _compare-float-unordered-branch
 literal: label
-use: src1/int-rep src2/int-rep
+use: src1/tagged-rep src2/tagged-rep
 literal: cc ;
 
 INSN: _compare-float-ordered-branch
 literal: label
-use: src1/int-rep src2/int-rep
+use: src1/tagged-rep src2/tagged-rep
 literal: cc ;
 
 ! Overflowing arithmetic
 INSN: _fixnum-add
 literal: label
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 INSN: _fixnum-sub
 literal: label
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 INSN: _fixnum-mul
 literal: label
-def: dst/int-rep
+def: dst/tagged-rep
-use: src1/int-rep src2/int-rep ;
+use: src1/tagged-rep src2/tagged-rep ;
 
 TUPLE: spill-slot { n integer } ;
 C: <spill-slot> spill-slot

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

@@ -121,10 +121,10 @@ M: vreg-insn assign-registers-in-insn
 : 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-of int-rep eq? ] { } assoc-filter-as values ;
+    [ drop rep-of tagged-rep eq? ] { } assoc-filter-as values ;
 
 : spill-on-gc? ( vreg reg -- ? )
-    [ rep-of int-rep? not ] [ spill-slot? not ] bi* and ;
+    [ rep-of tagged-rep? not ] [ spill-slot? not ] bi* and ;
 
 : spill-on-gc ( assoc -- assoc' )
     ! When a GC occurs, virtual registers which contain untagged data,

basis/compiler/cfg/representations/conversion/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/compiler/cfg/representations/conversion/conversion.factor

@@ -0,0 +1,75 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays byte-arrays combinators compiler.cfg.instructions
+compiler.cfg.registers compiler.constants cpu.architecture
+kernel layouts locals math namespaces ;
+IN: compiler.cfg.representations.conversion
+
+ERROR: bad-conversion dst src dst-rep src-rep ;
+
+GENERIC: emit-box ( dst src rep -- )
+GENERIC: emit-unbox ( dst src rep -- )
+
+M: int-rep emit-box ( dst src rep -- )
+    drop tag-bits get ##shl-imm ;
+
+M: int-rep emit-unbox ( dst src rep -- )
+    drop tag-bits get ##sar-imm ;
+
+M:: float-rep emit-box ( dst src rep -- )
+    double-rep next-vreg-rep :> temp
+    temp src ##single>double-float
+    dst temp double-rep emit-box ;
+
+M:: float-rep emit-unbox ( dst src rep -- )
+    double-rep next-vreg-rep :> temp
+    temp src double-rep emit-unbox
+    dst temp ##double>single-float ;
+
+M: double-rep emit-box
+    drop
+    [ drop 16 float tagged-rep next-vreg-rep ##allot ]
+    [ float-offset swap ##set-alien-double ]
+    2bi ;
+
+M: double-rep emit-unbox
+    drop float-offset ##alien-double ;
+
+M:: vector-rep emit-box ( dst src rep -- )
+    tagged-rep next-vreg-rep :> temp
+    dst 16 2 cells + byte-array tagged-rep next-vreg-rep ##allot
+    temp 16 tag-fixnum ##load-immediate
+    temp dst 1 byte-array type-number ##set-slot-imm
+    dst byte-array-offset src rep ##set-alien-vector ;
+
+M: vector-rep emit-unbox
+    [ byte-array-offset ] dip ##alien-vector ;
+
+M:: scalar-rep emit-box ( dst src rep -- )
+    tagged-rep next-vreg-rep :> temp
+    temp src rep ##scalar>integer
+    dst temp int-rep emit-box ;
+
+M:: scalar-rep emit-unbox ( dst src rep -- )
+    tagged-rep next-vreg-rep :> temp
+    temp src int-rep emit-unbox
+    dst temp rep ##integer>scalar ;
+
+: emit-conversion ( dst src dst-rep src-rep -- )
+    {
+        { [ 2dup eq? ] [ drop ##copy ] }
+        { [ dup tagged-rep eq? ] [ drop emit-unbox ] }
+        { [ over tagged-rep eq? ] [ nip emit-box ] }
+        [
+            2dup 2array {
+                { { double-rep float-rep } [ 2drop ##single>double-float ] }
+                { { float-rep double-rep } [ 2drop ##double>single-float ] }
+                ! Punning SIMD vector types? Naughty naughty! But
+                ! it is allowed... otherwise bail out.
+                [
+                    drop 2dup [ reg-class-of ] bi@ eq?
+                    [ drop ##copy ] [ bad-conversion ] if
+                ]
+            } case
+        ]
+    } cond ;

basis/compiler/cfg/representations/representations.factor

@@ -1,365 +1,13 @@
 ! Copyright (C) 2009, 2010 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel fry accessors sequences assocs sets namespaces
+USING: accessors combinators compiler.cfg
-arrays combinators combinators.short-circuit math make locals
+compiler.cfg.loop-detection compiler.cfg.registers
-deques dlists layouts byte-arrays cpu.architecture
+compiler.cfg.representations.rewrite
-compiler.utilities
+compiler.cfg.representations.selection namespaces ;
-compiler.constants
-compiler.cfg
-compiler.cfg.rpo
-compiler.cfg.hats
-compiler.cfg.registers
-compiler.cfg.instructions
-compiler.cfg.def-use
-compiler.cfg.utilities
-compiler.cfg.loop-detection
-compiler.cfg.renaming.functor
-compiler.cfg.representations.preferred ;
-FROM: namespaces => set ;
 IN: compiler.cfg.representations
 
 ! Virtual register representation selection.
 
-ERROR: bad-conversion dst src dst-rep src-rep ;
-
-GENERIC: emit-box ( dst src rep -- )
-GENERIC: emit-unbox ( dst src rep -- )
-
-M:: float-rep emit-box ( dst src rep -- )
-    double-rep next-vreg-rep :> temp
-    temp src ##single>double-float
-    dst temp double-rep emit-box ;
-
-M:: float-rep emit-unbox ( dst src rep -- )
-    double-rep next-vreg-rep :> temp
-    temp src double-rep emit-unbox
-    dst temp ##double>single-float ;
-
-M: double-rep emit-box
-    drop
-    [ drop 16 float int-rep next-vreg-rep ##allot ]
-    [ float-offset swap ##set-alien-double ]
-    2bi ;
-
-M: double-rep emit-unbox
-    drop float-offset ##alien-double ;
-
-M:: vector-rep emit-box ( dst src rep -- )
-    int-rep next-vreg-rep :> temp
-    dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
-    temp 16 tag-fixnum ##load-immediate
-    temp dst 1 byte-array type-number ##set-slot-imm
-    dst byte-array-offset src rep ##set-alien-vector ;
-
-M: vector-rep emit-unbox
-    [ byte-array-offset ] dip ##alien-vector ;
-
-M:: scalar-rep emit-box ( dst src rep -- )
-    int-rep next-vreg-rep :> temp
-    temp src rep ##scalar>integer
-    dst temp tag-bits get ##shl-imm ;
-
-M:: scalar-rep emit-unbox ( dst src rep -- )
-    int-rep next-vreg-rep :> temp
-    temp src tag-bits get ##sar-imm
-    dst temp rep ##integer>scalar ;
-
-: emit-conversion ( dst src dst-rep src-rep -- )
-    {
-        { [ 2dup eq? ] [ drop ##copy ] }
-        { [ dup int-rep eq? ] [ drop emit-unbox ] }
-        { [ over int-rep eq? ] [ nip emit-box ] }
-        [
-            2dup 2array {
-                { { double-rep float-rep } [ 2drop ##single>double-float ] }
-                { { float-rep double-rep } [ 2drop ##double>single-float ] }
-                ! Punning SIMD vector types? Naughty naughty! But
-                ! it is allowed... otherwise bail out.
-                [
-                    drop 2dup [ reg-class-of ] bi@ eq?
-                    [ drop ##copy ] [ bad-conversion ] if
-                ]
-            } case
-        ]
-    } cond ;
-
-<PRIVATE
-
-! For every vreg, compute possible representations.
-SYMBOL: possibilities
-
-: possible ( vreg -- reps ) possibilities get at ;
-
-: compute-possibilities ( cfg -- )
-    H{ } clone [ '[ swap _ adjoin-at ] with-vreg-reps ] keep
-    [ members ] assoc-map possibilities set ;
-
-! Compute vregs which must remain tagged for their lifetime.
-SYMBOL: always-boxed
-
-:: (compute-always-boxed) ( vreg rep assoc -- )
-    rep int-rep eq? [
-        int-rep vreg assoc set-at
-    ] when ;
-
-: compute-always-boxed ( cfg -- assoc )
-    H{ } clone [
-        '[
-            [
-                dup [ ##load-reference? ] [ ##load-constant? ] bi or
-                [ drop ] [ [ _ (compute-always-boxed) ] each-def-rep ] if
-            ] each-non-phi
-        ] each-basic-block
-    ] keep ;
-
-! For every vreg, compute the cost of keeping it in every possible
-! representation.
-
-! Cost map maps vreg to representation to cost.
-SYMBOL: costs
-
-: init-costs ( -- )
-    possibilities get [ drop H{ } clone ] assoc-map costs set ;
-
-: record-possibility ( rep vreg -- )
-    costs get at [ 0 or ] change-at ;
-
-: increase-cost ( rep vreg -- )
-    ! Increase cost of keeping vreg in rep, making a choice of rep less
-    ! likely.
-    costs get at [ 0 or basic-block get loop-nesting-at 1 + + ] change-at ;
-
-: maybe-increase-cost ( possible vreg preferred -- )
-    pick eq? [ record-possibility ] [ increase-cost ] if ;
-
-: representation-cost ( vreg preferred -- )
-    ! 'preferred' is a representation that the instruction can accept with no cost.
-    ! So, for each representation that's not preferred, increase the cost of keeping
-    ! the vreg in that representation.
-    [ drop possible ]
-    [ '[ _ _ maybe-increase-cost ] ]
-    2bi each ;
-
-GENERIC: compute-insn-costs ( insn -- )
-
-M: ##load-constant compute-insn-costs
-    ! There's no cost to unboxing the result of a ##load-constant
-    drop ;
-
-M: insn compute-insn-costs [ representation-cost ] each-rep ;
-
-: compute-costs ( cfg -- costs )
-    init-costs
-    [
-        [ basic-block set ]
-        [
-            [
-                compute-insn-costs
-            ] each-non-phi
-        ] bi
-    ] each-basic-block
-    costs get ;
-
-! For every vreg, compute preferred representation, that minimizes costs.
-: minimize-costs ( costs -- representations )
-    [ nip assoc-empty? not ] assoc-filter
-    [ >alist alist-min first ] assoc-map ;
-
-: compute-representations ( cfg -- )
-    [ compute-costs minimize-costs ]
-    [ compute-always-boxed ]
-    bi assoc-union
-    representations set ;
-
-! PHI nodes require special treatment
-! If the output of a phi instruction is only used as the input to another
-! phi instruction, then we want to use the same representation for both
-! if possible.
-SYMBOL: phis
-
-: collect-phis ( cfg -- )
-    H{ } clone phis set
-    [
-        phis get
-        '[ [ inputs>> values ] [ dst>> ] bi _ set-at ] each-phi
-    ] each-basic-block ;
-
-SYMBOL: work-list
-
-: add-to-work-list ( vregs -- )
-    work-list get push-all-front ;
-
-: rep-assigned ( vregs -- vregs' )
-    representations get '[ _ key? ] filter ;
-
-: rep-not-assigned ( vregs -- vregs' )
-    representations get '[ _ key? not ] filter ;
-
-: add-ready-phis ( -- )
-    phis get keys rep-assigned add-to-work-list ;
-
-: process-phi ( dst -- )
-    ! If dst = phi(src1,src2,...) and dst's representation has been
-    ! determined, assign that representation to each one of src1,...
-    ! that does not have a representation yet, and process those, too.
-    dup phis get at* [
-        [ rep-of ] [ rep-not-assigned ] bi*
-        [ [ set-rep-of ] with each ] [ add-to-work-list ] bi
-    ] [ 2drop ] if ;
-
-: remaining-phis ( -- )
-    phis get keys rep-not-assigned { } assert-sequence= ;
-
-: process-phis ( -- )
-    <hashed-dlist> work-list set
-    add-ready-phis
-    work-list get [ process-phi ] slurp-deque
-    remaining-phis ;
-
-: compute-phi-representations ( cfg -- )
-    collect-phis process-phis ;
-
-! Insert conversions. This introduces new temporaries, so we need
-! to rename opearands too.
-
-! Mapping from vreg,rep pairs to vregs
-SYMBOL: alternatives
-
-:: emit-def-conversion ( dst preferred required -- new-dst' )
-    ! If an instruction defines a register with representation 'required',
-    ! but the register has preferred representation 'preferred', then
-    ! we rename the instruction's definition to a new register, which
-    ! becomes the input of a conversion instruction.
-    dst required next-vreg-rep [ preferred required emit-conversion ] keep ;
-
-:: emit-use-conversion ( src preferred required -- new-src' )
-    ! If an instruction uses a register with representation 'required',
-    ! but the register has preferred representation 'preferred', then
-    ! we rename the instruction's input to a new register, which
-    ! becomes the output of a conversion instruction.
-    preferred required eq? [ src ] [
-        src required alternatives get [
-            required next-vreg-rep :> new-src
-            [ new-src ] 2dip preferred emit-conversion
-            new-src
-        ] 2cache
-    ] if ;
-
-SYMBOLS: renaming-set needs-renaming? ;
-
-: init-renaming-set ( -- )
-    needs-renaming? off
-    V{ } clone renaming-set set ;
-
-: no-renaming ( vreg -- )
-    dup 2array renaming-set get push ;
-
-: record-renaming ( from to -- )
-    2array renaming-set get push needs-renaming? on ;
-
-:: (compute-renaming-set) ( vreg required quot: ( vreg preferred required -- new-vreg ) -- )
-    vreg rep-of :> preferred
-    preferred required eq?
-    [ vreg no-renaming ]
-    [ vreg vreg preferred required quot call record-renaming ] if ; inline
-
-: compute-renaming-set ( insn -- )
-    ! temp vregs don't need conversions since they're always in their
-    ! preferred representation
-    init-renaming-set
-    [ [ [ emit-use-conversion ] (compute-renaming-set) ] each-use-rep ]
-    [ , ]
-    [ [ [ emit-def-conversion ] (compute-renaming-set) ] each-def-rep ]
-    tri ;
-
-: converted-value ( vreg -- vreg' )
-    renaming-set get pop first2 [ assert= ] dip ;
-
-RENAMING: convert [ converted-value ] [ converted-value ] [ ]
-
-: perform-renaming ( insn -- )
-    needs-renaming? get [
-        renaming-set get reverse! drop
-        [ convert-insn-uses ] [ convert-insn-defs ] bi
-        renaming-set get length 0 assert=
-    ] [ drop ] if ;
-
-GENERIC: conversions-for-insn ( insn -- )
-
-M: ##phi conversions-for-insn , ;
-
-! When a float is unboxed, we replace the ##load-constant with a ##load-double
-! if the architecture supports it
-: convert-to-load-double? ( insn -- ? )
-    {
-        [ drop load-double? ]
-        [ dst>> rep-of double-rep? ]
-        [ obj>> float? ]
-    } 1&& ;
-
-! When a literal zeroes/ones vector is unboxed, we replace the ##load-reference
-! with a ##zero-vector or ##fill-vector instruction since this is more efficient.
-: convert-to-zero-vector? ( insn -- ? )
-    {
-        [ dst>> rep-of vector-rep? ]
-        [ obj>> B{ 0 0 0 0  0 0 0 0  0 0 0 0  0 0 0 0 } = ]
-    } 1&& ;
-
-: convert-to-fill-vector? ( insn -- ? )
-    {
-        [ dst>> rep-of vector-rep? ]
-        [ obj>> B{ 255 255 255 255  255 255 255 255  255 255 255 255  255 255 255 255 } = ]
-    } 1&& ;
-
-: (convert-to-load-double) ( insn -- dst val )
-    [ dst>> ] [ obj>> ] bi ; inline
-
-: (convert-to-zero/fill-vector) ( insn -- dst rep )
-    dst>> dup rep-of ; inline
-
-: conversions-for-load-insn ( insn -- ?insn )
-    {
-        {
-            [ dup convert-to-load-double? ]
-            [ (convert-to-load-double) ##load-double f ]
-        }
-        {
-            [ dup convert-to-zero-vector? ]
-            [ (convert-to-zero/fill-vector) ##zero-vector f ]
-        }
-        {
-            [ dup convert-to-fill-vector? ]
-            [ (convert-to-zero/fill-vector) ##fill-vector f ]
-        }
-        [ ]
-    } cond ;
-
-M: ##load-reference conversions-for-insn
-    conversions-for-load-insn [ call-next-method ] when* ;
-
-M: ##load-constant conversions-for-insn
-    conversions-for-load-insn [ call-next-method ] when* ;
-
-M: vreg-insn conversions-for-insn
-    [ compute-renaming-set ] [ perform-renaming ] bi ;
-
-M: insn conversions-for-insn , ;
-
-: conversions-for-block ( bb -- )
-    dup kill-block? [ drop ] [
-        [
-            [
-                H{ } clone alternatives set
-                [ conversions-for-insn ] each
-            ] V{ } make
-        ] change-instructions drop
-    ] if ;
-
-: insert-conversions ( cfg -- )
-    [ conversions-for-block ] each-basic-block ;
-
-PRIVATE>
-
 : select-representations ( cfg -- cfg' )
     needs-loops
 

basis/compiler/cfg/representations/rewrite/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/compiler/cfg/representations/rewrite/rewrite.factor

@@ -0,0 +1,149 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs combinators
+combinators.short-circuit compiler.cfg.instructions
+compiler.cfg.registers compiler.cfg.renaming.functor
+compiler.cfg.representations.conversion
+compiler.cfg.representations.preferred compiler.cfg.rpo
+compiler.cfg.utilities cpu.architecture kernel locals make math
+namespaces sequences ;
+IN: compiler.cfg.representations.rewrite
+
+! Insert conversions. This introduces new temporaries, so we need
+! to rename opearands too.
+
+! Mapping from vreg,rep pairs to vregs
+SYMBOL: alternatives
+
+:: emit-def-conversion ( dst preferred required -- new-dst' )
+    ! If an instruction defines a register with representation 'required',
+    ! but the register has preferred representation 'preferred', then
+    ! we rename the instruction's definition to a new register, which
+    ! becomes the input of a conversion instruction.
+    dst required next-vreg-rep [ preferred required emit-conversion ] keep ;
+
+:: emit-use-conversion ( src preferred required -- new-src' )
+    ! If an instruction uses a register with representation 'required',
+    ! but the register has preferred representation 'preferred', then
+    ! we rename the instruction's input to a new register, which
+    ! becomes the output of a conversion instruction.
+    preferred required eq? [ src ] [
+        src required alternatives get [
+            required next-vreg-rep :> new-src
+            [ new-src ] 2dip preferred emit-conversion
+            new-src
+        ] 2cache
+    ] if ;
+
+SYMBOLS: renaming-set needs-renaming? ;
+
+: init-renaming-set ( -- )
+    needs-renaming? off
+    V{ } clone renaming-set set ;
+
+: no-renaming ( vreg -- )
+    dup 2array renaming-set get push ;
+
+: record-renaming ( from to -- )
+    2array renaming-set get push needs-renaming? on ;
+
+:: (compute-renaming-set) ( vreg required quot: ( vreg preferred required -- new-vreg ) -- )
+    vreg rep-of :> preferred
+    preferred required eq?
+    [ vreg no-renaming ]
+    [ vreg vreg preferred required quot call record-renaming ] if ; inline
+
+: compute-renaming-set ( insn -- )
+    ! temp vregs don't need conversions since they're always in their
+    ! preferred representation
+    init-renaming-set
+    [ [ [ emit-use-conversion ] (compute-renaming-set) ] each-use-rep ]
+    [ , ]
+    [ [ [ emit-def-conversion ] (compute-renaming-set) ] each-def-rep ]
+    tri ;
+
+: converted-value ( vreg -- vreg' )
+    renaming-set get pop first2 [ assert= ] dip ;
+
+RENAMING: convert [ converted-value ] [ converted-value ] [ ]
+
+: perform-renaming ( insn -- )
+    needs-renaming? get [
+        renaming-set get reverse! drop
+        [ convert-insn-uses ] [ convert-insn-defs ] bi
+        renaming-set get length 0 assert=
+    ] [ drop ] if ;
+
+GENERIC: conversions-for-insn ( insn -- )
+
+M: ##phi conversions-for-insn , ;
+
+! When a float is unboxed, we replace the ##load-constant with a ##load-double
+! if the architecture supports it
+: convert-to-load-double? ( insn -- ? )
+    {
+        [ drop load-double? ]
+        [ dst>> rep-of double-rep? ]
+        [ obj>> float? ]
+    } 1&& ;
+
+! When a literal zeroes/ones vector is unboxed, we replace the ##load-reference
+! with a ##zero-vector or ##fill-vector instruction since this is more efficient.
+: convert-to-zero-vector? ( insn -- ? )
+    {
+        [ dst>> rep-of vector-rep? ]
+        [ obj>> B{ 0 0 0 0  0 0 0 0  0 0 0 0  0 0 0 0 } = ]
+    } 1&& ;
+
+: convert-to-fill-vector? ( insn -- ? )
+    {
+        [ dst>> rep-of vector-rep? ]
+        [ obj>> B{ 255 255 255 255  255 255 255 255  255 255 255 255  255 255 255 255 } = ]
+    } 1&& ;
+
+: (convert-to-load-double) ( insn -- dst val )
+    [ dst>> ] [ obj>> ] bi ; inline
+
+: (convert-to-zero/fill-vector) ( insn -- dst rep )
+    dst>> dup rep-of ; inline
+
+: conversions-for-load-insn ( insn -- ?insn )
+    {
+        {
+            [ dup convert-to-load-double? ]
+            [ (convert-to-load-double) ##load-double f ]
+        }
+        {
+            [ dup convert-to-zero-vector? ]
+            [ (convert-to-zero/fill-vector) ##zero-vector f ]
+        }
+        {
+            [ dup convert-to-fill-vector? ]
+            [ (convert-to-zero/fill-vector) ##fill-vector f ]
+        }
+        [ ]
+    } cond ;
+
+M: ##load-reference conversions-for-insn
+    conversions-for-load-insn [ call-next-method ] when* ;
+
+M: ##load-constant conversions-for-insn
+    conversions-for-load-insn [ call-next-method ] when* ;
+
+M: vreg-insn conversions-for-insn
+    [ compute-renaming-set ] [ perform-renaming ] bi ;
+
+M: insn conversions-for-insn , ;
+
+: conversions-for-block ( bb -- )
+    dup kill-block? [ drop ] [
+        [
+            [
+                H{ } clone alternatives set
+                [ conversions-for-insn ] each
+            ] V{ } make
+        ] change-instructions drop
+    ] if ;
+
+: insert-conversions ( cfg -- )
+    [ conversions-for-block ] each-basic-block ;

basis/compiler/cfg/representations/selection/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/compiler/cfg/representations/selection/selection.factor

@@ -0,0 +1,143 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs compiler.cfg compiler.cfg.instructions
+compiler.cfg.loop-detection compiler.cfg.registers
+compiler.cfg.representations.preferred compiler.cfg.rpo
+compiler.cfg.utilities compiler.utilities cpu.architecture
+deques dlists fry kernel locals math namespaces sequences sets ;
+FROM: namespaces => set ;
+IN: compiler.cfg.representations.selection
+
+! For every vreg, compute possible representations.
+SYMBOL: possibilities
+
+: possible ( vreg -- reps ) possibilities get at ;
+
+: compute-possibilities ( cfg -- )
+    H{ } clone [ '[ swap _ adjoin-at ] with-vreg-reps ] keep
+    [ members ] assoc-map possibilities set ;
+
+! Compute vregs which must remain tagged for their lifetime.
+SYMBOL: always-boxed
+
+:: (compute-always-boxed) ( vreg rep assoc -- )
+    rep tagged-rep eq? [
+        tagged-rep vreg assoc set-at
+    ] when ;
+
+: compute-always-boxed ( cfg -- assoc )
+    H{ } clone [
+        '[
+            [
+                dup [ ##load-reference? ] [ ##load-constant? ] bi or
+                [ drop ] [ [ _ (compute-always-boxed) ] each-def-rep ] if
+            ] each-non-phi
+        ] each-basic-block
+    ] keep ;
+
+! For every vreg, compute the cost of keeping it in every possible
+! representation.
+
+! Cost map maps vreg to representation to cost.
+SYMBOL: costs
+
+: init-costs ( -- )
+    possibilities get [ drop H{ } clone ] assoc-map costs set ;
+
+: record-possibility ( rep vreg -- )
+    costs get at [ 0 or ] change-at ;
+
+: increase-cost ( rep vreg -- )
+    ! Increase cost of keeping vreg in rep, making a choice of rep less
+    ! likely.
+    costs get at [ 0 or basic-block get loop-nesting-at 1 + + ] change-at ;
+
+: maybe-increase-cost ( possible vreg preferred -- )
+    pick eq? [ record-possibility ] [ increase-cost ] if ;
+
+: representation-cost ( vreg preferred -- )
+    ! 'preferred' is a representation that the instruction can accept with no cost.
+    ! So, for each representation that's not preferred, increase the cost of keeping
+    ! the vreg in that representation.
+    [ drop possible ]
+    [ '[ _ _ maybe-increase-cost ] ]
+    2bi each ;
+
+GENERIC: compute-insn-costs ( insn -- )
+
+M: ##load-constant compute-insn-costs
+    ! There's no cost to unboxing the result of a ##load-constant
+    drop ;
+
+M: insn compute-insn-costs [ representation-cost ] each-rep ;
+
+: compute-costs ( cfg -- costs )
+    init-costs
+    [
+        [ basic-block set ]
+        [
+            [
+                compute-insn-costs
+            ] each-non-phi
+        ] bi
+    ] each-basic-block
+    costs get ;
+
+! For every vreg, compute preferred representation, that minimizes costs.
+: minimize-costs ( costs -- representations )
+    [ nip assoc-empty? not ] assoc-filter
+    [ >alist alist-min first ] assoc-map ;
+
+: compute-representations ( cfg -- )
+    [ compute-costs minimize-costs ]
+    [ compute-always-boxed ]
+    bi assoc-union
+    representations set ;
+
+! PHI nodes require special treatment
+! If the output of a phi instruction is only used as the input to another
+! phi instruction, then we want to use the same representation for both
+! if possible.
+SYMBOL: phis
+
+: collect-phis ( cfg -- )
+    H{ } clone phis set
+    [
+        phis get
+        '[ [ inputs>> values ] [ dst>> ] bi _ set-at ] each-phi
+    ] each-basic-block ;
+
+SYMBOL: work-list
+
+: add-to-work-list ( vregs -- )
+    work-list get push-all-front ;
+
+: rep-assigned ( vregs -- vregs' )
+    representations get '[ _ key? ] filter ;
+
+: rep-not-assigned ( vregs -- vregs' )
+    representations get '[ _ key? not ] filter ;
+
+: add-ready-phis ( -- )
+    phis get keys rep-assigned add-to-work-list ;
+
+: process-phi ( dst -- )
+    ! If dst = phi(src1,src2,...) and dst's representation has been
+    ! determined, assign that representation to each one of src1,...
+    ! that does not have a representation yet, and process those, too.
+    dup phis get at* [
+        [ rep-of ] [ rep-not-assigned ] bi*
+        [ [ set-rep-of ] with each ] [ add-to-work-list ] bi
+    ] [ 2drop ] if ;
+
+: remaining-phis ( -- )
+    phis get keys rep-not-assigned { } assert-sequence= ;
+
+: process-phis ( -- )
+    <hashed-dlist> work-list set
+    add-ready-phis
+    work-list get [ process-phi ] slurp-deque
+    remaining-phis ;
+
+: compute-phi-representations ( cfg -- )
+    collect-phis process-phis ;

basis/compiler/cfg/save-contexts/save-contexts.factor

@@ -20,8 +20,8 @@ IN: compiler.cfg.save-contexts
 
 : insert-save-context ( bb -- )
     dup instructions>> dup needs-save-context? [
-        int-rep next-vreg-rep
+        tagged-rep next-vreg-rep
-        int-rep next-vreg-rep
+        tagged-rep next-vreg-rep
         \ ##save-context new-insn prefix
         >>instructions drop
     ] [ 2drop ] if ;

basis/cpu/ppc/ppc.factor

@@ -224,6 +224,7 @@ M:: ppc %float>integer ( dst src -- )
 M: ppc %copy ( dst src rep -- )
     2over eq? [ 3drop ] [
         {
+            { tagged-rep [ MR ] }
             { int-rep [ MR ] }
             { double-rep [ FMR ] }
         } case

basis/cpu/x86/64/64.factor

@@ -168,9 +168,7 @@ M:: x86.64 %box ( n rep func -- )
     ] [
         rep load-return-value
     ] if
-    rep int-rep?
+    rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr
-    cpu x86.64? os windows? and or
-    param-reg-1 param-reg-0 ? %mov-vm-ptr
     func f %alien-invoke ;
 
 : box-struct-field@ ( i -- operand ) 1 + cells param@ ;