Comparison operations
parent
94a2bfa2ea
commit
87e9fbb34c
|
@ -21,6 +21,9 @@ SYMBOL: registers
|
|||
: register ( vreg -- operand )
|
||||
registers get at [ "Bad value" throw ] unless* ;
|
||||
|
||||
: ?register ( obj -- operand )
|
||||
dup vreg? [ register ] when ;
|
||||
|
||||
: generate-insns ( insns -- code )
|
||||
[
|
||||
[
|
||||
|
@ -64,7 +67,7 @@ SYMBOL: labels
|
|||
labels get [ drop <label> ] cache ;
|
||||
|
||||
M: ##load-immediate generate-insn
|
||||
[ dst>> register ] [ obj>> ] bi %load-immediate ;
|
||||
[ dst>> register ] [ val>> ] bi %load-immediate ;
|
||||
|
||||
M: ##load-indirect generate-insn
|
||||
[ dst>> register ] [ obj>> ] bi %load-indirect ;
|
||||
|
@ -94,7 +97,7 @@ M: ##dispatch generate-insn
|
|||
{
|
||||
[ dst>> register ]
|
||||
[ obj>> register ]
|
||||
[ slot>> dup vreg? [ register ] when ]
|
||||
[ slot>> ?register ]
|
||||
[ tag>> ]
|
||||
} cleave ; inline
|
||||
|
||||
|
@ -108,7 +111,7 @@ M: ##slot-imm generate-insn
|
|||
{
|
||||
[ src>> register ]
|
||||
[ obj>> register ]
|
||||
[ slot>> dup vreg? [ register ] when ]
|
||||
[ slot>> ?register ]
|
||||
[ tag>> ]
|
||||
} cleave ; inline
|
||||
|
||||
|
@ -122,7 +125,9 @@ M: ##set-slot-imm generate-insn
|
|||
[ dst>> register ] [ src>> register ] bi ; inline
|
||||
|
||||
: dst/src1/src2 ( insn -- dst src1 src2 )
|
||||
[ dst>> register ] [ src1>> register ] [ src2>> register ] tri ; inline
|
||||
[ dst>> register ]
|
||||
[ src1>> register ]
|
||||
[ src2>> ?register ] tri ; inline
|
||||
|
||||
M: ##add generate-insn dst/src1/src2 %add ;
|
||||
M: ##add-imm generate-insn dst/src1/src2 %add-imm ;
|
||||
|
@ -152,15 +157,15 @@ M: ##sub-float generate-insn dst/src1/src2 %sub-float ;
|
|||
M: ##mul-float generate-insn dst/src1/src2 %mul-float ;
|
||||
M: ##div-float generate-insn dst/src1/src2 %div-float ;
|
||||
|
||||
M: ##integer>float generate-insn dst/src/temp %integer>float ;
|
||||
M: ##integer>float generate-insn dst/src %integer>float ;
|
||||
M: ##float>integer generate-insn dst/src %float>integer ;
|
||||
|
||||
M: ##copy generate-insn dst/src %copy ;
|
||||
M: ##copy-float generate-insn dst/src %copy-float ;
|
||||
M: ##unbox-float generate-insn dst/src %unbox-float ;
|
||||
M: ##unbox-any-c-ptr generate-insn dst/src %unbox-any-c-ptr ;
|
||||
M: ##box-float generate-insn dst/src/temp %box-float ;
|
||||
M: ##box-alien generate-insn dst/src/temp %box-alien ;
|
||||
M: ##copy generate-insn dst/src %copy ;
|
||||
M: ##copy-float generate-insn dst/src %copy-float ;
|
||||
M: ##unbox-float generate-insn dst/src %unbox-float ;
|
||||
M: ##unbox-any-c-ptr generate-insn dst/src/temp %unbox-any-c-ptr ;
|
||||
M: ##box-float generate-insn dst/src/temp %box-float ;
|
||||
M: ##box-alien generate-insn dst/src/temp %box-alien ;
|
||||
|
||||
M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ;
|
||||
M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;
|
||||
|
@ -172,7 +177,7 @@ M: ##alien-cell generate-insn dst/src %alien-cell ;
|
|||
M: ##alien-float generate-insn dst/src %alien-float ;
|
||||
M: ##alien-double generate-insn dst/src %alien-double ;
|
||||
|
||||
: >alien-setter< [ src>> register ] [ value>> register ] bi ;
|
||||
: >alien-setter< [ src>> register ] [ value>> register ] bi ; inline
|
||||
|
||||
M: ##set-alien-integer-1 generate-insn >alien-setter< %set-alien-integer-1 ;
|
||||
M: ##set-alien-integer-2 generate-insn >alien-setter< %set-alien-integer-2 ;
|
||||
|
@ -461,13 +466,25 @@ M: _label generate-insn
|
|||
M: _branch generate-insn
|
||||
label>> lookup-label %jump-label ;
|
||||
|
||||
: >compare< ( insn -- label cc src1 src2 )
|
||||
{
|
||||
[ dst>> register ]
|
||||
[ cc>> ]
|
||||
[ src1>> register ]
|
||||
[ src2>> ?register ]
|
||||
} cleave ; inline
|
||||
|
||||
M: ##compare generate-insn >compare< %compare ;
|
||||
M: ##compare-imm generate-insn >compare< %compare-imm ;
|
||||
M: ##compare-float generate-insn >compare< %compare-float ;
|
||||
|
||||
: >binary-branch< ( insn -- label cc src1 src2 )
|
||||
{
|
||||
[ label>> lookup-label ]
|
||||
[ cc>> ]
|
||||
[ src1>> register ]
|
||||
[ src2>> dup vreg? [ register ] when ]
|
||||
} cleave ;
|
||||
[ src2>> ?register ]
|
||||
} cleave ; inline
|
||||
|
||||
M: _compare-branch generate-insn
|
||||
>binary-branch< %compare-branch ;
|
||||
|
|
|
@ -74,7 +74,7 @@ HOOK: %sar-imm cpu ( dst src1 src2 -- )
|
|||
HOOK: %not cpu ( dst src -- )
|
||||
|
||||
HOOK: %integer>bignum cpu ( dst src temp -- )
|
||||
HOOK: %bignum>integer cpu ( dst src temp -- )
|
||||
HOOK: %bignum>integer cpu ( dst src -- )
|
||||
|
||||
HOOK: %add-float cpu ( dst src1 src2 -- )
|
||||
HOOK: %sub-float cpu ( dst src1 src2 -- )
|
||||
|
@ -115,6 +115,10 @@ HOOK: %gc cpu ( -- )
|
|||
HOOK: %prologue cpu ( n -- )
|
||||
HOOK: %epilogue cpu ( n -- )
|
||||
|
||||
HOOK: %compare cpu ( dst cc src1 src2 -- )
|
||||
HOOK: %compare-imm cpu ( dst cc src1 src2 -- )
|
||||
HOOK: %compare-float cpu ( dst 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 -- )
|
||||
|
@ -193,7 +197,7 @@ M: stack-params param-reg drop ;
|
|||
M: stack-params param-regs drop f ;
|
||||
|
||||
: if-small-struct ( n size true false -- ? )
|
||||
[ 2dup [ not ] [ struct-small-enough? ] bi and ] 2dip
|
||||
[ 2dup [ not ] [ struct-small-enough? ] bi* and ] 2dip
|
||||
[ '[ nip @ ] ] dip if ;
|
||||
inline
|
||||
|
||||
|
|
|
@ -74,8 +74,12 @@ M: float-regs store-return-reg
|
|||
[ [ align-sub ] [ call ] bi* ]
|
||||
[ [ align-add ] [ drop ] bi* ] 2bi ; inline
|
||||
|
||||
M: x86.32 %load-indirect
|
||||
0 [] MOV rc-absolute-cell rel-literal ;
|
||||
M: x86.64 rel-literal-x86 rc-absolute-cell rel-literal ;
|
||||
|
||||
M: x86.32 %prologue ( n -- )
|
||||
dup PUSH
|
||||
0 PUSH rc-absolute-cell rel-this
|
||||
stack-reg swap 3 cells - SUB ;
|
||||
|
||||
M: object %load-param-reg 3drop ;
|
||||
|
||||
|
|
|
@ -32,8 +32,13 @@ M: float-regs return-reg drop XMM0 ;
|
|||
M: float-regs param-regs
|
||||
drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
|
||||
|
||||
M: x86.64 %load-indirect
|
||||
0 [] MOV rc-relative rel-literal ;
|
||||
M: x86.64 rel-literal-x86 rc-relative rel-literal ;
|
||||
|
||||
M: x86.64 %prologue ( n -- )
|
||||
temp-reg-1 0 MOV rc-absolute-cell rel-this
|
||||
dup PUSH
|
||||
temp-reg-1 PUSH
|
||||
stack-reg swap 3 cells - SUB ;
|
||||
|
||||
M: stack-params %load-param-reg
|
||||
drop
|
||||
|
@ -53,8 +58,8 @@ M: stack-params %save-param-reg
|
|||
] with-scope ; inline
|
||||
|
||||
! The ABI for passing structs by value is pretty messed up
|
||||
"void*" c-type clone "__stack_value" define-primitive-type
|
||||
stack-params "__stack_value" c-type (>>reg-class)
|
||||
<< "void*" c-type clone "__stack_value" define-primitive-type
|
||||
stack-params "__stack_value" c-type (>>reg-class) >>
|
||||
|
||||
: struct-types&offset ( struct-type -- pairs )
|
||||
fields>> [
|
||||
|
|
|
@ -14,6 +14,10 @@ HOOK: temp-reg-2 cpu ( -- reg )
|
|||
|
||||
M: x86 %load-immediate MOV ;
|
||||
|
||||
HOOK: rel-literal-x86 cpu ( literal -- )
|
||||
|
||||
M: x86 %load-indirect swap 0 [] MOV rel-literal-x86 ;
|
||||
|
||||
HOOK: ds-reg cpu ( -- reg )
|
||||
HOOK: rs-reg cpu ( -- reg )
|
||||
|
||||
|
@ -178,7 +182,7 @@ M: x86 %copy-float MOVSD ;
|
|||
M: x86 %unbox-float ( dst src -- )
|
||||
float-offset [+] MOVSD ;
|
||||
|
||||
M:: x86 %unbox-any-c-ptr ( dst src dst temp -- )
|
||||
M:: x86 %unbox-any-c-ptr ( dst src temp -- )
|
||||
[
|
||||
{ "is-byte-array" "end" "start" } [ define-label ] each
|
||||
dst 0 MOV
|
||||
|
@ -269,9 +273,9 @@ M:: x86 %box-alien ( dst src temp -- )
|
|||
|
||||
: small-reg ( reg size -- reg' )
|
||||
{
|
||||
{ 1 small-reg-1 }
|
||||
{ 2 small-reg-2 }
|
||||
{ 4 small-reg-4 }
|
||||
{ 1 [ small-reg-1 ] }
|
||||
{ 2 [ small-reg-2 ] }
|
||||
{ 4 [ small-reg-4 ] }
|
||||
} case ;
|
||||
|
||||
: small-regs ( -- regs ) { EAX ECX EDX EBX } ; inline
|
||||
|
@ -287,7 +291,7 @@ M:: x86 %box-alien ( dst src temp -- )
|
|||
#! call the quot with that. Otherwise, we find a small
|
||||
#! register that is not equal to src, and call quot, saving
|
||||
#! and restoring the small register.
|
||||
dst small-regs memq? [ src quot call ] [
|
||||
dst small-regs memq? [ dst src quot call ] [
|
||||
src small-reg-that-isn't
|
||||
[ src quot call ]
|
||||
with-save/restore
|
||||
|
@ -381,17 +385,39 @@ HOOK: stack-reg cpu ( -- reg )
|
|||
: decr-stack-reg ( n -- )
|
||||
dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
|
||||
|
||||
M: x86 %prologue ( n -- )
|
||||
temp-reg-1 0 MOV rc-absolute-cell rel-this
|
||||
dup PUSH
|
||||
temp-reg-1 PUSH
|
||||
stack-reg swap 3 cells - SUB ;
|
||||
|
||||
: incr-stack-reg ( n -- )
|
||||
dup 0 = [ drop ] [ stack-reg swap ADD ] if ;
|
||||
|
||||
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
|
||||
|
||||
: %boolean ( dst word -- )
|
||||
over \ f tag-number MOV
|
||||
0 [] swap execute
|
||||
\ t rel-literal-x86 ; inline
|
||||
|
||||
M: x86 %compare ( dst cc src1 src2 -- )
|
||||
CMP {
|
||||
{ cc< [ \ CMOVL %boolean ] }
|
||||
{ cc<= [ \ CMOVLE %boolean ] }
|
||||
{ cc> [ \ CMOVG %boolean ] }
|
||||
{ cc>= [ \ CMOVGE %boolean ] }
|
||||
{ cc= [ \ CMOVE %boolean ] }
|
||||
{ cc/= [ \ CMOVNE %boolean ] }
|
||||
} case ;
|
||||
|
||||
M: x86 %compare-imm ( dst cc src1 src2 -- )
|
||||
%compare ;
|
||||
|
||||
M: x86 %compare-float ( dst cc src1 src2 -- )
|
||||
UCOMISD {
|
||||
{ cc< [ \ CMOVB %boolean ] }
|
||||
{ cc<= [ \ CMOVBE %boolean ] }
|
||||
{ cc> [ \ CMOVA %boolean ] }
|
||||
{ cc>= [ \ CMOVAE %boolean ] }
|
||||
{ cc= [ \ CMOVE %boolean ] }
|
||||
{ cc/= [ \ CMOVNE %boolean ] }
|
||||
} case ;
|
||||
|
||||
M: x86 %compare-branch ( label cc src1 src2 -- )
|
||||
CMP {
|
||||
{ cc< [ JL ] }
|
||||
|
@ -399,6 +425,7 @@ M: x86 %compare-branch ( label cc src1 src2 -- )
|
|||
{ cc> [ JG ] }
|
||||
{ cc>= [ JGE ] }
|
||||
{ cc= [ JE ] }
|
||||
{ cc/= [ JNE ] }
|
||||
} case ;
|
||||
|
||||
M: x86 %compare-imm-branch ( label src1 src2 cc -- )
|
||||
|
@ -411,6 +438,7 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
|
|||
{ cc> [ JA ] }
|
||||
{ cc>= [ JAE ] }
|
||||
{ cc= [ JE ] }
|
||||
{ cc/= [ JNE ] }
|
||||
} case ;
|
||||
|
||||
: stack@ ( n -- op ) stack-reg swap [+] ;
|
||||
|
|
Loading…
Reference in New Issue