dst \ t %load-reference
"end" get resolve-label ; inline
- : %boolean ( dst cc temp -- )
- swap negate-cc {
- { cc< [ \ BLT (%boolean) ] }
- { cc<= [ \ BLE (%boolean) ] }
- { cc> [ \ BGT (%boolean) ] }
- { cc>= [ \ BGE (%boolean) ] }
- { cc= [ \ BEQ (%boolean) ] }
- { cc/= [ \ BNE (%boolean) ] }
-:: %boolean ( dst temp cc -- )
++:: %boolean ( dst cc temp -- )
+ cc negate-cc order-cc {
+ { cc< [ dst temp \ BLT f (%boolean) ] }
+ { cc<= [ dst temp \ BLE f (%boolean) ] }
+ { cc> [ dst temp \ BGT f (%boolean) ] }
+ { cc>= [ dst temp \ BGE f (%boolean) ] }
+ { cc= [ dst temp \ BEQ f (%boolean) ] }
+ { cc/= [ dst temp \ BNE f (%boolean) ] }
} case ;
: (%compare) ( src1 src2 -- ) [ 0 ] dip CMP ; inline
: (%compare-imm) ( src1 src2 -- ) [ 0 ] 2dip CMPI ; inline
- : (%compare-float) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
+ : (%compare-float-unordered) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
+ : (%compare-float-ordered) ( src1 src2 -- ) [ 0 ] dip FCMPO ; inline
+
-:: (%compare-float) ( cc src1 src2 -- branch1 branch2 )
++:: (%compare-float) ( src1 src2 cc -- 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 ] }
+ } case ; inline
-M: ppc %compare (%compare) %boolean ;
-M: ppc %compare-imm (%compare-imm) %boolean ;
-M:: ppc %compare-float ( dst temp cc src1 src2 -- )
+M: ppc %compare [ (%compare) ] 2dip %boolean ;
++
+M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
- M: ppc %compare-float [ (%compare-float) ] 2dip %boolean ;
+
- : %branch ( label cc -- )
- {
- { cc< [ BLT ] }
- { cc<= [ BLE ] }
- { cc> [ BGT ] }
- { cc>= [ BGE ] }
- { cc= [ BEQ ] }
- { cc/= [ BNE ] }
++M:: ppc %compare-float ( dst src1 src2 cc temp -- )
+ cc negate-cc src1 src2 (%compare-float) :> branch2 :> branch1
+ dst temp branch1 branch2 (%boolean) ;
+
+ :: %branch ( label cc -- )
+ cc order-cc {
+ { cc< [ label BLT ] }
+ { cc<= [ label BLE ] }
+ { cc> [ label BGT ] }
+ { cc>= [ label BGE ] }
+ { cc= [ label BEQ ] }
+ { cc/= [ label BNE ] }
} case ;
-M: ppc %compare-branch (%compare) %branch ;
-M: ppc %compare-imm-branch (%compare-imm) %branch ;
-M:: ppc %compare-float-branch ( label cc src1 src2 -- )
+M: ppc %compare-branch [ (%compare) ] 2dip %branch ;
++
+M: ppc %compare-imm-branch [ (%compare-imm) ] 2dip %branch ;
- M: ppc %compare-float-branch [ (%compare-float) ] 2dip %branch ;
++
++M:: ppc %compare-float-branch ( label src1 src2 cc -- )
+ cc src1 src2 (%compare-float) :> branch2 :> branch1
+ label branch1 execute( label -- )
+ branch2 [ label branch2 execute( label -- ) ] when ;
: load-from-frame ( dst n rep -- )
{
--! Copyright (C) 2005, 2008 Slava Pestov.
++! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs alien alien.c-types arrays strings
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
temp 0 MOV \ t rc-absolute-cell rel-immediate
dst temp word execute ; inline
-M:: x86 %compare ( dst temp cc src1 src2 -- )
+M: x86 %compare ( dst src1 src2 cc temp -- )
- [ CMP ] 2dip swap {
- { cc< [ \ CMOVL %boolean ] }
- { cc<= [ \ CMOVLE %boolean ] }
- { cc> [ \ CMOVG %boolean ] }
- { cc>= [ \ CMOVGE %boolean ] }
- { cc= [ \ CMOVE %boolean ] }
- { cc/= [ \ CMOVNE %boolean ] }
+ src1 src2 CMP
+ cc order-cc {
+ { cc< [ dst temp \ CMOVL %boolean ] }
+ { cc<= [ dst temp \ CMOVLE %boolean ] }
+ { cc> [ dst temp \ CMOVG %boolean ] }
+ { cc>= [ dst temp \ CMOVGE %boolean ] }
+ { cc= [ dst temp \ CMOVE %boolean ] }
+ { cc/= [ dst temp \ CMOVNE %boolean ] }
} case ;
-M: x86 %compare-imm ( dst temp cc src1 src2 -- )
+M: x86 %compare-imm ( dst src1 src2 cc temp -- )
%compare ;
- M: x86 %compare-float ( dst src1 src2 cc temp -- )
- [ UCOMISD ] 2dip swap {
- { cc< [ \ CMOVB %boolean ] }
- { cc<= [ \ CMOVBE %boolean ] }
- { cc> [ \ CMOVA %boolean ] }
- { cc>= [ \ CMOVAE %boolean ] }
- { cc= [ \ CMOVE %boolean ] }
- { cc/= [ \ CMOVNE %boolean ] }
+ : %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 src1 src2 cc temp -- )
+ 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 ;
- M: x86 %compare-branch ( label src1 src2 cc -- )
- [ CMP ] dip {
- { cc< [ JL ] }
- { cc<= [ JLE ] }
- { cc> [ JG ] }
- { cc>= [ JGE ] }
- { cc= [ JE ] }
- { cc/= [ JNE ] }
-M:: x86 %compare-branch ( label cc src1 src2 -- )
++M:: x86 %compare-branch ( label src1 src2 cc -- )
+ src1 src2 CMP
+ cc order-cc {
+ { cc< [ label JL ] }
+ { cc<= [ label JLE ] }
+ { cc> [ label JG ] }
+ { cc>= [ label JGE ] }
+ { cc= [ label JE ] }
+ { cc/= [ label JNE ] }
} case ;
M: x86 %compare-imm-branch ( label src1 src2 cc -- )
%compare-branch ;
- M: x86 %compare-float-branch ( label src1 src2 cc -- )
- [ UCOMISD ] dip {
- { cc< [ JB ] }
- { cc<= [ JBE ] }
- { cc> [ JA ] }
- { cc>= [ JAE ] }
- { cc= [ JE ] }
- { cc/= [ JNE ] }
+ : %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 src1 src2 cc -- )
+ 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 ] }
} case ;
-M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ;
-M: x86 %reload ( dst n rep -- ) [ spill@ ] dip copy-register ;
+M:: x86 %spill ( src rep n -- )
+ n spill@ src rep copy-register ;
+
+M:: x86 %reload ( dst rep n -- )
+ dst n spill@ rep copy-register ;
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;