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

split unordered and ordered float comparison intrinsics in compiler; generate only unordered comparisons for now

db4
Joe Groff 2009-09-08 17:04:26 -05:00
parent c45fddec6d
commit 0ea9949e51
11 changed files with 131 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/compiler/cfg/checker/checker.factor
View File

@ -23,7 +23,8 @@ ERROR: last-insn-not-a-jump bb ;
[ ##dispatch? ]
[ ##compare-branch? ]
[ ##compare-imm-branch? ]
[ ##compare-float-branch? ]
[ ##compare-float-ordered-branch? ]
[ ##compare-float-unordered-branch? ]
[ ##fixnum-add? ]
[ ##fixnum-sub? ]
[ ##fixnum-mul? ]

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

@ -496,11 +496,21 @@ constant: src2
literal: cc
temp: temp/int-rep ;
INSN: ##compare-float-branch
INSN: ##compare-float-ordered-branch
use: src1/double-rep src2/double-rep
literal: cc ;
PURE-INSN: ##compare-float
INSN: ##compare-float-unordered-branch
use: src1/double-rep src2/double-rep
literal: cc ;
PURE-INSN: ##compare-float-ordered
def: dst/int-rep
use: src1/double-rep src2/double-rep
literal: cc
temp: temp/int-rep ;
PURE-INSN: ##compare-float-unordered
def: dst/int-rep
use: src1/double-rep src2/double-rep
literal: cc
@ -556,7 +566,12 @@ use: src1/int-rep
constant: src2
literal: cc ;
INSN: _compare-float-branch
INSN: _compare-float-unordered-branch
literal: label
use: src1/int-rep src2/int-rep
literal: cc ;
INSN: _compare-float-ordered-branch
literal: label
use: src1/int-rep src2/int-rep
literal: cc ;

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

@ -8,7 +8,7 @@ IN: compiler.cfg.intrinsics.float
[ 2inputs ] dip call ds-push ; inline
: emit-float-comparison ( cc -- )
[ 2inputs ] dip ^^compare-float ds-push ; inline
[ 2inputs ] dip ^^compare-float-unordered ds-push ; inline
: emit-float>fixnum ( -- )
ds-pop ^^float>integer ^^tag-fixnum ds-push ;

7
basis/compiler/cfg/linearization/linearization.factor
View File

@ -57,8 +57,11 @@ M: ##compare-branch linearize-insn
M: ##compare-imm-branch linearize-insn
binary-conditional _compare-imm-branch emit-branch ;
M: ##compare-float-branch linearize-insn
binary-conditional _compare-float-branch emit-branch ;
M: ##compare-float-ordered-branch linearize-insn
binary-conditional _compare-float-ordered-branch emit-branch ;
M: ##compare-float-unordered-branch linearize-insn
binary-conditional _compare-float-unordered-branch emit-branch ;
: overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 )
[ dup successors block-number ]

9
basis/compiler/cfg/useless-conditionals/useless-conditionals.factor
View File

@ -7,7 +7,14 @@ IN: compiler.cfg.useless-conditionals
: delete-conditional? ( bb -- ? )
{
[ instructions>> last class { ##compare-branch ##compare-imm-branch ##compare-float-branch } memq? ]
[
instructions>> last class {
##compare-branch
##compare-imm-branch
##compare-float-ordered-branch
##compare-float-unordered-branch
} memq?
]
[ successors>> first2 [ skip-empty-blocks ] bi@ eq? ]
} 1&& ;

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

@ -33,7 +33,12 @@ M: insn rewrite drop f ;
] [ drop f ] if ; inline
: general-compare-expr? ( insn -- ? )
{ [ compare-expr? ] [ compare-imm-expr? ] [ compare-float-expr? ] } 1|| ;
{
[ compare-expr? ]
[ compare-imm-expr? ]
[ compare-float-unordered-expr? ]
[ compare-float-ordered-expr? ]
} 1|| ;
: rewrite-boolean-comparison? ( insn -- ? )
dup ##branch-t? [
@ -50,7 +55,8 @@ M: insn rewrite drop f ;
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-expr? ] [ >compare-expr< \ ##compare-float-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 ] }
} cond ;
: tag-fixnum-expr? ( expr -- ? )
@ -93,7 +99,8 @@ M: ##compare-imm rewrite-tagged-comparison
[ 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-expr? ] [ >compare-expr< next-vreg \ ##compare-float 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 ;

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

@ -12,7 +12,8 @@ IN: compiler.cfg.value-numbering.tests
dup {
[ ##compare? ]
[ ##compare-imm? ]
[ ##compare-float? ]
[ ##compare-float-unordered? ]
[ ##compare-float-ordered? ]
} 1|| [ f >>temp ] when
] map ;
@ -108,8 +109,8 @@ IN: compiler.cfg.value-numbering.tests
T{ ##peek f 9 D -1 }
T{ ##unbox-float f 10 8 }
T{ ##unbox-float f 11 9 }
T{ ##compare-float f 12 10 11 cc< }
T{ ##compare-float f 14 10 11 cc/< }
T{ ##compare-float-unordered f 12 10 11 cc< }
T{ ##compare-float-unordered f 14 10 11 cc/< }
T{ ##replace f 14 D 0 }
}
] [
@ -118,7 +119,7 @@ IN: compiler.cfg.value-numbering.tests
T{ ##peek f 9 D -1 }
T{ ##unbox-float f 10 8 }
T{ ##unbox-float f 11 9 }
T{ ##compare-float f 12 10 11 cc< }
T{ ##compare-float-unordered f 12 10 11 cc< }
T{ ##compare-imm f 14 12 5 cc= }
T{ ##replace f 14 D 0 }
} value-numbering-step trim-temps

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

@ -199,7 +199,8 @@ CODEGEN: ##allot %allot
CODEGEN: ##write-barrier %write-barrier
CODEGEN: ##compare %compare
CODEGEN: ##compare-imm %compare-imm
CODEGEN: ##compare-float %compare-float
CODEGEN: ##compare-float-ordered %compare-float-ordered
CODEGEN: ##compare-float-unordered %compare-float-unordered
CODEGEN: _fixnum-add %fixnum-add
CODEGEN: _fixnum-sub %fixnum-sub
@ -208,7 +209,8 @@ CODEGEN: _label resolve-label
CODEGEN: _branch %jump-label
CODEGEN: _compare-branch %compare-branch
CODEGEN: _compare-imm-branch %compare-imm-branch
CODEGEN: _compare-float-branch %compare-float-branch
CODEGEN: _compare-float-ordered-branch %compare-float-ordered-branch
CODEGEN: _compare-float-unordered-branch %compare-float-unordered-branch
CODEGEN: _dispatch %dispatch
CODEGEN: _spill %spill
CODEGEN: _reload %reload

6
basis/cpu/architecture/architecture.factor
View File

@ -217,11 +217,13 @@ HOOK: %epilogue cpu ( n -- )
HOOK: %compare cpu ( dst temp cc src1 src2 -- )
HOOK: %compare-imm cpu ( dst temp cc src1 src2 -- )
HOOK: %compare-float cpu ( dst temp cc src1 src2 -- )
HOOK: %compare-float-ordered cpu ( dst temp cc src1 src2 -- )
HOOK: %compare-float-unordered cpu ( dst temp cc src1 src2 -- )
HOOK: %compare-branch cpu ( label cc src1 src2 -- )
HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- )
HOOK: %compare-float-branch cpu ( label cc src1 src2 -- )
HOOK: %compare-float-ordered-branch cpu ( label cc src1 src2 -- )
HOOK: %compare-float-unordered-branch cpu ( label cc src1 src2 -- )
HOOK: %spill cpu ( src rep n -- )
HOOK: %reload cpu ( dst rep n -- )

50
basis/cpu/ppc/ppc.factor
View File

@ -516,30 +516,33 @@ M: ppc %epilogue ( n -- )
: (%compare-float-unordered) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
: (%compare-float-ordered) ( src1 src2 -- ) [ 0 ] dip FCMPO ; inline
:: (%compare-float) ( src1 src2 cc -- branch1 branch2 )
:: (%compare-float) ( src1 src2 cc compare -- branch1 branch2 )
cc {
{ cc< [ src1 src2 (%compare-float-ordered) \ BLT f ] }
{ cc<= [ src1 src2 (%compare-float-ordered) \ BLT \ BEQ ] }
{ cc> [ src1 src2 (%compare-float-ordered) \ BGT f ] }
{ cc>= [ src1 src2 (%compare-float-ordered) \ BGT \ BEQ ] }
{ cc= [ src1 src2 (%compare-float-unordered) \ BEQ f ] }
{ cc<> [ src1 src2 (%compare-float-ordered) \ BLT \ BGT ] }
{ cc<>= [ src1 src2 (%compare-float-ordered) \ BNO f ] }
{ cc/< [ src1 src2 (%compare-float-unordered) \ BGE f ] }
{ cc/<= [ src1 src2 (%compare-float-unordered) \ BGT \ BO ] }
{ cc/> [ src1 src2 (%compare-float-unordered) \ BLE f ] }
{ cc/>= [ src1 src2 (%compare-float-unordered) \ BLT \ BO ] }
{ cc/= [ src1 src2 (%compare-float-unordered) \ BNE f ] }
{ cc/<> [ src1 src2 (%compare-float-unordered) \ BEQ \ BO ] }
{ cc/<>= [ src1 src2 (%compare-float-unordered) \ BO f ] }
{ cc< [ src1 src2 \ compare execute( a b -- ) \ BLT f ] }
{ cc<= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BEQ ] }
{ cc> [ src1 src2 \ compare execute( a b -- ) \ BGT f ] }
{ cc>= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BEQ ] }
{ cc= [ src1 src2 \ compare execute( a b -- ) \ BEQ f ] }
{ cc<> [ src1 src2 \ compare execute( a b -- ) \ BLT \ BGT ] }
{ cc<>= [ src1 src2 \ compare execute( a b -- ) \ BNO f ] }
{ cc/< [ src1 src2 \ compare execute( a b -- ) \ BGE f ] }
{ cc/<= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BO ] }
{ cc/> [ src1 src2 \ compare execute( a b -- ) \ BLE f ] }
{ cc/>= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BO ] }
{ cc/= [ src1 src2 \ compare execute( a b -- ) \ BNE f ] }
{ cc/<> [ src1 src2 \ compare execute( a b -- ) \ BEQ \ BO ] }
{ cc/<>= [ src1 src2 \ compare execute( a b -- ) \ BO f ] }
} case ; inline
M: ppc %compare [ (%compare) ] 2dip %boolean ;
M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
M:: ppc %compare-float ( dst src1 src2 cc temp -- )
cc negate-cc src1 src2 (%compare-float) :> branch2 :> branch1
M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- )
src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
dst temp branch1 branch2 (%boolean) ;
M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- )
src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
dst temp branch1 branch2 (%boolean) ;
:: %branch ( label cc -- )
@ -556,10 +559,17 @@ M: ppc %compare-branch [ (%compare) ] 2dip %branch ;
M: ppc %compare-imm-branch [ (%compare-imm) ] 2dip %branch ;
M:: ppc %compare-float-branch ( label src1 src2 cc -- )
cc src1 src2 (%compare-float) :> branch2 :> branch1
:: (%branch) ( label branch1 branch2 -- )
label branch1 execute( label -- )
branch2 [ label branch2 execute( label -- ) ] when ;
branch2 [ label branch2 execute( label -- ) ] when ; inline
M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- )
cc src1 src2 \ (%compare-float-ordered) \ (%compare-float) :> branch2 :> branch1
label branch1 branch2 (%branch) ;
M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
cc src1 src2 \ (%compare-float-unordered) \ (%compare-float) :> branch2 :> branch1
label branch1 branch2 (%branch) ;
: load-from-frame ( dst n rep -- )
{

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

@ -658,23 +658,29 @@ M: x86 %compare-imm ( dst src1 src2 cc temp -- )
"no-move" resolve-label
] with-scope ;
M:: x86 %compare-float ( dst src1 src2 cc temp -- )
:: (%compare-float) ( dst src1 src2 cc temp compare -- )
cc {
{ cc< [ src2 src1 COMISD dst temp \ CMOVA %boolean ] }
{ cc<= [ src2 src1 COMISD dst temp \ CMOVAE %boolean ] }
{ cc> [ src1 src2 COMISD dst temp \ CMOVA %boolean ] }
{ cc>= [ src1 src2 COMISD dst temp \ CMOVAE %boolean ] }
{ cc= [ src1 src2 UCOMISD dst temp \ %cmov-float= %boolean ] }
{ cc<> [ src1 src2 COMISD dst temp \ CMOVNE %boolean ] }
{ cc<>= [ src1 src2 COMISD dst temp \ CMOVNP %boolean ] }
{ cc/< [ src2 src1 UCOMISD dst temp \ CMOVBE %boolean ] }
{ cc/<= [ src2 src1 UCOMISD dst temp \ CMOVB %boolean ] }
{ cc/> [ src1 src2 UCOMISD dst temp \ CMOVBE %boolean ] }
{ cc/>= [ src1 src2 UCOMISD dst temp \ CMOVB %boolean ] }
{ cc/= [ src1 src2 UCOMISD dst temp \ %cmov-float/= %boolean ] }
{ cc/<> [ src1 src2 UCOMISD dst temp \ CMOVE %boolean ] }
{ cc/<>= [ src1 src2 UCOMISD dst temp \ CMOVP %boolean ] }
} case ;
{ cc< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
{ cc<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
{ cc> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
{ cc>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
{ cc= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float= %boolean ] }
{ cc<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNE %boolean ] }
{ cc<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNP %boolean ] }
{ cc/< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
{ cc/<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
{ cc/> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
{ cc/>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
{ cc/= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float/= %boolean ] }
{ cc/<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVE %boolean ] }
{ cc/<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVP %boolean ] }
} case ; inline
M: x86 %compare-float-ordered ( dst src1 src2 cc temp -- )
\ COMISD (%compare-float) ;
M: x86 %compare-float-unordered ( dst src1 src2 cc temp -- )
\ UCOMISD (%compare-float) ;
M:: x86 %compare-branch ( label src1 src2 cc -- )
src1 src2 CMP
@ -701,24 +707,30 @@ M: x86 %compare-imm-branch ( label src1 src2 cc -- )
: %jump-float/= ( label -- )
[ JNE ] [ JP ] bi ;
M:: x86 %compare-float-branch ( label src1 src2 cc -- )
:: (%compare-float-branch) ( label src1 src2 cc compare -- )
cc {
{ cc< [ src2 src1 COMISD label JA ] }
{ cc<= [ src2 src1 COMISD label JAE ] }
{ cc> [ src1 src2 COMISD label JA ] }
{ cc>= [ src1 src2 COMISD label JAE ] }
{ cc= [ src1 src2 UCOMISD label %jump-float= ] }
{ cc<> [ src1 src2 COMISD label JNE ] }
{ cc<>= [ src1 src2 COMISD label JNP ] }
{ cc/< [ src2 src1 UCOMISD label JBE ] }
{ cc/<= [ src2 src1 UCOMISD label JB ] }
{ cc/> [ src1 src2 UCOMISD label JBE ] }
{ cc/>= [ src1 src2 UCOMISD label JB ] }
{ cc/= [ src1 src2 UCOMISD label %jump-float/= ] }
{ cc/<> [ src1 src2 UCOMISD label JE ] }
{ cc/<>= [ src1 src2 UCOMISD label JP ] }
{ cc< [ src2 src1 \ compare execute( a b -- ) label JA ] }
{ cc<= [ src2 src1 \ compare execute( a b -- ) label JAE ] }
{ cc> [ src1 src2 \ compare execute( a b -- ) label JA ] }
{ cc>= [ src1 src2 \ compare execute( a b -- ) label JAE ] }
{ cc= [ src1 src2 \ compare execute( a b -- ) label %jump-float= ] }
{ cc<> [ src1 src2 \ compare execute( a b -- ) label JNE ] }
{ cc<>= [ src1 src2 \ compare execute( a b -- ) label JNP ] }
{ cc/< [ src2 src1 \ compare execute( a b -- ) label JBE ] }
{ cc/<= [ src2 src1 \ compare execute( a b -- ) label JB ] }
{ cc/> [ src1 src2 \ compare execute( a b -- ) label JBE ] }
{ cc/>= [ src1 src2 \ compare execute( a b -- ) label JB ] }
{ cc/= [ src1 src2 \ compare execute( a b -- ) label %jump-float/= ] }
{ cc/<> [ src1 src2 \ compare execute( a b -- ) label JE ] }
{ cc/<>= [ src1 src2 \ compare execute( a b -- ) label JP ] }
} case ;
M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
\ COMISD (%compare-float-branch) ;
M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
\ UCOMISD (%compare-float-branch) ;
M:: x86 %spill ( src rep n -- )
n spill@ src rep copy-register ;