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

add compiler comparison codes for floating-point unordered comparisons; update x86 backend to generate proper code for all floating-point comparisons

db4
Joe Groff 2009-09-03 20:32:05 -05:00
parent 1bc97b4624
commit 036ff77306
3 changed files with 133 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
basis/compiler/cfg/comparisons/comparisons.factor
View File

@ -3,34 +3,81 @@
USING: assocs math.order sequences ; USING: assocs math.order sequences ;
IN: compiler.cfg.comparisons IN: compiler.cfg.comparisons
SYMBOLS: cc< cc<= cc= cc> cc>= cc/= ; SYMBOL: +unordered+
SYMBOLS:
cc< cc<= cc= cc> cc>= cc<> cc<>=
cc/< cc/<= cc/= cc/> cc/>= cc/<> cc/<>= ;
: negate-cc ( cc -- cc' ) : negate-cc ( cc -- cc' )
H{ H{
{ cc< cc>= } { cc< cc/< }
{ cc<= cc> } { cc<= cc/<= }
{ cc> cc<= } { cc> cc/> }
{ cc>= cc< } { cc>= cc/>= }
{ cc= cc/= } { cc= cc/= }
{ cc/= cc= } { cc<> cc/<> }
{ cc<>= cc/<>= }
{ cc/< cc< }
{ cc/<= cc<= }
{ cc/> cc> }
{ cc/>= cc>= }
{ cc/= cc= }
{ cc/<> cc<> }
{ cc/<>= cc<>= }
} at ; } at ;
: swap-cc ( cc -- cc' ) : swap-cc ( cc -- cc' )
H{ H{
{ cc< cc> } { cc< cc> }
{ cc<= cc>= } { cc<= cc>= }
{ cc> cc< } { cc> cc< }
{ cc>= cc<= } { cc>= cc<= }
{ cc= cc= } { cc= cc= }
{ cc/= cc/= } { cc<> cc<> }
{ cc<>= cc<>= }
{ cc/< cc/> }
{ cc/<= cc/>= }
{ cc/> cc/< }
{ cc/>= cc/<= }
{ cc/= cc/= }
{ cc/<> cc/<> }
{ cc/<>= cc/<>= }
} at ;
: order-cc ( cc -- cc' )
H{
{ cc< cc< }
{ cc<= cc<= }
{ cc> cc> }
{ cc>= cc>= }
{ cc= cc= }
{ cc<> cc/= }
{ cc<>= t }
{ cc/< cc>= }
{ cc/<= cc> }
{ cc/> cc<= }
{ cc/>= cc< }
{ cc/= cc/= }
{ cc/<> cc= }
{ cc/<>= f }
} at ; } at ;
: evaluate-cc ( result cc -- ? ) : evaluate-cc ( result cc -- ? )
H{ H{
{ cc< { +lt+ } } { cc< { +lt+ } }
{ cc<= { +lt+ +eq+ } } { cc<= { +lt+ +eq+ } }
{ cc= { +eq+ } } { cc= { +eq+ } }
{ cc>= { +eq+ +gt+ } } { cc>= { +eq+ +gt+ } }
{ cc> { +gt+ } } { cc> { +gt+ } }
{ cc/= { +lt+ +gt+ } } { cc<> { +lt+ +gt+ } }
} at memq? ; { cc<>= { +lt+ +eq+ +gt+ } }
{ cc/< { +eq+ +gt+ +unordered+ } }
{ cc/<= { +gt+ +unordered+ } }
{ cc/= { +lt+ +gt+ +unordered+ } }
{ cc/>= { +lt+ +unordered+ } }
{ cc/> { +lt+ +eq+ +unordered+ } }
{ cc/<> { +eq+ +unordered+ } }
{ cc/<>= { +unordered+ } }
} at memq? ;

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

@ -501,7 +501,7 @@ M: ppc %epilogue ( n -- )
"end" get resolve-label ; inline "end" get resolve-label ; inline
: %boolean ( dst temp cc -- ) : %boolean ( dst temp cc -- )
negate-cc { negate-cc order-cc {
{ cc< [ \ BLT (%boolean) ] } { cc< [ \ BLT (%boolean) ] }
{ cc<= [ \ BLE (%boolean) ] } { cc<= [ \ BLE (%boolean) ] }
{ cc> [ \ BGT (%boolean) ] } { cc> [ \ BGT (%boolean) ] }
@ -519,7 +519,7 @@ M: ppc %compare-imm (%compare-imm) %boolean ;
M: ppc %compare-float (%compare-float) %boolean ; M: ppc %compare-float (%compare-float) %boolean ;
: %branch ( label cc -- ) : %branch ( label cc -- )
{ order-cc {
{ cc< [ BLT ] } { cc< [ BLT ] }
{ cc<= [ BLE ] } { cc<= [ BLE ] }
{ cc> [ BGT ] } { cc> [ BGT ] }

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

@ -512,7 +512,7 @@ M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
dst temp word execute ; inline dst temp word execute ; inline
M: x86 %compare ( dst temp cc src1 src2 -- ) M: x86 %compare ( dst temp cc src1 src2 -- )
CMP { CMP order-cc {
{ cc< [ \ CMOVL %boolean ] } { cc< [ \ CMOVL %boolean ] }
{ cc<= [ \ CMOVLE %boolean ] } { cc<= [ \ CMOVLE %boolean ] }
{ cc> [ \ CMOVG %boolean ] } { cc> [ \ CMOVG %boolean ] }
@ -524,18 +524,47 @@ M: x86 %compare ( dst temp cc src1 src2 -- )
M: x86 %compare-imm ( dst temp cc src1 src2 -- ) M: x86 %compare-imm ( dst temp cc src1 src2 -- )
%compare ; %compare ;
: %cmov-float= ( dst src -- )
[
"no-move" define-label
"no-move" get [ JNE ] [ JP ] bi
MOV
"no-move" resolve-label
] with-scope ;
: %cmov-float/= ( dst src -- )
[
"no-move" define-label
"move" define-label
"move" get JP
"no-move" get JE
"move" resolve-label
MOV
"no-move" resolve-label
] with-scope ;
M: x86 %compare-float ( dst temp cc src1 src2 -- ) M: x86 %compare-float ( dst temp cc src1 src2 -- )
UCOMISD { rot {
{ cc< [ \ CMOVB %boolean ] } { cc< [ swap UCOMISD \ CMOVA %boolean ] }
{ cc<= [ \ CMOVBE %boolean ] } { cc<= [ swap UCOMISD \ CMOVAE %boolean ] }
{ cc> [ \ CMOVA %boolean ] } { cc> [ UCOMISD \ CMOVA %boolean ] }
{ cc>= [ \ CMOVAE %boolean ] } { cc>= [ UCOMISD \ CMOVAE %boolean ] }
{ cc= [ \ CMOVE %boolean ] } { cc= [ COMISD \ %cmov-float= %boolean ] }
{ cc/= [ \ CMOVNE %boolean ] } { cc<> [ UCOMISD \ CMOVNE %boolean ] }
{ cc<>= [ UCOMISD \ CMOVNP %boolean ] }
{ cc/< [ swap COMISD \ CMOVBE %boolean ] }
{ cc/<= [ swap COMISD \ CMOVB %boolean ] }
{ cc/> [ COMISD \ CMOVBE %boolean ] }
{ cc/>= [ COMISD \ CMOVB %boolean ] }
{ cc/= [ COMISD \ %cmov-float/= %boolean ] }
{ cc/<> [ COMISD \ CMOVE %boolean ] }
{ cc/<>= [ COMISD \ CMOVP %boolean ] }
} case ; } case ;
M: x86 %compare-branch ( label cc src1 src2 -- ) M: x86 %compare-branch ( label cc src1 src2 -- )
CMP { CMP order-cc {
{ cc< [ JL ] } { cc< [ JL ] }
{ cc<= [ JLE ] } { cc<= [ JLE ] }
{ cc> [ JG ] } { cc> [ JG ] }
@ -547,14 +576,33 @@ M: x86 %compare-branch ( label cc src1 src2 -- )
M: x86 %compare-imm-branch ( label src1 src2 cc -- ) M: x86 %compare-imm-branch ( label src1 src2 cc -- )
%compare-branch ; %compare-branch ;
: %jump-float= ( label -- )
[
"no-jump" define-label
"no-jump" get JP
JE
"no-jump" resolve-label
] with-scope ;
: %jump-float/= ( label -- )
[ JNE ] [ JP ] bi ;
M: x86 %compare-float-branch ( label cc src1 src2 -- ) M: x86 %compare-float-branch ( label cc src1 src2 -- )
UCOMISD { rot {
{ cc< [ JB ] } { cc< [ swap UCOMISD JA ] }
{ cc<= [ JBE ] } { cc<= [ swap UCOMISD JAE ] }
{ cc> [ JA ] } { cc> [ UCOMISD JA ] }
{ cc>= [ JAE ] } { cc>= [ UCOMISD JAE ] }
{ cc= [ JE ] } { cc= [ COMISD %jump-float= ] }
{ cc/= [ JNE ] } { cc<> [ UCOMISD JNE ] }
{ cc<>= [ UCOMISD JNP ] }
{ cc/< [ swap COMISD JBE ] }
{ cc/<= [ swap COMISD JB ] }
{ cc/> [ COMISD JBE ] }
{ cc/>= [ COMISD JB ] }
{ cc/= [ COMISD %jump-float/= ] } ! XXX
{ cc/<> [ COMISD JE ] }
{ cc/<>= [ COMISD JP ] }
} case ; } case ;
M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ; M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ;