steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Untagged fixnums work in progress

db4
Slava Pestov 2010-04-21 02:08:52 -05:00
parent 503c0fcfde
commit 5d3a7a7362
37 changed files with 1239 additions and 1159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/compiler/cfg/alias-analysis/alias-analysis.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math namespaces assocs hashtables sequences arrays
accessors words vectors combinators combinators.short-circuit
@ -187,19 +187,12 @@ SYMBOL: heap-ac
[ kill-constant-set-slot ] 2bi
] [ nip kill-computed-set-slot ] if ;
SYMBOL: constants
: constant ( vreg -- n/f )
#! Return a ##load-immediate value, or f if the vreg was not
#! assigned by an ##load-immediate.
resolve constants get at ;
GENERIC: insn-slot# ( insn -- slot#/f )
GENERIC: insn-object ( insn -- vreg )
M: ##slot insn-slot# slot>> constant ;
M: ##slot insn-slot# drop f ;
M: ##slot-imm insn-slot# slot>> ;
M: ##set-slot insn-slot# slot>> constant ;
M: ##set-slot insn-slot# drop f ;
M: ##set-slot-imm insn-slot# slot>> ;
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
M: ##vm-field insn-slot# offset>> ;
@ -218,7 +211,6 @@ M: ##set-vm-field insn-object drop \ ##vm-field ;
H{ } clone vregs>acs set
H{ } clone acs>vregs set
H{ } clone live-slots set
H{ } clone constants set
H{ } clone copies set
0 ac-counter set
@ -245,10 +237,6 @@ M: insn analyze-aliases*
M: ##phi analyze-aliases*
dup defs-vreg set-heap-ac ;
M: ##load-immediate analyze-aliases*
call-next-method
dup [ val>> ] [ dst>> ] bi constants get set-at ;
M: ##allocation analyze-aliases*
#! A freshly allocated object is distinct from any other
#! object.
@ -287,7 +275,7 @@ M: ##copy analyze-aliases*
M: ##compare analyze-aliases*
call-next-method
dup useless-compare? [
dst>> f \ ##load-constant new-insn
dst>> f \ ##load-reference new-insn
analyze-aliases*
] when ;

24
basis/compiler/cfg/dce/dce-tests.factor
View File

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

27
basis/compiler/cfg/hats/hats.factor
View File

@ -41,21 +41,22 @@ insn-classes get [
>>
: immutable? ( obj -- ? )
{ [ float? ] [ word? ] [ not ] } 1|| ; inline
: ^^load-literal ( obj -- dst )
[ next-vreg dup ] dip {
{ [ dup fixnum? ] [ tag-fixnum ##load-immediate ] }
{ [ dup immutable? ] [ ##load-constant ] }
[ ##load-reference ]
} cond ;
dup fixnum? [ ^^load-integer ] [ ^^load-reference ] if ;
: ^^offset>slot ( slot -- vreg' )
cell 4 = 2 1 ? ^^shr-imm ;
cell 4 = 2 3 ? ^^shl-imm ;
: ^^tag-fixnum ( src -- dst )
tag-bits get ^^shl-imm ;
: ^^unbox-f ( src -- dst )
drop 0 ^^load-literal ;
: ^^untag-fixnum ( src -- dst )
tag-bits get ^^sar-imm ;
: ^^unbox-byte-array ( src -- dst )
^^tagged>integer byte-array-offset ^^add-imm ;
: ^^unbox-c-ptr ( src class -- dst )
{
{ [ dup \ f class<= ] [ drop ^^unbox-f ] }
{ [ dup alien class<= ] [ drop ^^unbox-alien ] }
{ [ dup byte-array class<= ] [ drop ^^unbox-byte-array ] }
[ drop ^^unbox-any-c-ptr ]
} cond ;

216
basis/compiler/cfg/instructions/instructions.factor
View File

@ -20,23 +20,25 @@ TUPLE: insn ;
! value numbering
TUPLE: pure-insn < insn ;
! Stack operations
INSN: ##load-immediate
def: dst/tagged-rep
! Constants
INSN: ##load-integer
def: dst/int-rep
constant: val ;
INSN: ##load-reference
def: dst/tagged-rep
constant: obj ;
INSN: ##load-constant
! These two are inserted by representation selection
INSN: ##load-tagged
def: dst/tagged-rep
constant: obj ;
constant: val ;
INSN: ##load-double
def: dst/double-rep
constant: val ;
! Stack operations
INSN: ##peek
def: dst/tagged-rep
literal: loc ;
@ -65,13 +67,13 @@ INSN: ##no-tco ;
! Jump tables
INSN: ##dispatch
use: src/tagged-rep
use: src/int-rep
temp: temp/int-rep ;
! Slot access
INSN: ##slot
def: dst/tagged-rep
use: obj/tagged-rep slot/tagged-rep ;
use: obj/tagged-rep slot/int-rep ;
INSN: ##slot-imm
def: dst/tagged-rep
@ -79,7 +81,7 @@ use: obj/tagged-rep
literal: slot tag ;
INSN: ##set-slot
use: src/tagged-rep obj/tagged-rep slot/tagged-rep ;
use: src/tagged-rep obj/tagged-rep slot/int-rep ;
INSN: ##set-slot-imm
use: src/tagged-rep obj/tagged-rep
@ -87,120 +89,125 @@ literal: slot tag ;
! String element access
INSN: ##string-nth
def: dst/tagged-rep
use: obj/tagged-rep index/tagged-rep
def: dst/int-rep
use: obj/tagged-rep index/int-rep
temp: temp/int-rep ;
INSN: ##set-string-nth-fast
use: src/tagged-rep obj/tagged-rep index/tagged-rep
use: src/int-rep obj/tagged-rep index/int-rep
temp: temp/int-rep ;
! Register transfers
PURE-INSN: ##copy
def: dst
use: src
literal: rep ;
PURE-INSN: ##tagged>integer
def: dst/int-rep
use: src/tagged-rep ;
! Integer arithmetic
PURE-INSN: ##add
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##add-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##sub
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##sub-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##mul
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##mul-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##and
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##and-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##or
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##or-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##xor
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##xor-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##shl
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##shl-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##shr
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##shr-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##sar
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##sar-imm
def: dst/tagged-rep
use: src1/tagged-rep
def: dst/int-rep
use: src1/int-rep
constant: src2 ;
PURE-INSN: ##min
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##max
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
PURE-INSN: ##not
def: dst/tagged-rep
use: src/tagged-rep ;
def: dst/int-rep
use: src/int-rep ;
PURE-INSN: ##neg
def: dst/tagged-rep
use: src/tagged-rep ;
def: dst/int-rep
use: src/int-rep ;
PURE-INSN: ##log2
def: dst/tagged-rep
use: src/tagged-rep ;
def: dst/int-rep
use: src/int-rep ;
! Float arithmetic
PURE-INSN: ##add-float
@ -253,12 +260,12 @@ use: src/double-rep ;
! Float/integer conversion
PURE-INSN: ##float>integer
def: dst/tagged-rep
def: dst/int-rep
use: src/double-rep ;
PURE-INSN: ##integer>float
def: dst/double-rep
use: src/tagged-rep ;
use: src/int-rep ;
! SIMD operations
PURE-INSN: ##zero-vector
@ -508,13 +515,13 @@ literal: rep ;
! Scalar/vector conversion
PURE-INSN: ##scalar>integer
def: dst/tagged-rep
def: dst/int-rep
use: src
literal: rep ;
PURE-INSN: ##integer>scalar
def: dst
use: src/tagged-rep
use: src/int-rep
literal: rep ;
PURE-INSN: ##vector>scalar
@ -530,117 +537,106 @@ literal: rep ;
! Boxing and unboxing aliens
PURE-INSN: ##box-alien
def: dst/tagged-rep
use: src/tagged-rep
use: src/int-rep
temp: temp/int-rep ;
PURE-INSN: ##box-displaced-alien
def: dst/tagged-rep
use: displacement/tagged-rep base/tagged-rep
use: displacement/int-rep base/int-rep
temp: temp/int-rep
literal: base-class ;
PURE-INSN: ##unbox-any-c-ptr
def: dst/tagged-rep
def: dst/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/tagged-rep
def: dst/int-rep
use: src/tagged-rep ;
: ##unbox-c-ptr ( dst src class -- )
{
{ [ dup \ f class<= ] [ drop ##unbox-f ] }
{ [ dup alien class<= ] [ drop ##unbox-alien ] }
{ [ dup byte-array class<= ] [ drop ##unbox-byte-array ] }
[ drop ##unbox-any-c-ptr ]
} cond ;
! Alien accessors
INSN: ##alien-unsigned-1
def: dst/tagged-rep
use: src/tagged-rep
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-unsigned-2
def: dst/tagged-rep
use: src/tagged-rep
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-unsigned-4
def: dst/tagged-rep
use: src/tagged-rep
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-signed-1
def: dst/tagged-rep
use: src/tagged-rep
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-signed-2
def: dst/tagged-rep
use: src/tagged-rep
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-signed-4
def: dst/tagged-rep
use: src/tagged-rep
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-cell
def: dst/tagged-rep
use: src/tagged-rep
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-float
def: dst/float-rep
use: src/tagged-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-double
def: dst/double-rep
use: src/tagged-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-vector
def: dst
use: src/tagged-rep
use: src/int-rep
literal: offset rep ;
INSN: ##set-alien-integer-1
use: src/tagged-rep
use: src/int-rep
literal: offset
use: value/tagged-rep ;
use: value/int-rep ;
INSN: ##set-alien-integer-2
use: src/tagged-rep
use: src/int-rep
literal: offset
use: value/tagged-rep ;
use: value/int-rep ;
INSN: ##set-alien-integer-4
use: src/tagged-rep
use: src/int-rep
literal: offset
use: value/tagged-rep ;
use: value/int-rep ;
INSN: ##set-alien-cell
use: src/tagged-rep
use: src/int-rep
literal: offset
use: value/tagged-rep ;
use: value/int-rep ;
INSN: ##set-alien-float
use: src/tagged-rep
use: src/int-rep
literal: offset
use: value/float-rep ;
INSN: ##set-alien-double
use: src/tagged-rep
use: src/int-rep
literal: offset
use: value/double-rep ;
INSN: ##set-alien-vector
use: src/tagged-rep
use: src/int-rep
literal: offset
use: value
literal: rep ;
@ -652,7 +648,7 @@ literal: size class
temp: temp/int-rep ;
INSN: ##write-barrier
use: src/tagged-rep slot/tagged-rep
use: src/tagged-rep slot/int-rep
temp: temp1/int-rep temp2/int-rep ;
INSN: ##write-barrier-imm
@ -661,7 +657,7 @@ literal: slot
temp: temp1/int-rep temp2/int-rep ;
INSN: ##alien-global
def: dst/tagged-rep
def: dst/int-rep
literal: symbol library ;
INSN: ##vm-field
@ -669,7 +665,7 @@ def: dst/tagged-rep
literal: offset ;
INSN: ##set-vm-field
use: src/tagged-rep
use: src/int-rep
literal: offset ;
! FFI
@ -749,7 +745,7 @@ use: src1/tagged-rep src2/tagged-rep ;
INSN: ##fixnum-mul
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
use: src1/tagged-rep src2/int-rep ;
INSN: ##gc
temp: temp1/int-rep temp2/int-rep
@ -774,7 +770,7 @@ literal: label ;
INSN: _loop-entry ;
INSN: _dispatch
use: src/tagged-rep
use: src/int-rep
temp: temp ;
INSN: _dispatch-label
@ -815,7 +811,7 @@ use: src1/tagged-rep src2/tagged-rep ;
INSN: _fixnum-mul
literal: label
def: dst/tagged-rep
use: src1/tagged-rep src2/tagged-rep ;
use: src1/tagged-rep src2/int-rep ;
TUPLE: spill-slot { n integer } ;
C: <spill-slot> spill-slot

12
basis/compiler/cfg/instructions/syntax/syntax.factor
View File

@ -37,17 +37,17 @@ TUPLE: insn-slot-spec type name rep ;
] reduce drop
] { } make ;
: insn-def-slot ( class -- slot/f )
"insn-slots" word-prop
: find-def-slot ( slots -- slot/f )
[ type>> def eq? ] find nip ;
: insn-def-slot ( class -- slot/f )
"insn-slots" word-prop find-def-slot ;
: insn-use-slots ( class -- slots )
"insn-slots" word-prop
[ type>> use eq? ] filter ;
"insn-slots" word-prop [ type>> use eq? ] filter ;
: insn-temp-slots ( class -- slots )
"insn-slots" word-prop
[ type>> temp eq? ] filter ;
"insn-slots" word-prop [ type>> temp eq? ] filter ;
! We cannot reference words in compiler.cfg.instructions directly
! since that would create circularity.

24
basis/compiler/cfg/intrinsics/alien/alien.factor
View File

@ -16,7 +16,7 @@ IN: compiler.cfg.intrinsics.alien
: emit-<displaced-alien> ( node -- )
dup emit-<displaced-alien>? [
[ 2inputs [ ^^untag-fixnum ] dip ] dip
[ 2inputs ] dip
node-input-infos second class>>
^^box-displaced-alien ds-push
] [ emit-primitive ] if ;
@ -32,11 +32,8 @@ IN: compiler.cfg.intrinsics.alien
[ second class>> fixnum class<= ]
bi and ;
: ^^unbox-c-ptr ( src class -- dst )
[ next-vreg dup ] 2dip ##unbox-c-ptr ;
: prepare-alien-accessor ( info -- ptr-vreg offset )
class>> [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add 0 ;
class>> [ 2inputs swap ] dip ^^unbox-c-ptr ^^add 0 ;
: prepare-alien-getter ( infos -- ptr-vreg offset )
first prepare-alien-accessor ;
@ -54,8 +51,8 @@ IN: compiler.cfg.intrinsics.alien
: prepare-alien-setter ( infos -- ptr-vreg offset )
second prepare-alien-accessor ;
: inline-alien-integer-setter ( node quot -- )
'[ prepare-alien-setter ds-pop ^^untag-fixnum @ ]
: inline-alien-setter ( node quot -- )
'[ prepare-alien-setter ds-pop @ ]
[ fixnum inline-alien-setter? ]
inline-alien ; inline
@ -64,18 +61,13 @@ IN: compiler.cfg.intrinsics.alien
[ pinned-c-ptr inline-alien-setter? ]
inline-alien ; inline
: inline-alien-float-setter ( node quot -- )
'[ prepare-alien-setter ds-pop @ ]
[ float inline-alien-setter? ]
inline-alien ; inline
: emit-alien-unsigned-getter ( node n -- )
'[
_ {
{ 1 [ ^^alien-unsigned-1 ] }
{ 2 [ ^^alien-unsigned-2 ] }
{ 4 [ ^^alien-unsigned-4 ] }
} case ^^tag-fixnum
} case
] inline-alien-getter ;
: emit-alien-signed-getter ( node n -- )
@ -84,7 +76,7 @@ IN: compiler.cfg.intrinsics.alien
{ 1 [ ^^alien-signed-1 ] }
{ 2 [ ^^alien-signed-2 ] }
{ 4 [ ^^alien-signed-4 ] }
} case ^^tag-fixnum
} case
] inline-alien-getter ;
: emit-alien-integer-setter ( node n -- )
@ -94,7 +86,7 @@ IN: compiler.cfg.intrinsics.alien
{ 2 [ ##set-alien-integer-2 ] }
{ 4 [ ##set-alien-integer-4 ] }
} case
] inline-alien-integer-setter ;
] inline-alien-setter ;
: emit-alien-cell-getter ( node -- )
[ ^^alien-cell ^^box-alien ] inline-alien-getter ;
@ -116,4 +108,4 @@ IN: compiler.cfg.intrinsics.alien
{ float-rep [ ##set-alien-float ] }
{ double-rep [ ##set-alien-double ] }
} case
] inline-alien-float-setter ;
] inline-alien-setter ;

24
basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences accessors layouts kernel math math.intervals
namespaces combinators fry arrays
@ -20,14 +20,17 @@ IN: compiler.cfg.intrinsics.fixnum
0 cc= ^^compare-imm
ds-push ;
: emit-fixnum-op ( insn -- )
: binary-fixnum-op ( quot -- )
[ 2inputs ] dip call ds-push ; inline
: unary-fixnum-op ( quot -- )
[ ds-pop ] dip call ds-push ; inline
: emit-fixnum-left-shift ( -- )
[ ^^untag-fixnum ^^shl ] emit-fixnum-op ;
[ ^^shl ] binary-fixnum-op ;
: emit-fixnum-right-shift ( -- )
[ ^^untag-fixnum ^^neg ^^sar dup tag-mask get ^^and-imm ^^xor ] emit-fixnum-op ;
[ ^^sar ] binary-fixnum-op ;
: emit-fixnum-shift-general ( -- )
ds-peek 0 cc> ##compare-imm-branch
@ -42,17 +45,8 @@ IN: compiler.cfg.intrinsics.fixnum
[ drop emit-fixnum-shift-general ]
} cond ;
: emit-fixnum-bitnot ( -- )
ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
: emit-fixnum-log2 ( -- )
ds-pop ^^log2 tag-bits get ^^sub-imm ^^tag-fixnum ds-push ;
: emit-fixnum*fast ( -- )
2inputs ^^untag-fixnum ^^mul ds-push ;
: emit-fixnum-comparison ( cc -- )
'[ _ ^^compare ] emit-fixnum-op ;
'[ _ ^^compare ] binary-fixnum-op ;
: emit-no-overflow-case ( dst -- final-bb )
[ ds-drop ds-drop ds-push ] with-branch ;
@ -80,4 +74,4 @@ IN: compiler.cfg.intrinsics.fixnum
[ ^^fixnum-sub ] \ fixnum-overflow emit-fixnum-overflow-op ;
: emit-fixnum* ( -- )
[ ^^untag-fixnum ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ;
[ ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ;

4
basis/compiler/cfg/intrinsics/float/float.factor
View File

@ -14,10 +14,10 @@ IN: compiler.cfg.intrinsics.float
[ 2inputs ] dip ^^compare-float-unordered ds-push ; inline
: emit-float>fixnum ( -- )
ds-pop ^^float>integer ^^tag-fixnum ds-push ;
ds-pop ^^float>integer ds-push ;
: emit-fixnum>float ( -- )
ds-pop ^^untag-fixnum ^^integer>float ds-push ;
ds-pop ^^integer>float ds-push ;
: emit-fsqrt ( -- )
ds-pop ^^sqrt ds-push ;

24
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: words sequences kernel combinators cpu.architecture assocs
compiler.cfg.hats
@ -38,14 +38,14 @@ IN: compiler.cfg.intrinsics
{ math.private:fixnum+ [ drop emit-fixnum+ ] }
{ math.private:fixnum- [ drop emit-fixnum- ] }
{ math.private:fixnum* [ drop emit-fixnum* ] }
{ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
{ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
{ math.private:fixnum*fast [ drop emit-fixnum*fast ] }
{ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
{ math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] }
{ math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] }
{ math.private:fixnum+fast [ drop [ ^^add ] binary-fixnum-op ] }
{ math.private:fixnum-fast [ drop [ ^^sub ] binary-fixnum-op ] }
{ math.private:fixnum*fast [ drop [ ^^mul ] binary-fixnum-op ] }
{ math.private:fixnum-bitand [ drop [ ^^and ] binary-fixnum-op ] }
{ math.private:fixnum-bitor [ drop [ ^^or ] binary-fixnum-op ] }
{ math.private:fixnum-bitxor [ drop [ ^^xor ] binary-fixnum-op ] }
{ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
{ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
{ math.private:fixnum-bitnot [ drop [ ^^not ] unary-fixnum-op ] }
{ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
{ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
{ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
@ -143,13 +143,13 @@ IN: compiler.cfg.intrinsics
: enable-min/max ( -- )
{
{ math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] }
{ math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] }
{ math.integers.private:fixnum-min [ drop [ ^^min ] binary-fixnum-op ] }
{ math.integers.private:fixnum-max [ drop [ ^^max ] binary-fixnum-op ] }
} enable-intrinsics ;
: enable-fixnum-log2 ( -- )
: enable-log2 ( -- )
{
{ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
{ math.integers.private:fixnum-log2 [ drop [ ^^log2 ] unary-fixnum-op ] }
} enable-intrinsics ;
: emit-intrinsic ( node word -- )

7
basis/compiler/cfg/intrinsics/misc/misc.factor
View File

@ -9,7 +9,7 @@ FROM: vm => context-field-offset vm-field-offset ;
IN: compiler.cfg.intrinsics.misc
: emit-tag ( -- )
ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
ds-pop ^^tagged>integer tag-mask get ^^and-imm ds-push ;
: special-object-offset ( n -- offset )
cells "special-objects" vm-field-offset + ;
@ -37,7 +37,8 @@ IN: compiler.cfg.intrinsics.misc
] [ emit-primitive ] ?if ;
: emit-identity-hashcode ( -- )
ds-pop tag-mask get bitnot ^^load-immediate ^^and 0 0 ^^slot-imm
ds-pop ^^tagged>integer
tag-mask get bitnot ^^load-integer ^^and
0 ^^alien-cell
hashcode-shift ^^shr-imm
^^tag-fixnum
ds-push ;

12
basis/compiler/cfg/intrinsics/simd/simd-tests.factor
View File

@ -127,7 +127,7 @@ unit-test
unit-test
! vneg
[ { ##load-constant ##sub-vector } ]
[ { ##load-reference ##sub-vector } ]
[ simple-ops-cpu float-4-rep [ emit-simd-vneg ] test-emit ]
unit-test
@ -153,11 +153,11 @@ M: addsub-cpu %add-sub-vector-reps { int-4-rep float-4-rep } ;
[ addsub-cpu float-4-rep [ emit-simd-v+- ] test-emit ]
unit-test
[ { ##load-constant ##xor-vector ##add-vector } ]
[ { ##load-reference ##xor-vector ##add-vector } ]
[ simple-ops-cpu float-4-rep [ emit-simd-v+- ] test-emit ]
unit-test
[ { ##load-constant ##xor-vector ##sub-vector ##add-vector } ]
[ { ##load-reference ##xor-vector ##sub-vector ##add-vector } ]
[ simple-ops-cpu int-4-rep [ emit-simd-v+- ] test-emit ]
unit-test
@ -301,7 +301,7 @@ unit-test
[ abs-cpu float-4-rep [ emit-simd-vabs ] test-emit ]
unit-test
[ { ##load-constant ##andn-vector } ]
[ { ##load-reference ##andn-vector } ]
[ simple-ops-cpu float-4-rep [ emit-simd-vabs ] test-emit ]
unit-test
@ -388,7 +388,7 @@ TUPLE: shuffle-cpu < simple-ops-cpu ;
M: shuffle-cpu %shuffle-vector-reps signed-reps ;
! vshuffle-elements
[ { ##load-constant ##shuffle-vector } ]
[ { ##load-reference ##shuffle-vector } ]
[ shuffle-cpu { 0 1 2 3 } int-4-rep [ emit-simd-vshuffle-elements ] test-emit-literal ]
unit-test
@ -420,7 +420,7 @@ unit-test
[ minmax-cpu int-4-rep [ emit-simd-v<= ] test-emit ]
unit-test
[ { ##load-constant ##xor-vector ##xor-vector ##compare-vector } ]
[ { ##load-reference ##xor-vector ##xor-vector ##compare-vector } ]
[ compare-cpu uint-4-rep [ emit-simd-v<= ] test-emit ]
unit-test

24
basis/compiler/cfg/intrinsics/simd/simd.factor
View File

@ -43,24 +43,24 @@ IN: compiler.cfg.intrinsics.simd
: ^load-neg-zero-vector ( rep -- dst )
{
{ float-4-rep [ float-array{ -0.0 -0.0 -0.0 -0.0 } underlying>> ^^load-constant ] }
{ double-2-rep [ double-array{ -0.0 -0.0 } underlying>> ^^load-constant ] }
{ float-4-rep [ float-array{ -0.0 -0.0 -0.0 -0.0 } underlying>> ^^load-literal ] }
{ double-2-rep [ double-array{ -0.0 -0.0 } underlying>> ^^load-literal ] }
} case ;
: ^load-add-sub-vector ( rep -- dst )
signed-rep {
{ float-4-rep [ float-array{ -0.0 0.0 -0.0 0.0 } underlying>> ^^load-constant ] }
{ double-2-rep [ double-array{ -0.0 0.0 } underlying>> ^^load-constant ] }
{ char-16-rep [ char-array{ -1 0 -1 0 -1 0 -1 0 -1 0 -1 0 -1 0 -1 0 } underlying>> ^^load-constant ] }
{ short-8-rep [ short-array{ -1 0 -1 0 -1 0 -1 0 } underlying>> ^^load-constant ] }
{ int-4-rep [ int-array{ -1 0 -1 0 } underlying>> ^^load-constant ] }
{ longlong-2-rep [ longlong-array{ -1 0 } underlying>> ^^load-constant ] }
{ float-4-rep [ float-array{ -0.0 0.0 -0.0 0.0 } underlying>> ^^load-literal ] }
{ double-2-rep [ double-array{ -0.0 0.0 } underlying>> ^^load-literal ] }
{ char-16-rep [ char-array{ -1 0 -1 0 -1 0 -1 0 -1 0 -1 0 -1 0 -1 0 } underlying>> ^^load-literal ] }
{ short-8-rep [ short-array{ -1 0 -1 0 -1 0 -1 0 } underlying>> ^^load-literal ] }
{ int-4-rep [ int-array{ -1 0 -1 0 } underlying>> ^^load-literal ] }
{ longlong-2-rep [ longlong-array{ -1 0 } underlying>> ^^load-literal ] }
} case ;
: ^load-half-vector ( rep -- dst )
{
{ float-4-rep [ float-array{ 0.5 0.5 0.5 0.5 } underlying>> ^^load-constant ] }
{ double-2-rep [ double-array{ 0.5 0.5 } underlying>> ^^load-constant ] }
{ float-4-rep [ float-array{ 0.5 0.5 0.5 0.5 } underlying>> ^^load-literal ] }
{ double-2-rep [ double-array{ 0.5 0.5 } underlying>> ^^load-literal ] }
} case ;
: >variable-shuffle ( shuffle rep -- shuffle' )
@ -70,7 +70,7 @@ IN: compiler.cfg.intrinsics.simd
'[ _ n*v _ v+ ] map concat ;
: ^load-immediate-shuffle ( shuffle rep -- dst )
>variable-shuffle ^^load-constant ;
>variable-shuffle ^^load-literal ;
:: ^blend-vector ( mask true false rep -- dst )
true mask rep ^^and-vector
@ -118,7 +118,7 @@ IN: compiler.cfg.intrinsics.simd
[ ^(compare-vector) ]
[ ^minmax-compare-vector ]
{ unsigned-int-vector-rep [| src1 src2 rep cc |
rep sign-bit-mask ^^load-constant :> sign-bits
rep sign-bit-mask ^^load-literal :> sign-bits
src1 sign-bits rep ^^xor-vector
src2 sign-bits rep ^^xor-vector
rep signed-rep cc ^(compare-vector)

5
basis/compiler/cfg/intrinsics/slots/slots.factor
View File

@ -76,8 +76,7 @@ IN: compiler.cfg.intrinsics.slots
] [ drop emit-primitive ] if ;
: emit-string-nth ( -- )
2inputs swap ^^untag-fixnum ^^string-nth ^^tag-fixnum ds-push ;
2inputs swap ^^string-nth ds-push ;
: emit-set-string-nth-fast ( -- )
3inputs [ ^^untag-fixnum ] [ ^^untag-fixnum ] [ ] tri*
swap next-vreg ##set-string-nth-fast ;
3inputs swap next-vreg ##set-string-nth-fast ;

4
basis/compiler/cfg/linear-scan/linear-scan-tests.factor
View File

@ -1126,7 +1126,7 @@ V{
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
V{
T{ ##load-immediate { dst 61 } }
T{ ##load-integer { dst 61 } }
T{ ##peek { dst 62 } { loc D 0 } }
T{ ##peek { dst 64 } { loc D 1 } }
T{ ##slot-imm
@ -1269,7 +1269,7 @@ V{
{ src1 109 }
{ src2 8 }
}
T{ ##load-immediate { dst 129 } { val 24 } }
T{ ##load-integer { dst 129 } { val 24 } }
T{ ##inc-d { n 4 } }
T{ ##inc-r { n 1 } }
T{ ##replace { src 109 } { loc D 2 } }

53
basis/compiler/cfg/representations/conversion/conversion.factor
View File

@ -7,59 +7,70 @@ 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 -- )
GENERIC: rep>tagged ( dst src rep -- )
GENERIC: tagged>rep ( dst src rep -- )
M: int-rep emit-box ( dst src rep -- )
M: int-rep rep>tagged ( dst src rep -- )
drop tag-bits get ##shl-imm ;
M: int-rep emit-unbox ( dst src rep -- )
M: int-rep tagged>rep ( dst src rep -- )
drop tag-bits get ##sar-imm ;
M:: float-rep emit-box ( dst src rep -- )
M:: float-rep rep>tagged ( dst src rep -- )
double-rep next-vreg-rep :> temp
temp src ##single>double-float
dst temp double-rep emit-box ;
dst temp double-rep rep>tagged ;
M:: float-rep emit-unbox ( dst src rep -- )
M:: float-rep tagged>rep ( dst src rep -- )
double-rep next-vreg-rep :> temp
temp src double-rep emit-unbox
temp src double-rep tagged>rep
dst temp ##double>single-float ;
M: double-rep emit-box
M: double-rep rep>tagged
drop
[ drop 16 float tagged-rep next-vreg-rep ##allot ]
[ drop 16 float int-rep next-vreg-rep ##allot ]
[ float-offset swap ##set-alien-double ]
2bi ;
M: double-rep emit-unbox
M: double-rep tagged>rep
drop float-offset ##alien-double ;
M:: vector-rep emit-box ( dst src rep -- )
M:: vector-rep rep>tagged ( 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
dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
temp 16 tag-fixnum ##load-tagged
temp dst 1 byte-array type-number ##set-slot-imm
dst byte-array-offset src rep ##set-alien-vector ;
M: vector-rep emit-unbox
M: vector-rep tagged>rep
[ byte-array-offset ] dip ##alien-vector ;
M:: scalar-rep emit-box ( dst src rep -- )
M:: scalar-rep rep>tagged ( dst src rep -- )
tagged-rep next-vreg-rep :> temp
temp src rep ##scalar>integer
dst temp int-rep emit-box ;
dst temp int-rep rep>tagged ;
M:: scalar-rep emit-unbox ( dst src rep -- )
M:: scalar-rep tagged>rep ( dst src rep -- )
tagged-rep next-vreg-rep :> temp
temp src int-rep emit-unbox
temp src int-rep tagged>rep
dst temp rep ##integer>scalar ;
GENERIC: rep>int ( dst src rep -- )
GENERIC: int>rep ( dst src rep -- )
M: scalar-rep rep>int ( dst src rep -- )
##scalar>integer ;
M: scalar-rep int>rep ( dst src 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 ] }
{ [ dup tagged-rep? ] [ drop tagged>rep ] }
{ [ over tagged-rep? ] [ nip rep>tagged ] }
{ [ dup int-rep? ] [ drop int>rep ] }
{ [ over int-rep? ] [ nip rep>int ] }
[
2dup 2array {
{ { double-rep float-rep } [ 2drop ##single>double-float ] }

61
basis/compiler/cfg/representations/representations-tests.factor
View File

@ -1,7 +1,7 @@
USING: accessors compiler.cfg compiler.cfg.debugger
compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.representations.preferred cpu.architecture kernel
namespaces tools.test sequences arrays system ;
namespaces tools.test sequences arrays system literals layouts ;
IN: compiler.cfg.representations
[ { double-rep double-rep } ] [
@ -50,6 +50,59 @@ V{
[ 1 ] [ 1 get instructions>> [ ##allot? ] count ] unit-test
! Converting a ##load-integer into a ##load-tagged
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##load-integer f 1 100 }
T{ ##replace f 1 D 0 }
T{ ##branch }
} 1 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 2 test-bb
0 1 edge
1 2 edge
[ ] [ test-representations ] unit-test
[ T{ ##load-tagged f 1 $[ 100 tag-fixnum ] } ]
[ 1 get instructions>> first ]
unit-test
! scalar-rep => int-rep conversion
V{
T{ ##prologue }
T{ ##branch }
} 0 test-bb
V{
T{ ##peek f 1 D 0 }
T{ ##peek f 2 D 0 }
T{ ##vector>scalar f 3 2 int-4-rep }
T{ ##shl f 4 1 3 }
T{ ##replace f 4 D 0 }
T{ ##branch }
} 1 test-bb
V{
T{ ##epilogue }
T{ ##return }
} 2 test-bb
0 1 edge
1 2 edge
[ ] [ test-representations ] unit-test
[ t ] [ 1 get instructions>> 4 swap nth ##scalar>integer? ] unit-test
cpu x86.32? [
! Make sure load-constant is converted into load-double
@ -60,7 +113,7 @@ cpu x86.32? [
V{
T{ ##peek f 1 D 0 }
T{ ##load-constant f 2 0.5 }
T{ ##load-reference f 2 0.5 }
T{ ##add-float f 3 1 2 }
T{ ##replace f 3 D 0 }
T{ ##branch }
@ -90,12 +143,12 @@ cpu x86.32? [
} 1 test-bb
V{
T{ ##load-constant f 2 1.5 }
T{ ##load-reference f 2 1.5 }
T{ ##branch }
} 2 test-bb
V{
T{ ##load-constant f 3 2.5 }
T{ ##load-reference f 3 2.5 }
T{ ##branch }
} 3 test-bb

41
basis/compiler/cfg/representations/rewrite/rewrite.factor
View File

@ -1,12 +1,16 @@
! 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
combinators.short-circuit layouts kernel locals make math
namespaces sequences
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 ;
compiler.cfg.representations.preferred
compiler.cfg.rpo
compiler.cfg.utilities
cpu.architecture ;
IN: compiler.cfg.representations.rewrite
! Insert conversions. This introduces new temporaries, so we need
@ -78,7 +82,16 @@ GENERIC: conversions-for-insn ( insn -- )
M: ##phi conversions-for-insn , ;
! When a float is unboxed, we replace the ##load-constant with a ##load-double
M: ##load-integer conversions-for-insn
{
{
[ dup dst>> rep-of tagged-rep? ]
[ [ dst>> ] [ val>> tag-fixnum ] bi ##load-tagged ]
}
[ call-next-method ]
} cond ;
! When a float is unboxed, we replace the ##load-reference with a ##load-double
! if the architecture supports it
: convert-to-load-double? ( insn -- ? )
{
@ -107,29 +120,23 @@ M: ##phi conversions-for-insn , ;
: (convert-to-zero/fill-vector) ( insn -- dst rep )
dst>> dup rep-of ; inline
: conversions-for-load-insn ( insn -- ?insn )
M: ##load-reference conversions-for-insn
{
{
[ dup convert-to-load-double? ]
[ (convert-to-load-double) ##load-double f ]
[ (convert-to-load-double) ##load-double ]
}
{
[ dup convert-to-zero-vector? ]
[ (convert-to-zero/fill-vector) ##zero-vector f ]
[ (convert-to-zero/fill-vector) ##zero-vector ]
}
{
[ dup convert-to-fill-vector? ]
[ (convert-to-zero/fill-vector) ##fill-vector f ]
[ (convert-to-zero/fill-vector) ##fill-vector ]
}
[ ]
[ call-next-method ]
} 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 ;

8
basis/compiler/cfg/representations/selection/selection.factor
View File

@ -29,7 +29,7 @@ SYMBOL: always-boxed
H{ } clone [
'[
[
dup [ ##load-reference? ] [ ##load-constant? ] bi or
dup ##load-reference?
[ drop ] [ [ _ (compute-always-boxed) ] each-def-rep ] if
] each-non-phi
] each-basic-block
@ -65,9 +65,9 @@ SYMBOL: costs
GENERIC: compute-insn-costs ( insn -- )
M: ##load-constant compute-insn-costs
! There's no cost to unboxing the result of a ##load-constant
drop ;
! There's no cost to converting a constant's representation
M: ##load-integer compute-insn-costs drop ;
M: ##load-reference compute-insn-costs drop ;
M: insn compute-insn-costs [ representation-cost ] each-rep ;

12
basis/compiler/cfg/ssa/construction/construction-tests.factor
View File

@ -13,19 +13,19 @@ IN: compiler.cfg.ssa.construction.tests
reset-counters
V{
T{ ##load-immediate f 1 100 }
T{ ##load-integer f 1 100 }
T{ ##add-imm f 2 1 50 }
T{ ##add-imm f 2 2 10 }
T{ ##branch }
} 0 test-bb
V{
T{ ##load-immediate f 3 3 }
T{ ##load-integer f 3 3 }
T{ ##branch }
} 1 test-bb
V{
T{ ##load-immediate f 3 4 }
T{ ##load-integer f 3 4 }
T{ ##branch }
} 2 test-bb
@ -48,7 +48,7 @@ V{
[
V{
T{ ##load-immediate f 1 100 }
T{ ##load-integer f 1 100 }
T{ ##add-imm f 2 1 50 }
T{ ##add-imm f 3 2 10 }
T{ ##branch }
@ -57,14 +57,14 @@ V{
[
V{
T{ ##load-immediate f 4 3 }
T{ ##load-integer f 4 3 }
T{ ##branch }
}
] [ 1 get instructions>> ] unit-test
[
V{
T{ ##load-immediate f 5 4 }
T{ ##load-integer f 5 4 }
T{ ##branch }
}
] [ 2 get instructions>> ] unit-test

2
basis/compiler/cfg/ssa/cssa/cssa.factor
View File

@ -7,7 +7,7 @@ compiler.cfg.def-use
compiler.cfg.utilities
compiler.cfg.registers
compiler.cfg.instructions
compiler.cfg.representations ;
compiler.cfg.representations.conversion ;
IN: compiler.cfg.ssa.cssa
! Convert SSA to conventional SSA. This pass runs after representation

50
basis/compiler/cfg/value-numbering/alien/alien.factor Normal file
View File

@ -0,0 +1,50 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors fry kernel make math
compiler.cfg.hats
compiler.cfg.instructions
compiler.cfg.registers
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.rewrite ;
IN: compiler.cfg.value-numbering.alien
! ##box-displaced-alien f 1 2 3 <class>
! ##unbox-c-ptr 4 1 <class>
! =>
! ##box-displaced-alien f 1 2 3 <class>
! ##unbox-c-ptr 5 3 <class>
! ##add 4 5 2
: rewrite-unbox-displaced-alien ( insn expr -- insns )
[
[ dst>> ]
[ [ base>> vn>vreg ] [ base-class>> ] [ displacement>> vn>vreg ] tri ] bi*
[ ^^unbox-c-ptr ] dip
##add
] { } make ;
M: ##unbox-any-c-ptr rewrite
dup src>> vreg>expr dup box-displaced-alien-expr?
[ rewrite-unbox-displaced-alien ] [ 2drop f ] if ;
! More efficient addressing for alien intrinsics
: rewrite-alien-addressing ( insn -- insn' )
dup src>> vreg>expr dup add-imm-expr? [
[ src1>> vn>vreg ] [ src2>> vn>integer ] bi
[ >>src ] [ '[ _ + ] change-offset ] bi*
] [ 2drop f ] if ;
M: ##alien-unsigned-1 rewrite rewrite-alien-addressing ;
M: ##alien-unsigned-2 rewrite rewrite-alien-addressing ;
M: ##alien-unsigned-4 rewrite rewrite-alien-addressing ;
M: ##alien-signed-1 rewrite rewrite-alien-addressing ;
M: ##alien-signed-2 rewrite rewrite-alien-addressing ;
M: ##alien-signed-4 rewrite rewrite-alien-addressing ;
M: ##alien-float rewrite rewrite-alien-addressing ;
M: ##alien-double rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-1 rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-2 rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-4 rewrite rewrite-alien-addressing ;
M: ##set-alien-float rewrite rewrite-alien-addressing ;
M: ##set-alien-double rewrite rewrite-alien-addressing ;

1
basis/compiler/cfg/value-numbering/alien/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

1
basis/compiler/cfg/value-numbering/comparisons/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

167
basis/compiler/cfg/value-numbering/comparisons/comparisons.factor Normal file
View File

@ -0,0 +1,167 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators kernel math math.order namespaces
sequences vectors combinators.short-circuit compiler.cfg
compiler.cfg.comparisons compiler.cfg.instructions
compiler.cfg.registers compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.rewrite ;
IN: compiler.cfg.value-numbering.comparisons
: ##branch-t? ( insn -- ? )
dup ##compare-imm-branch? [
{ [ cc>> cc/= eq? ] [ src2>> not ] } 1&&
] [ drop f ] if ; inline
: scalar-compare-expr? ( insn -- ? )
{
[ compare-expr? ]
[ compare-imm-expr? ]
[ compare-float-unordered-expr? ]
[ compare-float-ordered-expr? ]
} 1|| ;
: general-compare-expr? ( insn -- ? )
{
[ scalar-compare-expr? ]
[ test-vector-expr? ]
} 1|| ;
: rewrite-boolean-comparison? ( insn -- ? )
dup ##branch-t? [
src1>> vreg>expr general-compare-expr?
] [ drop f ] if ; inline
: >compare-expr< ( expr -- in1 in2 cc )
[ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline
: >compare-imm-expr< ( expr -- in1 in2 cc )
[ src1>> vn>vreg ] [ src2>> vn>integer ] [ cc>> ] tri ; inline
: >test-vector-expr< ( expr -- src1 temp rep vcc )
{
[ src1>> vn>vreg ]
[ drop next-vreg ]
[ rep>> ]
[ vcc>> ]
} cleave ; inline
: rewrite-boolean-comparison ( expr -- insn )
src1>> vreg>expr {
{ [ dup compare-expr? ] [ >compare-expr< \ ##compare-branch new-insn ] }
{ [ dup compare-imm-expr? ] [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
{ [ dup compare-float-unordered-expr? ] [ >compare-expr< \ ##compare-float-unordered-branch new-insn ] }
{ [ dup compare-float-ordered-expr? ] [ >compare-expr< \ ##compare-float-ordered-branch new-insn ] }
{ [ dup test-vector-expr? ] [ >test-vector-expr< \ ##test-vector-branch new-insn ] }
} cond ;
: rewrite-redundant-comparison? ( insn -- ? )
{
[ src1>> vreg>expr scalar-compare-expr? ]
[ src2>> not ]
[ cc>> { cc= cc/= } member? ]
} 1&& ; inline
: rewrite-redundant-comparison ( insn -- insn' )
[ cc>> ] [ dst>> ] [ src1>> vreg>expr ] tri {
{ [ dup compare-expr? ] [ >compare-expr< next-vreg \ ##compare new-insn ] }
{ [ dup compare-imm-expr? ] [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] }
{ [ dup compare-float-unordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-unordered new-insn ] }
{ [ dup compare-float-ordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-ordered new-insn ] }
} cond
swap cc= eq? [ [ negate-cc ] change-cc ] when ;
: evaluate-compare-imm ( insn -- ? )
[ src1>> vreg>comparand ] [ src2>> ] [ cc>> ] tri
2over [ integer? ] both? [ [ <=> ] dip evaluate-cc ] [
{
{ cc= [ eq? ] }
{ cc/= [ eq? not ] }
} case
] if ;
: fold-compare-imm? ( insn -- ? )
src1>> vreg>expr literal-expr? ;
: fold-branch ( ? -- insn )
0 1 ?
basic-block get [ nth 1vector ] change-successors drop
\ ##branch new-insn ;
: fold-compare-imm-branch ( insn -- insn/f )
evaluate-compare-imm fold-branch ;
M: ##compare-imm-branch rewrite
{
{ [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] }
{ [ dup fold-compare-imm? ] [ fold-compare-imm-branch ] }
[ drop f ]
} cond ;
: swap-compare ( src1 src2 cc swap? -- src1 src2 cc )
[ [ swap ] dip swap-cc ] when ; inline
: >compare-imm-branch ( insn swap? -- insn' )
[
[ src1>> ]
[ src2>> ]
[ cc>> ]
tri
] dip
swap-compare
[ vreg>comparand ] dip
\ ##compare-imm-branch new-insn ; inline
: self-compare? ( insn -- ? )
[ src1>> ] [ src2>> ] bi [ vreg>vn ] bi@ = ; inline
: evaluate-self-compare ( insn -- ? )
cc>> { cc= cc<= cc>= } member-eq? ;
: rewrite-self-compare-branch ( insn -- insn' )
evaluate-self-compare fold-branch ;
M: ##compare-branch rewrite
{
{ [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm-branch ] }
{ [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm-branch ] }
{ [ dup self-compare? ] [ rewrite-self-compare-branch ] }
[ drop f ]
} cond ;
: >compare-imm ( insn swap? -- insn' )
[
{
[ dst>> ]
[ src1>> ]
[ src2>> ]
[ cc>> ]
} cleave
] dip
swap-compare
[ vreg>comparand ] dip
next-vreg \ ##compare-imm new-insn ; inline
: >boolean-insn ( insn ? -- insn' )
[ dst>> ] dip \ ##load-reference new-insn ;
: rewrite-self-compare ( insn -- insn' )
dup evaluate-self-compare >boolean-insn ;
M: ##compare rewrite
{
{ [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm ] }
{ [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm ] }
{ [ dup self-compare? ] [ rewrite-self-compare ] }
[ drop f ]
} cond ;
: fold-compare-imm ( insn -- insn' )
dup evaluate-compare-imm >boolean-insn ;
M: ##compare-imm rewrite
{
{ [ dup rewrite-redundant-comparison? ] [ rewrite-redundant-comparison ] }
{ [ dup fold-compare-imm? ] [ fold-compare-imm ] }
[ drop f ]
} cond ;

93
basis/compiler/cfg/value-numbering/expressions/expressions.factor
View File

@ -1,46 +1,87 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes classes.algebra classes.parser
classes.tuple combinators combinators.short-circuit fry
generic.parser kernel math namespaces quotations sequences slots
splitting words compiler.cfg.instructions
generic.parser kernel layouts locals math namespaces quotations
sequences slots splitting words
cpu.architecture
compiler.cfg.instructions
compiler.cfg.instructions.syntax
compiler.cfg.value-numbering.graph ;
IN: compiler.cfg.value-numbering.expressions
TUPLE: constant-expr < expr value ;
TUPLE: integer-expr < expr value ;
C: <constant> constant-expr
M: constant-expr equal?
over constant-expr? [
[ value>> ] bi@
2dup [ float? ] both? [ fp-bitwise= ] [
{ [ [ class ] bi@ = ] [ = ] } 2&&
] if
] [ 2drop f ] if ;
C: <integer-expr> integer-expr
TUPLE: reference-expr < expr value ;
C: <reference> reference-expr
C: <reference-expr> reference-expr
M: reference-expr equal?
over reference-expr? [ [ value>> ] bi@ eq? ] [ 2drop f ] if ;
over reference-expr? [
[ value>> ] bi@
2dup [ float? ] both?
[ fp-bitwise= ] [ eq? ] if
] [ 2drop f ] if ;
M: reference-expr hashcode*
nip value>> identity-hashcode ;
nip value>> dup float? [ double>bits ] [ identity-hashcode ] if ;
: constant>vn ( constant -- vn ) <constant> expr>vn ; inline
UNION: literal-expr integer-expr reference-expr ;
GENERIC: >expr ( insn -- expr )
M: insn >expr drop next-input-expr ;
M: ##load-immediate >expr val>> <constant> ;
M: ##load-integer >expr val>> <integer-expr> ;
M: ##load-reference >expr obj>> <reference> ;
M: ##load-reference >expr obj>> <reference-expr> ;
M: ##load-constant >expr obj>> <constant> ;
GENERIC: expr>reference ( expr -- obj )
M: reference-expr expr>reference value>> ;
: vn>reference ( vn -- obj ) vn>expr expr>reference ;
: vreg>reference ( vreg -- obj ) vreg>vn vn>reference ; inline
GENERIC: expr>integer ( expr -- n )
M: integer-expr expr>integer value>> ;
: vn>integer ( vn -- n ) vn>expr expr>integer ;
: vreg>integer ( vreg -- n ) vreg>vn vn>integer ; inline
: vreg-immediate-arithmetic? ( vreg -- ? )
vreg>expr {
[ integer-expr? ]
[ expr>integer tag-fixnum immediate-arithmetic? ]
} 1&& ;
: vreg-immediate-bitwise? ( vreg -- ? )
vreg>expr {
[ integer-expr? ]
[ expr>integer tag-fixnum immediate-bitwise? ]
} 1&& ;
GENERIC: expr>comparand ( expr -- n )
M: integer-expr expr>comparand value>> ;
M: reference-expr expr>comparand value>> ;
: vn>comparand ( vn -- n ) vn>expr expr>comparand ;
: vreg>comparand ( vreg -- n ) vreg>vn vn>comparand ; inline
: vreg-immediate-comparand? ( vreg -- ? )
vreg>expr {
{ [ dup integer-expr? ] [ expr>integer tag-fixnum immediate-comparand? ] }
{ [ dup reference-expr? ] [ value>> immediate-comparand? ] }
[ drop f ]
} cond ;
<<
@ -50,8 +91,12 @@ M: ##load-constant >expr obj>> <constant> ;
: expr-class ( insn -- expr )
name>> "##" ?head drop "-expr" append create-class-in ;
: define-expr-class ( insn expr slot-specs -- )
[ nip expr ] dip [ name>> ] map define-tuple-class ;
: define-expr-class ( expr slot-specs -- )
[ expr ] dip [ name>> ] map define-tuple-class ;
: constant>vn ( obj -- vn )
dup integer? [ <integer-expr> ] [ <reference-expr> ] if
expr>vn ;
: >expr-quot ( expr slot-specs -- quot )
[
@ -66,11 +111,11 @@ M: ##load-constant >expr obj>> <constant> ;
] map cleave>quot swap suffix \ boa suffix ;
: define->expr-method ( insn expr slot-specs -- )
[ 2drop \ >expr create-method-in ] [ >expr-quot nip ] 3bi define ;
[ \ >expr create-method-in ] 2dip >expr-quot define ;
: handle-pure-insn ( insn -- )
[ ] [ expr-class ] [ "insn-slots" word-prop input-values ] tri
[ define-expr-class ] [ define->expr-method ] 3bi ;
[ define-expr-class drop ] [ define->expr-method ] 3bi ;
insn-classes get [ pure-insn class<= ] filter [ handle-pure-insn ] each

1
basis/compiler/cfg/value-numbering/folding/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

39
basis/compiler/cfg/value-numbering/folding/folding.factor Normal file
View File

@ -0,0 +1,39 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel layouts math math.bitwise
compiler.cfg.instructions
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph ;
IN: compiler.cfg.value-numbering.folding
: binary-constant-fold? ( insn -- ? )
src1>> vreg>expr integer-expr? ; inline
GENERIC: binary-constant-fold* ( x y insn -- z )
M: ##add-imm binary-constant-fold* drop + ;
M: ##sub-imm binary-constant-fold* drop - ;
M: ##mul-imm binary-constant-fold* drop * ;
M: ##and-imm binary-constant-fold* drop bitand ;
M: ##or-imm binary-constant-fold* drop bitor ;
M: ##xor-imm binary-constant-fold* drop bitxor ;
M: ##shr-imm binary-constant-fold* drop [ cell-bits 2^ wrap ] dip neg shift ;
M: ##sar-imm binary-constant-fold* drop neg shift ;
M: ##shl-imm binary-constant-fold* drop shift ;
: binary-constant-fold ( insn -- insn' )
[ dst>> ]
[ [ src1>> vreg>integer ] [ src2>> ] [ ] tri binary-constant-fold* ] bi
\ ##load-integer new-insn ; inline
: unary-constant-fold? ( insn -- ? )
src>> vreg>expr integer-expr? ; inline
GENERIC: unary-constant-fold* ( x insn -- y )
M: ##not unary-constant-fold* drop bitnot ;
M: ##neg unary-constant-fold* drop neg ;
: unary-constant-fold ( insn -- insn' )
[ dst>> ] [ [ src>> vreg>integer ] [ ] bi unary-constant-fold* ] bi
\ ##load-integer new-insn ; inline

6
basis/compiler/cfg/value-numbering/graph/graph.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math namespaces assocs biassocs ;
IN: compiler.cfg.value-numbering.graph
@ -35,10 +35,6 @@ SYMBOL: vregs>vns
: vreg>expr ( vreg -- expr ) vreg>vn vn>expr ; inline
: vn>constant ( vn -- constant ) vn>expr value>> ; inline
: vreg>constant ( vreg -- constant ) vreg>vn vn>constant ; inline
: init-value-graph ( -- )
0 vn-counter set
0 input-expr-counter set

1
basis/compiler/cfg/value-numbering/math/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

196
basis/compiler/cfg/value-numbering/math/math.factor Normal file
View File

@ -0,0 +1,196 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators cpu.architecture fry kernel layouts
math sequences compiler.cfg.instructions
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.folding
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.rewrite
compiler.cfg.value-numbering.simplify ;
IN: compiler.cfg.value-numbering.math
M: ##tagged>integer rewrite
[ dst>> ] [ src>> vreg>expr ] bi {
{ [ dup integer-expr? ] [ value>> tag-fixnum \ ##load-integer new-insn ] }
{ [ dup reference-expr? ] [ value>> [ drop f ] [ \ f type-number \ ##load-integer new-insn ] if ] }
[ 2drop f ]
} cond ;
M: ##neg rewrite
dup unary-constant-fold? [ unary-constant-fold ] [ drop f ] if ;
M: ##not rewrite
dup unary-constant-fold? [ unary-constant-fold ] [ drop f ] if ;
: reassociate ( insn -- dst src1 src2 )
{
[ dst>> ]
[ src1>> vreg>expr [ src1>> vn>vreg ] [ src2>> vn>integer ] bi ]
[ src2>> ]
[ ]
} cleave binary-constant-fold* ;
: ?new-insn ( dst src1 src2 ? class -- insn/f )
'[ _ new-insn ] [ 3drop f ] if ; inline
: reassociate-arithmetic ( insn new-insn -- insn/f )
[ reassociate dup immediate-arithmetic? ] dip ?new-insn ; inline
: reassociate-bitwise ( insn new-insn -- insn/f )
[ reassociate dup immediate-bitwise? ] dip ?new-insn ; inline
M: ##add-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup src1>> vreg>expr add-imm-expr? ] [ \ ##add-imm reassociate-arithmetic ] }
[ drop f ]
} cond ;
: sub-imm>add-imm ( insn -- insn' )
[ dst>> ] [ src1>> ] [ src2>> neg ] tri dup immediate-arithmetic?
\ ##add-imm ?new-insn ;
M: ##sub-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
[ sub-imm>add-imm ]
} cond ;
: mul-to-neg? ( insn -- ? )
src2>> -1 = ;
: mul-to-neg ( insn -- insn' )
[ dst>> ] [ src1>> ] bi \ ##neg new-insn ;
: mul-to-shl? ( insn -- ? )
src2>> power-of-2? ;
: mul-to-shl ( insn -- insn' )
[ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi \ ##shl-imm new-insn ;
M: ##mul-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup mul-to-neg? ] [ mul-to-neg ] }
{ [ dup mul-to-shl? ] [ mul-to-shl ] }
{ [ dup src1>> vreg>expr mul-imm-expr? ] [ \ ##mul-imm reassociate-arithmetic ] }
[ drop f ]
} cond ;
M: ##and-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup src1>> vreg>expr and-imm-expr? ] [ \ ##and-imm reassociate-bitwise ] }
[ drop f ]
} cond ;
M: ##or-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup src1>> vreg>expr or-imm-expr? ] [ \ ##or-imm reassociate-bitwise ] }
[ drop f ]
} cond ;
M: ##xor-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup src1>> vreg>expr xor-imm-expr? ] [ \ ##xor-imm reassociate-bitwise ] }
[ drop f ]
} cond ;
M: ##shl-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
[ drop f ]
} cond ;
M: ##shr-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
[ drop f ]
} cond ;
M: ##sar-imm rewrite
{
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
[ drop f ]
} cond ;
: insn>imm-insn ( insn op swap? -- new-insn )
swap [
[ [ dst>> ] [ src1>> ] [ src2>> ] tri ] dip
[ swap ] when vreg>integer
] dip new-insn ; inline
M: ##add rewrite
{
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##add-imm f insn>imm-insn ] }
{ [ dup src1>> vreg-immediate-arithmetic? ] [ \ ##add-imm t insn>imm-insn ] }
[ drop f ]
} cond ;
: subtraction-identity? ( insn -- ? )
[ src1>> ] [ src2>> ] bi [ vreg>vn ] bi@ eq? ;
: rewrite-subtraction-identity ( insn -- insn' )
dst>> 0 \ ##load-integer new-insn ;
: sub-to-neg? ( ##sub -- ? )
src1>> vn>expr expr-zero? ;
: sub-to-neg ( ##sub -- insn )
[ dst>> ] [ src2>> ] bi \ ##neg new-insn ;
M: ##sub rewrite
{
{ [ dup sub-to-neg? ] [ sub-to-neg ] }
{ [ dup subtraction-identity? ] [ rewrite-subtraction-identity ] }
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##sub-imm f insn>imm-insn ] }
[ drop f ]
} cond ;
M: ##mul rewrite
{
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##mul-imm f insn>imm-insn ] }
{ [ dup src1>> vreg-immediate-arithmetic? ] [ \ ##mul-imm t insn>imm-insn ] }
[ drop f ]
} cond ;
M: ##and rewrite
{
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##and-imm f insn>imm-insn ] }
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##and-imm t insn>imm-insn ] }
[ drop f ]
} cond ;
M: ##or rewrite
{
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##or-imm f insn>imm-insn ] }
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##or-imm t insn>imm-insn ] }
[ drop f ]
} cond ;
M: ##xor rewrite
{
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##xor-imm f insn>imm-insn ] }
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##xor-imm t insn>imm-insn ] }
[ drop f ]
} cond ;
M: ##shl rewrite
{
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##shl-imm f insn>imm-insn ] }
[ drop f ]
} cond ;
M: ##shr rewrite
{
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##shr-imm f insn>imm-insn ] }
[ drop f ]
} cond ;
M: ##sar rewrite
{
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##sar-imm f insn>imm-insn ] }
[ drop f ]
} cond ;

473
basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
View File

@ -1,478 +1,9 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman, Daniel Ehrenberg.
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit arrays
fry kernel layouts math namespaces sequences cpu.architecture
math.bitwise math.order classes
vectors locals make alien.c-types io.binary grouping
compiler.cfg
compiler.cfg.registers
compiler.cfg.comparisons
compiler.cfg.instructions
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.simplify ;
USING: kernel compiler.cfg.instructions ;
IN: compiler.cfg.value-numbering.rewrite
: vreg-immediate-arithmetic? ( vreg -- ? )
vreg>expr {
[ constant-expr? ]
[ value>> fixnum? ]
[ value>> immediate-arithmetic? ]
} 1&& ;
: vreg-immediate-bitwise? ( vreg -- ? )
vreg>expr {
[ constant-expr? ]
[ value>> fixnum? ]
[ value>> immediate-bitwise? ]
} 1&& ;
: vreg-immediate-comparand? ( vreg -- ? )
vreg>expr {
[ constant-expr? ]
[ value>> immediate-comparand? ]
} 1&& ;
! Outputs f to mean no change
GENERIC: rewrite ( insn -- insn/f )
M: insn rewrite drop f ;
: ##branch-t? ( insn -- ? )
dup ##compare-imm-branch? [
{ [ cc>> cc/= eq? ] [ src2>> not ] } 1&&
] [ drop f ] if ; inline
: general-compare-expr? ( insn -- ? )
{
[ compare-expr? ]
[ compare-imm-expr? ]
[ compare-float-unordered-expr? ]
[ compare-float-ordered-expr? ]
} 1|| ;
: general-or-vector-compare-expr? ( insn -- ? )
{
[ compare-expr? ]
[ compare-imm-expr? ]
[ compare-float-unordered-expr? ]
[ compare-float-ordered-expr? ]
[ test-vector-expr? ]
} 1|| ;
: rewrite-boolean-comparison? ( insn -- ? )
dup ##branch-t? [
src1>> vreg>expr general-or-vector-compare-expr?
] [ drop f ] if ; inline
: >compare-expr< ( expr -- in1 in2 cc )
[ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline
: >compare-imm-expr< ( expr -- in1 in2 cc )
[ src1>> vn>vreg ] [ src2>> vn>constant ] [ cc>> ] tri ; inline
: >test-vector-expr< ( expr -- src1 temp rep vcc )
{
[ src1>> vn>vreg ]
[ drop next-vreg ]
[ rep>> ]
[ vcc>> ]
} cleave ; inline
: rewrite-boolean-comparison ( expr -- insn )
src1>> vreg>expr {
{ [ dup compare-expr? ] [ >compare-expr< \ ##compare-branch new-insn ] }
{ [ dup compare-imm-expr? ] [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
{ [ dup compare-float-unordered-expr? ] [ >compare-expr< \ ##compare-float-unordered-branch new-insn ] }
{ [ dup compare-float-ordered-expr? ] [ >compare-expr< \ ##compare-float-ordered-branch new-insn ] }
{ [ dup test-vector-expr? ] [ >test-vector-expr< \ ##test-vector-branch new-insn ] }
} cond ;
: tag-fixnum-expr? ( expr -- ? )
dup shl-imm-expr?
[ src2>> vn>constant tag-bits get = ] [ drop f ] if ;
: rewrite-tagged-comparison? ( insn -- ? )
#! Are we comparing two tagged fixnums? Then untag them.
{
[ src1>> vreg>expr tag-fixnum-expr? ]
[ src2>> tag-mask get bitand 0 = ]
} 1&& ; inline
: tagged>constant ( n -- n' )
tag-bits get neg shift ; inline
: (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
[ src1>> vreg>expr src1>> vn>vreg ]
[ src2>> tagged>constant ]
[ cc>> ]
tri ; inline
GENERIC: rewrite-tagged-comparison ( insn -- insn/f )
M: ##compare-imm-branch rewrite-tagged-comparison
(rewrite-tagged-comparison) \ ##compare-imm-branch new-insn ;
M: ##compare-imm rewrite-tagged-comparison
[ dst>> ] [ (rewrite-tagged-comparison) ] bi
next-vreg \ ##compare-imm new-insn ;
: rewrite-redundant-comparison? ( insn -- ? )
{
[ src1>> vreg>expr general-compare-expr? ]
[ src2>> not ]
[ cc>> { cc= cc/= } member? ]
} 1&& ; inline
: rewrite-redundant-comparison ( insn -- insn' )
[ cc>> ] [ dst>> ] [ src1>> vreg>expr ] tri {
{ [ dup compare-expr? ] [ >compare-expr< next-vreg \ ##compare new-insn ] }
{ [ dup compare-imm-expr? ] [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] }
{ [ dup compare-float-unordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-unordered new-insn ] }
{ [ dup compare-float-ordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-ordered new-insn ] }
} cond
swap cc= eq? [ [ negate-cc ] change-cc ] when ;
: (fold-compare-imm) ( insn -- ? )
[ src1>> vreg>constant ] [ src2>> ] [ cc>> ] tri
2over [ integer? ] both? [ [ <=> ] dip evaluate-cc ] [
{
{ cc= [ eq? ] }
{ cc/= [ eq? not ] }
} case
] if ;
: fold-compare-imm? ( insn -- ? )
src1>> vreg>expr [ constant-expr? ] [ reference-expr? ] bi or ;
: fold-branch ( ? -- insn )
0 1 ?
basic-block get [ nth 1vector ] change-successors drop
\ ##branch new-insn ;
: fold-compare-imm-branch ( insn -- insn/f )
(fold-compare-imm) fold-branch ;
M: ##compare-imm-branch rewrite
{
{ [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] }
{ [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] }
{ [ dup fold-compare-imm? ] [ fold-compare-imm-branch ] }
[ drop f ]
} cond ;
: swap-compare ( src1 src2 cc swap? -- src1 src2 cc )
[ [ swap ] dip swap-cc ] when ; inline
: >compare-imm-branch ( insn swap? -- insn' )
[
[ src1>> ]
[ src2>> ]
[ cc>> ]
tri
] dip
swap-compare
[ vreg>constant ] dip
\ ##compare-imm-branch new-insn ; inline
: self-compare? ( insn -- ? )
[ src1>> ] [ src2>> ] bi [ vreg>vn ] bi@ = ; inline
: (rewrite-self-compare) ( insn -- ? )
cc>> { cc= cc<= cc>= } member-eq? ;
: rewrite-self-compare-branch ( insn -- insn' )
(rewrite-self-compare) fold-branch ;
M: ##compare-branch rewrite
{
{ [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm-branch ] }
{ [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm-branch ] }
{ [ dup self-compare? ] [ rewrite-self-compare-branch ] }
[ drop f ]
} cond ;
: >compare-imm ( insn swap? -- insn' )
[
{
[ dst>> ]
[ src1>> ]
[ src2>> ]
[ cc>> ]
} cleave
] dip
swap-compare
[ vreg>constant ] dip
next-vreg \ ##compare-imm new-insn ; inline
: >boolean-insn ( insn ? -- insn' )
[ dst>> ] dip \ ##load-constant new-insn ;
: rewrite-self-compare ( insn -- insn' )
dup (rewrite-self-compare) >boolean-insn ;
M: ##compare rewrite
{
{ [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm ] }
{ [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm ] }
{ [ dup self-compare? ] [ rewrite-self-compare ] }
[ drop f ]
} cond ;
: fold-compare-imm ( insn -- insn' )
dup (fold-compare-imm) >boolean-insn ;
M: ##compare-imm rewrite
{
{ [ dup rewrite-redundant-comparison? ] [ rewrite-redundant-comparison ] }
{ [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] }
{ [ dup fold-compare-imm? ] [ fold-compare-imm ] }
[ drop f ]
} cond ;
: constant-fold? ( insn -- ? )
src1>> vreg>expr constant-expr? ; inline
GENERIC: constant-fold* ( x y insn -- z )
M: ##add-imm constant-fold* drop + ;
M: ##sub-imm constant-fold* drop - ;
M: ##mul-imm constant-fold* drop * ;
M: ##and-imm constant-fold* drop bitand ;
M: ##or-imm constant-fold* drop bitor ;
M: ##xor-imm constant-fold* drop bitxor ;
M: ##shr-imm constant-fold* drop [ cell-bits 2^ wrap ] dip neg shift ;
M: ##sar-imm constant-fold* drop neg shift ;
M: ##shl-imm constant-fold* drop shift ;
: constant-fold ( insn -- insn' )
[ dst>> ]
[
[ src1>> vreg>constant \ f type-number or ]
[ src2>> ]
[ ]
tri constant-fold*
] bi
\ ##load-immediate new-insn ; inline
: unary-constant-fold? ( insn -- ? )
src>> vreg>expr constant-expr? ; inline
GENERIC: unary-constant-fold* ( x insn -- y )
M: ##not unary-constant-fold* drop bitnot ;
M: ##neg unary-constant-fold* drop neg ;
: unary-constant-fold ( insn -- insn' )
[ dst>> ]
[ [ src>> vreg>constant ] [ ] bi unary-constant-fold* ] bi
\ ##load-immediate new-insn ; inline
: maybe-unary-constant-fold ( insn -- insn' )
dup unary-constant-fold? [ unary-constant-fold ] [ drop f ] if ;
M: ##neg rewrite
maybe-unary-constant-fold ;
M: ##not rewrite
maybe-unary-constant-fold ;
: arithmetic-op? ( op -- ? )
{
##add
##add-imm
##sub
##sub-imm
##mul
##mul-imm
} member-eq? ;
: immediate? ( value op -- ? )
arithmetic-op? [ immediate-arithmetic? ] [ immediate-bitwise? ] if ;
: reassociate ( insn op -- insn )
[
{
[ dst>> ]
[ src1>> vreg>expr [ src1>> vn>vreg ] [ src2>> vn>constant ] bi ]
[ src2>> ]
[ ]
} cleave constant-fold*
] dip
2dup immediate? [ new-insn ] [ 2drop 2drop f ] if ; inline
M: ##add-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
{ [ dup src1>> vreg>expr add-imm-expr? ] [ \ ##add-imm reassociate ] }
[ drop f ]
} cond ;
: sub-imm>add-imm ( insn -- insn' )
[ dst>> ] [ src1>> ] [ src2>> neg ] tri dup immediate-arithmetic?
[ \ ##add-imm new-insn ] [ 3drop f ] if ;
M: ##sub-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
[ sub-imm>add-imm ]
} cond ;
: mul-to-neg? ( insn -- ? )
src2>> -1 = ;
: mul-to-neg ( insn -- insn' )
[ dst>> ] [ src1>> ] bi \ ##neg new-insn ;
: mul-to-shl? ( insn -- ? )
src2>> power-of-2? ;
: mul-to-shl ( insn -- insn' )
[ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi \ ##shl-imm new-insn ;
M: ##mul-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
{ [ dup mul-to-neg? ] [ mul-to-neg ] }
{ [ dup mul-to-shl? ] [ mul-to-shl ] }
{ [ dup src1>> vreg>expr mul-imm-expr? ] [ \ ##mul-imm reassociate ] }
[ drop f ]
} cond ;
M: ##and-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
{ [ dup src1>> vreg>expr and-imm-expr? ] [ \ ##and-imm reassociate ] }
[ drop f ]
} cond ;
M: ##or-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
{ [ dup src1>> vreg>expr or-imm-expr? ] [ \ ##or-imm reassociate ] }
[ drop f ]
} cond ;
M: ##xor-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
{ [ dup src1>> vreg>expr xor-imm-expr? ] [ \ ##xor-imm reassociate ] }
[ drop f ]
} cond ;
M: ##shl-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
[ drop f ]
} cond ;
M: ##shr-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
[ drop f ]
} cond ;
M: ##sar-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
[ drop f ]
} cond ;
: insn>imm-insn ( insn op swap? -- new-insn )
swap [
[ [ dst>> ] [ src1>> ] [ src2>> ] tri ] dip
[ swap ] when vreg>constant
] dip new-insn ; inline
: vreg-immediate? ( vreg op -- ? )
arithmetic-op?
[ vreg-immediate-arithmetic? ] [ vreg-immediate-bitwise? ] if ;
: rewrite-arithmetic ( insn op -- insn/f )
{
{ [ over src2>> over vreg-immediate? ] [ f insn>imm-insn ] }
[ 2drop f ]
} cond ; inline
: rewrite-arithmetic-commutative ( insn op -- insn/f )
{
{ [ over src2>> over vreg-immediate? ] [ f insn>imm-insn ] }
{ [ over src1>> over vreg-immediate? ] [ t insn>imm-insn ] }
[ 2drop f ]
} cond ; inline
M: ##add rewrite \ ##add-imm rewrite-arithmetic-commutative ;
: subtraction-identity? ( insn -- ? )
[ src1>> ] [ src2>> ] bi [ vreg>vn ] bi@ eq? ;
: rewrite-subtraction-identity ( insn -- insn' )
dst>> 0 \ ##load-immediate new-insn ;
: sub-to-neg? ( ##sub -- ? )
src1>> vn>expr expr-zero? ;
: sub-to-neg ( ##sub -- insn )
[ dst>> ] [ src2>> ] bi \ ##neg new-insn ;
M: ##sub rewrite
{
{ [ dup sub-to-neg? ] [ sub-to-neg ] }
{ [ dup subtraction-identity? ] [ rewrite-subtraction-identity ] }
[ \ ##sub-imm rewrite-arithmetic ]
} cond ;
M: ##mul rewrite \ ##mul-imm rewrite-arithmetic-commutative ;
M: ##and rewrite \ ##and-imm rewrite-arithmetic-commutative ;
M: ##or rewrite \ ##or-imm rewrite-arithmetic-commutative ;
M: ##xor rewrite \ ##xor-imm rewrite-arithmetic-commutative ;
M: ##shl rewrite \ ##shl-imm rewrite-arithmetic ;
M: ##shr rewrite \ ##shr-imm rewrite-arithmetic ;
M: ##sar rewrite \ ##sar-imm rewrite-arithmetic ;
! ##box-displaced-alien f 1 2 3 <class>
! ##unbox-c-ptr 4 1 <class>
! =>
! ##box-displaced-alien f 1 2 3 <class>
! ##unbox-c-ptr 5 3 <class>
! ##add 4 5 2
:: rewrite-unbox-displaced-alien ( insn expr -- insns )
[
next-vreg :> temp
temp expr base>> vn>vreg expr base-class>> ##unbox-c-ptr
insn dst>> temp expr displacement>> vn>vreg ##add
] { } make ;
M: ##unbox-any-c-ptr rewrite
dup src>> vreg>expr dup box-displaced-alien-expr?
[ rewrite-unbox-displaced-alien ] [ 2drop f ] if ;
! More efficient addressing for alien intrinsics
: rewrite-alien-addressing ( insn -- insn' )
dup src>> vreg>expr dup add-imm-expr? [
[ src1>> vn>vreg ] [ src2>> vn>constant ] bi
[ >>src ] [ '[ _ + ] change-offset ] bi*
] [ 2drop f ] if ;
M: ##alien-unsigned-1 rewrite rewrite-alien-addressing ;
M: ##alien-unsigned-2 rewrite rewrite-alien-addressing ;
M: ##alien-unsigned-4 rewrite rewrite-alien-addressing ;
M: ##alien-signed-1 rewrite rewrite-alien-addressing ;
M: ##alien-signed-2 rewrite rewrite-alien-addressing ;
M: ##alien-signed-4 rewrite rewrite-alien-addressing ;
M: ##alien-float rewrite rewrite-alien-addressing ;
M: ##alien-double rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-1 rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-2 rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-4 rewrite rewrite-alien-addressing ;
M: ##set-alien-float rewrite rewrite-alien-addressing ;
M: ##set-alien-double rewrite rewrite-alien-addressing ;

11
basis/compiler/cfg/value-numbering/simd/simd.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit arrays
fry kernel layouts math namespaces sequences cpu.architecture
@ -9,6 +9,7 @@ compiler.cfg
compiler.cfg.registers
compiler.cfg.comparisons
compiler.cfg.instructions
compiler.cfg.value-numbering.alien
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.rewrite
@ -34,19 +35,18 @@ M: ##set-alien-vector rewrite rewrite-alien-addressing ;
: fold-shuffle-vector-imm ( insn expr -- insn' )
[ [ dst>> ] [ shuffle>> ] bi ] dip value>>
(fold-shuffle-vector-imm) \ ##load-constant new-insn ;
(fold-shuffle-vector-imm) \ ##load-reference new-insn ;
M: ##shuffle-vector-imm rewrite
dup src>> vreg>expr {
{ [ dup shuffle-vector-imm-expr? ] [ rewrite-shuffle-vector-imm ] }
{ [ dup reference-expr? ] [ fold-shuffle-vector-imm ] }
{ [ dup constant-expr? ] [ fold-shuffle-vector-imm ] }
[ 2drop f ]
} cond ;
: (fold-scalar>vector) ( insn bytes -- insn' )
[ [ dst>> ] [ rep>> rep-length ] bi ] dip <repetition> concat
\ ##load-constant new-insn ;
\ ##load-reference new-insn ;
: fold-scalar>vector ( insn expr -- insn' )
value>> over rep>> {
@ -56,7 +56,7 @@ M: ##shuffle-vector-imm rewrite
} case ;
M: ##scalar>vector rewrite
dup src>> vreg>expr dup constant-expr?
dup src>> vreg>expr dup reference-expr?
[ fold-scalar>vector ] [ 2drop f ] if ;
M: ##xor-vector rewrite
@ -117,4 +117,3 @@ M: scalar>vector-expr simplify*
M: shuffle-vector-imm-expr simplify*
[ src>> ] [ shuffle>> ] [ rep>> rep-length iota ] tri
sequence= [ drop f ] unless ;

15
basis/compiler/cfg/value-numbering/simplify/simplify.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors combinators classes math layouts
sequences
@ -19,11 +19,9 @@ M: unbox-alien-expr simplify* simplify-unbox-alien ;
M: unbox-any-c-ptr-expr simplify* simplify-unbox-alien ;
: expr-zero? ( expr -- ? ) T{ constant-expr f 0 } = ; inline
: expr-one? ( expr -- ? ) T{ constant-expr f 1 } = ; inline
: expr-neg-one? ( expr -- ? ) T{ constant-expr f -1 } = ; inline
: expr-zero? ( expr -- ? ) T{ integer-expr f 0 } = ; inline
: expr-one? ( expr -- ? ) T{ integer-expr f 1 } = ; inline
: expr-neg-one? ( expr -- ? ) T{ integer-expr f -1 } = ; inline
: >unary-expr< ( expr -- in ) src>> vn>expr ; inline
@ -101,13 +99,8 @@ M: or-imm-expr simplify* simplify-or ;
M: xor-expr simplify* simplify-xor ;
M: xor-imm-expr simplify* simplify-xor ;
: useless-shr? ( in1 in2 -- ? )
over shl-imm-expr?
[ [ src2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline
: simplify-shr ( expr -- vn/expr/f )
>binary-expr< {
{ [ 2dup useless-shr? ] [ drop src1>> ] }
{ [ dup expr-zero? ] [ drop ] }
[ 2drop f ]
} cond ; inline

724
basis/compiler/cfg/value-numbering/value-numbering-tests.factor
View File

File diff suppressed because it is too large Load Diff

9
basis/compiler/cfg/value-numbering/value-numbering.factor
View File

@ -8,10 +8,13 @@ compiler.cfg
compiler.cfg.rpo
compiler.cfg.def-use
compiler.cfg.instructions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.alien
compiler.cfg.value-numbering.comparisons
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.simplify
compiler.cfg.value-numbering.rewrite ;
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.math
compiler.cfg.value-numbering.rewrite
compiler.cfg.value-numbering.simplify ;
IN: compiler.cfg.value-numbering
! Local value numbering.

5
basis/compiler/codegen/codegen.factor
View File

@ -78,9 +78,9 @@ SYNTAX: CODEGEN:
codegen-method-body define ;
>>
CODEGEN: ##load-immediate %load-immediate
CODEGEN: ##load-integer %load-immediate
CODEGEN: ##load-tagged %load-immediate
CODEGEN: ##load-reference %load-reference
CODEGEN: ##load-constant %load-reference
CODEGEN: ##load-double %load-double
CODEGEN: ##peek %peek
CODEGEN: ##replace %replace
@ -119,6 +119,7 @@ CODEGEN: ##not %not
CODEGEN: ##neg %neg
CODEGEN: ##log2 %log2
CODEGEN: ##copy %copy
CODEGEN: ##tagged>integer %copy
CODEGEN: ##add-float %add-float
CODEGEN: ##sub-float %sub-float
CODEGEN: ##mul-float %mul-float

2
basis/cpu/x86/x86.factor
View File

@ -1457,7 +1457,7 @@ M: x86 immediate-bitwise? ( n -- ? )
frame-reg swap 2 cells + [+] ;
enable-min/max
enable-fixnum-log2
enable-log2
:: install-sse2-check ( -- )
[