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

Comparison operations

db4
Slava Pestov 2008-10-21 03:21:29 -05:00
parent 94a2bfa2ea
commit 87e9fbb34c
5 changed files with 91 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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 ;

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

@ -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

8
basis/cpu/x86/32/32.factor
View File

@ -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 ;

13
basis/cpu/x86/64/64.factor
View File

@ -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>> [

50
basis/cpu/x86/architecture/architecture.factor
View File

@ -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 [+] ;