From 036ff77306f6034f179a9ba7df94b895ec37bf73 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 3 Sep 2009 20:32:05 -0500 Subject: [PATCH] add compiler comparison codes for floating-point unordered comparisons; update x86 backend to generate proper code for all floating-point comparisons --- .../cfg/comparisons/comparisons.factor | 87 ++++++++++++++----- basis/cpu/ppc/ppc.factor | 4 +- basis/cpu/x86/x86.factor | 80 +++++++++++++---- 3 files changed, 133 insertions(+), 38 deletions(-) diff --git a/basis/compiler/cfg/comparisons/comparisons.factor b/basis/compiler/cfg/comparisons/comparisons.factor index 576d541230..e7c19e7206 100644 --- a/basis/compiler/cfg/comparisons/comparisons.factor +++ b/basis/compiler/cfg/comparisons/comparisons.factor @@ -3,34 +3,81 @@ USING: assocs math.order sequences ; 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' ) 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 ; : swap-cc ( cc -- cc' ) 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 ; : evaluate-cc ( result cc -- ? ) H{ - { cc< { +lt+ } } - { cc<= { +lt+ +eq+ } } - { cc= { +eq+ } } - { cc>= { +eq+ +gt+ } } - { cc> { +gt+ } } - { cc/= { +lt+ +gt+ } } - } at memq? ; \ No newline at end of file + { cc< { +lt+ } } + { cc<= { +lt+ +eq+ } } + { cc= { +eq+ } } + { cc>= { +eq+ +gt+ } } + { cc> { +gt+ } } + { cc<> { +lt+ +gt+ } } + { 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? ; + diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 20d1adcd6f..11c8a7ab1e 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -501,7 +501,7 @@ M: ppc %epilogue ( n -- ) "end" get resolve-label ; inline : %boolean ( dst temp cc -- ) - negate-cc { + negate-cc order-cc { { cc< [ \ BLT (%boolean) ] } { cc<= [ \ BLE (%boolean) ] } { cc> [ \ BGT (%boolean) ] } @@ -519,7 +519,7 @@ M: ppc %compare-imm (%compare-imm) %boolean ; M: ppc %compare-float (%compare-float) %boolean ; : %branch ( label cc -- ) - { + order-cc { { cc< [ BLT ] } { cc<= [ BLE ] } { cc> [ BGT ] } diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 630be55c67..c6c542e2bb 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -512,7 +512,7 @@ M: x86 %epilogue ( n -- ) cell - incr-stack-reg ; dst temp word execute ; inline M: x86 %compare ( dst temp cc src1 src2 -- ) - CMP { + CMP order-cc { { cc< [ \ CMOVL %boolean ] } { cc<= [ \ CMOVLE %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 -- ) %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 -- ) - UCOMISD { - { cc< [ \ CMOVB %boolean ] } - { cc<= [ \ CMOVBE %boolean ] } - { cc> [ \ CMOVA %boolean ] } - { cc>= [ \ CMOVAE %boolean ] } - { cc= [ \ CMOVE %boolean ] } - { cc/= [ \ CMOVNE %boolean ] } + rot { + { cc< [ swap UCOMISD \ CMOVA %boolean ] } + { cc<= [ swap UCOMISD \ CMOVAE %boolean ] } + { cc> [ UCOMISD \ CMOVA %boolean ] } + { cc>= [ UCOMISD \ CMOVAE %boolean ] } + { cc= [ COMISD \ %cmov-float= %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 ; M: x86 %compare-branch ( label cc src1 src2 -- ) - CMP { + CMP order-cc { { cc< [ JL ] } { cc<= [ JLE ] } { cc> [ JG ] } @@ -547,14 +576,33 @@ M: x86 %compare-branch ( label cc src1 src2 -- ) M: x86 %compare-imm-branch ( label src1 src2 cc -- ) %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 -- ) - UCOMISD { - { cc< [ JB ] } - { cc<= [ JBE ] } - { cc> [ JA ] } - { cc>= [ JAE ] } - { cc= [ JE ] } - { cc/= [ JNE ] } + rot { + { cc< [ swap UCOMISD JA ] } + { cc<= [ swap UCOMISD JAE ] } + { cc> [ UCOMISD JA ] } + { cc>= [ UCOMISD JAE ] } + { cc= [ COMISD %jump-float= ] } + { 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 ; M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ;