compiler: Start using tagged-rep for stuff, and split up compiler.cfg.representations into several sub-vocabularies
Slava Pestov
parent
8e33230039
commit
503c0fcfde
|
|
@ -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* ;
|
||||
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
|
|||
|
||||
: insert-gc-check ( bb -- )
|
||||
dup dup '[
|
||||
int-rep next-vreg-rep
|
||||
int-rep next-vreg-rep
|
||||
tagged-rep next-vreg-rep
|
||||
tagged-rep next-vreg-rep
|
||||
_ allocation-size
|
||||
f
|
||||
f
|
||||
|
|
|
|||
|
|
@ -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
|
||||
use: obj/int-rep slot/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: obj/tagged-rep slot/tagged-rep ;
|
||||
|
||||
INSN: ##slot-imm
|
||||
def: dst/int-rep
|
||||
use: obj/int-rep
|
||||
def: dst/tagged-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
|
||||
use: obj/int-rep index/int-rep
|
||||
def: dst/tagged-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
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##add-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##sub
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##sub-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##mul
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##mul-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##and
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##and-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##or
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##or-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##xor
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##xor-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##shl
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##shl-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##shr
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##shr-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##sar
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##sar-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
constant: src2 ;
|
||||
|
||||
PURE-INSN: ##min
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##max
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##not
|
||||
def: dst/int-rep
|
||||
use: src/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##neg
|
||||
def: dst/int-rep
|
||||
use: src/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##log2
|
||||
def: dst/int-rep
|
||||
use: src/int-rep ;
|
||||
def: dst/tagged-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
|
||||
use: src/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##box-displaced-alien
|
||||
def: dst/int-rep
|
||||
use: displacement/int-rep base/int-rep
|
||||
def: dst/tagged-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
|
||||
use: src/int-rep ;
|
||||
def: dst/tagged-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
|
||||
use: src/int-rep ;
|
||||
def: dst/tagged-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
|
||||
use: src/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
INSN: ##alien-unsigned-2
|
||||
def: dst/int-rep
|
||||
use: src/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
INSN: ##alien-unsigned-4
|
||||
def: dst/int-rep
|
||||
use: src/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
INSN: ##alien-signed-1
|
||||
def: dst/int-rep
|
||||
use: src/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
INSN: ##alien-signed-2
|
||||
def: dst/int-rep
|
||||
use: src/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
INSN: ##alien-signed-4
|
||||
def: dst/int-rep
|
||||
use: src/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
INSN: ##alien-cell
|
||||
def: dst/int-rep
|
||||
use: src/int-rep
|
||||
def: dst/tagged-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
|
||||
use: src1/int-rep src2/int-rep
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep
|
||||
literal: cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##compare-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
def: dst/tagged-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
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
INSN: ##fixnum-sub
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
INSN: ##fixnum-mul
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-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
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
INSN: _fixnum-sub
|
||||
literal: label
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
INSN: _fixnum-mul
|
||||
literal: label
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep ;
|
||||
|
||||
TUPLE: spill-slot { n integer } ;
|
||||
C: <spill-slot> spill-slot
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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
|
||||
arrays combinators combinators.short-circuit math make locals
|
||||
deques dlists layouts byte-arrays cpu.architecture
|
||||
compiler.utilities
|
||||
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 ;
|
||||
USING: accessors combinators compiler.cfg
|
||||
compiler.cfg.loop-detection compiler.cfg.registers
|
||||
compiler.cfg.representations.rewrite
|
||||
compiler.cfg.representations.selection namespaces ;
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -20,8 +20,8 @@ IN: compiler.cfg.save-contexts
|
|||
|
||||
: insert-save-context ( bb -- )
|
||||
dup instructions>> dup needs-save-context? [
|
||||
int-rep next-vreg-rep
|
||||
int-rep next-vreg-rep
|
||||
tagged-rep next-vreg-rep
|
||||
tagged-rep next-vreg-rep
|
||||
\ ##save-context new-insn prefix
|
||||
>>instructions drop
|
||||
] [ 2drop ] if ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -168,9 +168,7 @@ M:: x86.64 %box ( n rep func -- )
|
|||
] [
|
||||
rep load-return-value
|
||||
] if
|
||||
rep int-rep?
|
||||
cpu x86.64? os windows? and or
|
||||
param-reg-1 param-reg-0 ? %mov-vm-ptr
|
||||
rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr
|
||||
func f %alien-invoke ;
|
||||
|
||||
: box-struct-field@ ( i -- operand ) 1 + cells param@ ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue