more PowerPC work done; overflow checks remain
parent
1abf62487d
commit
a76f7107c3
|
@ -130,7 +130,7 @@ sequences words ;
|
|||
: binary-op-reg ( op out -- )
|
||||
>r in-2
|
||||
1 %dec-d ,
|
||||
1 <vreg> 0 <vreg> rot execute ,
|
||||
>r 1 <vreg> 0 <vreg> 0 <vreg> r> execute ,
|
||||
r> 0 %replace-d , ;
|
||||
|
||||
: literal-fixnum? ( value -- ? )
|
||||
|
@ -141,7 +141,7 @@ sequences words ;
|
|||
>r >r node-peek dup literal-fixnum? [
|
||||
1 %dec-d ,
|
||||
in-1
|
||||
literal-value 0 <vreg> r> execute ,
|
||||
literal-value 0 <vreg> 0 <vreg> r> execute ,
|
||||
r> 0 %replace-d ,
|
||||
] [
|
||||
drop
|
||||
|
@ -172,7 +172,7 @@ sequences words ;
|
|||
literal-value dup power-of-2? [
|
||||
1 %dec-d ,
|
||||
in-1
|
||||
log2 0 <vreg> %fixnum<< ,
|
||||
log2 0 <vreg> 0 <vreg> %fixnum<< ,
|
||||
0 0 %replace-d ,
|
||||
] [
|
||||
drop slow-fixnum*
|
||||
|
@ -186,7 +186,11 @@ sequences words ;
|
|||
! This is not clever. Because of x86, %fixnum-mod is
|
||||
! hard-coded to put its output in vreg 2, which happends to
|
||||
! be EDX there.
|
||||
drop \ %fixnum-mod 2 binary-op-reg
|
||||
drop
|
||||
in-2
|
||||
1 %dec-d ,
|
||||
1 <vreg> 0 <vreg> 2 <vreg> %fixnum-mod ,
|
||||
2 0 %replace-d ,
|
||||
] "intrinsic" set-word-prop
|
||||
|
||||
\ fixnum/i t "intrinsic" set-word-prop
|
||||
|
@ -199,7 +203,9 @@ sequences words ;
|
|||
! See the remark on fixnum-mod for vreg usage
|
||||
drop
|
||||
in-2
|
||||
0 <vreg> 1 <vreg> %fixnum/mod ,
|
||||
[ << vreg f 1 >> << vreg f 0 >> ]
|
||||
[ << vreg f 2 >> << vreg f 0 >> ]
|
||||
%fixnum/mod ,
|
||||
2 0 %replace-d ,
|
||||
0 1 %replace-d ,
|
||||
] "intrinsic" set-word-prop
|
||||
|
@ -217,10 +223,10 @@ sequences words ;
|
|||
1 %dec-d ,
|
||||
in-1
|
||||
dup cell -8 * <= [
|
||||
drop 0 <vreg> 2 <vreg> %fixnum-sgn ,
|
||||
drop 0 <vreg> 2 <vreg> 2 <vreg> %fixnum-sgn ,
|
||||
2 0 %replace-d ,
|
||||
] [
|
||||
neg 0 <vreg> %fixnum>> ,
|
||||
neg 0 <vreg> 0 <vreg> %fixnum>> ,
|
||||
out-1
|
||||
] ifte ;
|
||||
|
||||
|
@ -228,7 +234,7 @@ sequences words ;
|
|||
dup cell 8 * tag-bits - <= [
|
||||
1 %dec-d ,
|
||||
in-1
|
||||
0 <vreg> %fixnum<< ,
|
||||
0 <vreg> 0 <vreg> %fixnum<< ,
|
||||
out-1
|
||||
] [
|
||||
drop slow-shift
|
||||
|
|
|
@ -31,6 +31,7 @@ USING: compiler errors kernel math memory words ;
|
|||
r> bitor r> bitor r> bitor r> bitor r> bitor ;
|
||||
|
||||
: x-form ( a s b xo rc -- n )
|
||||
swap
|
||||
>r 1 shift >r 11 shift >r swap 16 shift >r 21 shift
|
||||
r> bitor r> bitor r> bitor r> bitor ;
|
||||
|
||||
|
@ -38,6 +39,7 @@ USING: compiler errors kernel math memory words ;
|
|||
1 shift >r 11 shift >r 21 shift r> bitor r> bitor ;
|
||||
|
||||
: xo-form ( d a b oe xo rc -- n )
|
||||
swap
|
||||
>r 1 shift >r 10 shift >r 11 shift >r 16 shift >r 21 shift
|
||||
r> bitor r> bitor r> bitor r> bitor r> bitor ;
|
||||
|
||||
|
@ -48,19 +50,19 @@ USING: compiler errors kernel math memory words ;
|
|||
|
||||
: ADDIC. d-form 13 insn ; : SUBIC. neg ADDIC. ;
|
||||
|
||||
: (ADD) 266 swap xo-form 31 insn ;
|
||||
: (ADD) 266 xo-form 31 insn ;
|
||||
: ADD 0 0 (ADD) ;
|
||||
: ADD. 0 1 (ADD) ;
|
||||
: ADDO 1 0 (ADD) ;
|
||||
: ADDO. 1 1 (ADD) ;
|
||||
|
||||
: (ADDC) 10 swap xo-form 31 insn ;
|
||||
: (ADDC) 10 xo-form 31 insn ;
|
||||
: ADDC 0 0 (ADDC) ;
|
||||
: ADDC. 0 1 (ADDC) ;
|
||||
: ADDCO 1 0 (ADDC) ;
|
||||
: ADDCO. 1 1 (ADDC) ;
|
||||
|
||||
: (ADDE) 138 swap xo-form 31 insn ;
|
||||
: (ADDE) 138 xo-form 31 insn ;
|
||||
: ADDE 0 0 (ADDE) ;
|
||||
: ADDE. 0 1 (ADDE) ;
|
||||
: ADDEO 1 0 (ADDE) ;
|
||||
|
@ -69,31 +71,31 @@ USING: compiler errors kernel math memory words ;
|
|||
: ANDI d-form 28 insn ;
|
||||
: ANDIS d-form 29 insn ;
|
||||
|
||||
: (AND) 28 swap x-form 31 insn ;
|
||||
: (AND) 28 x-form 31 insn ;
|
||||
: AND 0 (AND) ;
|
||||
: AND. 0 (AND) ;
|
||||
|
||||
: (DIVW) 491 swap xo-form 31 insn ;
|
||||
: (DIVW) 491 xo-form 31 insn ;
|
||||
: DIVW 0 0 (DIVW) ;
|
||||
: DIVW. 0 1 (DIVW) ;
|
||||
: DIVWO 1 0 (DIVW) ;
|
||||
: DIVWO 1 1 (DIVW) ;
|
||||
|
||||
: (DIVWU) 459 swap xo-form 31 insn ;
|
||||
: (DIVWU) 459 xo-form 31 insn ;
|
||||
: DIVWU 0 0 (DIVWU) ;
|
||||
: DIVWU. 0 1 (DIVWU) ;
|
||||
: DIVWUO 1 0 (DIVWU) ;
|
||||
: DIVWUO. 1 1 (DIVWU) ;
|
||||
|
||||
: (EQV) 284 swap x-form 31 insn ;
|
||||
: (EQV) 284 x-form 31 insn ;
|
||||
: EQV 0 (EQV) ;
|
||||
: EQV. 1 (EQV) ;
|
||||
|
||||
: (NAND) 476 swap x-form 31 insn ;
|
||||
: (NAND) 476 x-form 31 insn ;
|
||||
: NAND 0 (NAND) ;
|
||||
: NAND. 1 (NAND) ;
|
||||
|
||||
: (NOR) 124 swap x-form 31 insn ;
|
||||
: (NOR) 124 x-form 31 insn ;
|
||||
: NOR 0 (NOR) ;
|
||||
: NOR. 1 (NOR) ;
|
||||
|
||||
|
@ -103,44 +105,60 @@ USING: compiler errors kernel math memory words ;
|
|||
: ORI d-form 24 insn ;
|
||||
: ORIS d-form 25 insn ;
|
||||
|
||||
: (OR) 444 swap x-form 31 insn ;
|
||||
: (OR) 444 x-form 31 insn ;
|
||||
: OR 0 (OR) ;
|
||||
: OR. 1 (OR) ;
|
||||
|
||||
: (ORC) 412 swap x-form 31 insn ;
|
||||
: (ORC) 412 x-form 31 insn ;
|
||||
: ORC 0 (ORC) ;
|
||||
: ORC. 1 (ORC) ;
|
||||
|
||||
: MR over OR ;
|
||||
: MR. over OR. ;
|
||||
: MR dup OR ;
|
||||
: MR. dup OR. ;
|
||||
|
||||
: (SLW) 24 swap x-form 31 insn ;
|
||||
: (MULHW) 75 xo-form 31 insn ;
|
||||
: MULHW 0 0 (MULHW) ;
|
||||
: MULHW. 0 1 (MULHW) ;
|
||||
|
||||
: MULLI d-form 7 insn ;
|
||||
|
||||
: (MULHWU) 11 xo-form 31 insn ;
|
||||
: MULHWU 0 0 (MULHWU) ;
|
||||
: MULHWU. 0 1 (MULHWU) ;
|
||||
|
||||
: (MULLW) 235 xo-form 31 insn ;
|
||||
: MULLW 0 0 (MULLW) ;
|
||||
: MULLW. 0 1 (MULLW) ;
|
||||
: MULLWC 1 0 (MULLW) ;
|
||||
: MULLWC. 1 1 (MULLW) ;
|
||||
|
||||
: (SLW) 24 x-form 31 insn ;
|
||||
: SLW 0 (SLW) ;
|
||||
: SLW. 1 (SLW) ;
|
||||
|
||||
: (SRAW) 792 swap x-form 31 insn ;
|
||||
: (SRAW) 792 x-form 31 insn ;
|
||||
: SRAW 0 (SRAW) ;
|
||||
: SRAW. 1 (SRAW) ;
|
||||
|
||||
: (SRW) 536 swap x-form 31 insn ;
|
||||
: (SRW) 536 x-form 31 insn ;
|
||||
: SRW 0 (SRW) ;
|
||||
: SRW. 1 (SRW) ;
|
||||
|
||||
: SRAWI 824 0 x-form 31 insn ;
|
||||
: SRAWI 0 824 x-form 31 insn ;
|
||||
|
||||
: (SUBF) 40 swap xo-form 31 insn ;
|
||||
: (SUBF) 40 xo-form 31 insn ;
|
||||
: SUBF 0 0 (SUBF) ;
|
||||
: SUBF. 0 1 (SUBF) ;
|
||||
: SUBFO 1 0 (SUBF) ;
|
||||
: SUBFO. 1 1 (SUBF) ;
|
||||
|
||||
: (SUBFC) 8 swap xo-form 31 insn ;
|
||||
: (SUBFC) 8 xo-form 31 insn ;
|
||||
: SUBFC 0 0 (SUBFC) ;
|
||||
: SUBFC. 0 1 (SUBFC) ;
|
||||
: SUBFCO 1 0 (SUBFC) ;
|
||||
: SUBFCO. 1 1 (SUBFC) ;
|
||||
|
||||
: (SUBFE) 136 swap xo-form 31 insn ;
|
||||
: (SUBFE) 136 xo-form 31 insn ;
|
||||
: SUBFE 0 0 (SUBFE) ;
|
||||
: SUBFE. 0 1 (SUBFE) ;
|
||||
: SUBFEO 1 0 (SUBFE) ;
|
||||
|
@ -149,7 +167,7 @@ USING: compiler errors kernel math memory words ;
|
|||
: XORI d-form 26 insn ;
|
||||
: XORIS d-form 27 insn ;
|
||||
|
||||
: (XOR) 316 swap x-form 31 insn ;
|
||||
: (XOR) 316 x-form 31 insn ;
|
||||
: XOR 0 (XOR) ;
|
||||
: XOR. 1 (XOR) ;
|
||||
|
||||
|
@ -157,7 +175,7 @@ USING: compiler errors kernel math memory words ;
|
|||
: CMPLI d-form 10 insn ;
|
||||
|
||||
: CMP 0 0 x-form 31 insn ;
|
||||
: CMPL 32 0 x-form 31 insn ;
|
||||
: CMPL 0 32 x-form 31 insn ;
|
||||
|
||||
: (RLWINM) m-form 21 insn ;
|
||||
: RLWINM 0 (RLWINM) ;
|
||||
|
|
|
@ -1,13 +1,19 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: compiler-backend
|
||||
USING: assembler compiler kernel math memory namespaces words ;
|
||||
USING: assembler compiler kernel math math-internals memory
|
||||
namespaces words ;
|
||||
|
||||
: >3-vop< ( vop -- out1 in2 in1 )
|
||||
[ vop-out-1 v>operand ] keep
|
||||
[ vop-in-2 v>operand ] keep
|
||||
vop-in-1 ;
|
||||
|
||||
: maybe-immediate ( vop imm comp -- )
|
||||
pick vop-in-1 integer? [
|
||||
>r >r dest/src dupd r> execute r> drop
|
||||
>r >r >3-vop< v>operand r> execute r> drop
|
||||
] [
|
||||
>r >r dest/src over r> drop r> execute
|
||||
>r >r >3-vop< v>operand swap r> drop r> execute
|
||||
] ifte ; inline
|
||||
|
||||
M: %fixnum+ generate-node ( vop -- )
|
||||
|
@ -16,6 +22,33 @@ M: %fixnum+ generate-node ( vop -- )
|
|||
M: %fixnum- generate-node ( vop -- )
|
||||
\ SUBI \ SUBF maybe-immediate ;
|
||||
|
||||
M: %fixnum* generate-node ( vop -- )
|
||||
dup \ MULLI \ MULLW maybe-immediate
|
||||
vop-out-1 v>operand dup tag-bits SRAWI ;
|
||||
|
||||
M: %fixnum/i generate-node ( vop -- )
|
||||
dup >3-vop< v>operand DIVW
|
||||
vop-out-1 v>operand dup tag-fixnum ;
|
||||
|
||||
: generate-fixnum/mod ( -- )
|
||||
#! The same code is used for %fixnum/i and %fixnum/mod.
|
||||
#! mdest is vreg where to put the modulus. Note this has
|
||||
#! precise vreg requirements.
|
||||
20 17 18 DIVW ! divide in2 by in1, store result in out1
|
||||
18 20 18 MULLW ! multiply out1 by in1, store result in in1
|
||||
19 18 17 SUBF ! subtract in2 from in1, store result in out1.
|
||||
;
|
||||
|
||||
M: %fixnum-mod generate-node ( vop -- )
|
||||
#! This has specific vreg requirements.
|
||||
drop generate-fixnum/mod ;
|
||||
|
||||
M: %fixnum/mod generate-node ( vop -- )
|
||||
#! This has specific vreg requirements.
|
||||
drop generate-fixnum/mod
|
||||
17 20 MR
|
||||
17 17 tag-fixnum ;
|
||||
|
||||
M: %fixnum-bitand generate-node ( vop -- )
|
||||
\ ANDI \ AND maybe-immediate ;
|
||||
|
||||
|
@ -26,15 +59,28 @@ M: %fixnum-bitxor generate-node ( vop -- )
|
|||
\ XORI \ XOR maybe-immediate ;
|
||||
|
||||
M: %fixnum-bitnot generate-node ( vop -- )
|
||||
dup vop-in-1 swap vop-out-1 NOT ;
|
||||
dup vop-in-1 v>operand swap vop-out-1 v>operand
|
||||
2dup NOT untag ;
|
||||
|
||||
M: %fixnum<< generate-node ( vop -- )
|
||||
dup vop-in-1 20 LI
|
||||
dup vop-out-1 v>operand swap vop-in-2 v>operand 20 SLW ;
|
||||
|
||||
M: %fixnum>> generate-node ( vop -- )
|
||||
dup vop-out-1 v>operand over vop-in-2 v>operand
|
||||
rot vop-in-1 >r 2dup r> SRAWI untag ;
|
||||
>3-vop< >r 2dup r> SRAWI untag ;
|
||||
|
||||
M: %fixnum-sgn generate-node ( vop -- )
|
||||
>3-vop< >r 2dup r> drop 31 SRAWI untag ;
|
||||
|
||||
: MULLW 0 0 (MULLW) ;
|
||||
: MULLW. 0 1 (MULLW) ;
|
||||
|
||||
: compare ( vop -- )
|
||||
dup vop-in-2 v>operand swap vop-in-1 dup integer? [
|
||||
0 -rot address CMPI
|
||||
] [
|
||||
0 swap v>operand CMP
|
||||
] ifte ;
|
||||
|
||||
: load-boolean ( dest cond -- )
|
||||
#! Compile this after a conditional jump to store f or t
|
||||
|
@ -48,22 +94,21 @@ M: %fixnum>> generate-node ( vop -- )
|
|||
t load-indirect
|
||||
"end" get save-xt ; inline
|
||||
|
||||
: fixnum-compare ( vop -- dest )
|
||||
dup vop-out-1 v>operand
|
||||
dup rot vop-in-1 v>operand
|
||||
0 swap CMP ;
|
||||
: fixnum-pred ( vop word -- dest )
|
||||
>r [ compare ] keep vop-out-1 v>operand r> load-boolean ;
|
||||
inline
|
||||
|
||||
M: %fixnum< generate-node ( vop -- )
|
||||
fixnum-compare \ BLT load-boolean ;
|
||||
M: %fixnum< generate-node ( vop -- ) \ BLT fixnum-pred ;
|
||||
M: %fixnum<= generate-node ( vop -- ) \ BLE fixnum-pred ;
|
||||
M: %fixnum> generate-node ( vop -- ) \ BGT fixnum-pred ;
|
||||
M: %fixnum>= generate-node ( vop -- ) \ BGE fixnum-pred ;
|
||||
M: %eq? generate-node ( vop -- ) \ BEQ fixnum-pred ;
|
||||
|
||||
M: %fixnum<= generate-node ( vop -- )
|
||||
fixnum-compare \ BLE load-boolean ;
|
||||
: fixnum-jump ( vop -- label )
|
||||
[ compare ] keep vop-label ;
|
||||
|
||||
M: %fixnum> generate-node ( vop -- )
|
||||
fixnum-compare \ BGT load-boolean ;
|
||||
|
||||
M: %fixnum>= generate-node ( vop -- )
|
||||
fixnum-compare \ BGE load-boolean ;
|
||||
|
||||
M: %eq? generate-node ( vop -- )
|
||||
fixnum-compare \ BEQ load-boolean ;
|
||||
M: %jump-fixnum< generate-node ( vop -- ) fixnum-jump BLT ;
|
||||
M: %jump-fixnum<= generate-node ( vop -- ) fixnum-jump BLE ;
|
||||
M: %jump-fixnum> generate-node ( vop -- ) fixnum-jump BGT ;
|
||||
M: %jump-fixnum>= generate-node ( vop -- ) fixnum-jump BGE ;
|
||||
M: %jump-eq? generate-node ( vop -- ) fixnum-jump BEQ ;
|
||||
|
|
|
@ -84,10 +84,11 @@ M: %untag generate-node ( vop -- )
|
|||
M: %untag-fixnum generate-node ( vop -- )
|
||||
dest/src tag-bits SRAWI ;
|
||||
|
||||
: tag-fixnum ( dest src -- ) 3 21 LI 21 SLW ;
|
||||
|
||||
M: %tag-fixnum generate-node ( vop -- )
|
||||
! todo: formalize scratch register usage
|
||||
3 19 LI
|
||||
dest/src 19 SLW ;
|
||||
dest/src tag-fixnum ;
|
||||
|
||||
M: %dispatch generate-node ( vop -- )
|
||||
0 <vreg> check-src
|
||||
|
@ -123,7 +124,7 @@ M: %type generate-node ( vop -- )
|
|||
! The pointer is equal to 3. Load F_TYPE (9).
|
||||
f type 18 LI
|
||||
"end" get save-xt
|
||||
18 17 MR ;
|
||||
17 18 MR ;
|
||||
|
||||
M: %arithmetic-type generate-node ( vop -- )
|
||||
0 <vreg> check-dest
|
||||
|
|
|
@ -26,7 +26,8 @@ TUPLE: vop inputs outputs label ;
|
|||
: vop-in-1 ( vop -- input ) vop-inputs first ;
|
||||
: vop-in-2 ( vop -- input ) vop-inputs second ;
|
||||
: vop-in-3 ( vop -- input ) vop-inputs third ;
|
||||
: vop-out-1 ( vop -- output ) vop-outputs car ;
|
||||
: vop-out-1 ( vop -- output ) vop-outputs first ;
|
||||
: vop-out-2 ( vop -- output ) vop-outputs second ;
|
||||
|
||||
GENERIC: basic-block? ( vop -- ? )
|
||||
M: vop basic-block? drop f ;
|
||||
|
@ -50,10 +51,10 @@ M: vop calls-label? vop-label = ;
|
|||
: src-vop ( src) unit f f ;
|
||||
: dest-vop ( dest) unit dup f ;
|
||||
: src/dest-vop ( src dest) >r unit r> unit f ;
|
||||
: binary-vop ( src dest) [ 2list ] keep unit f ;
|
||||
: 2-in-vop ( in1 in2) 2list f f ;
|
||||
: 2-in/label-vop ( in1 in2 label) >r 2list f r> ;
|
||||
: ternary-vop ( in1 in2 dest) >r 2list r> unit f ;
|
||||
: 2-vop ( in dest) [ 2list ] keep unit f ;
|
||||
: 3-vop ( in1 in2 dest) >r 2list r> unit f ;
|
||||
|
||||
! miscellanea
|
||||
VOP: %prologue
|
||||
|
@ -153,7 +154,7 @@ VOP: %untag
|
|||
M: %untag basic-block? drop t ;
|
||||
|
||||
VOP: %slot
|
||||
: %slot ( n vreg ) >r <vreg> r> <vreg> binary-vop <%slot> ;
|
||||
: %slot ( n vreg ) >r <vreg> r> <vreg> 2-vop <%slot> ;
|
||||
M: %slot basic-block? drop t ;
|
||||
|
||||
VOP: %set-slot
|
||||
|
@ -167,7 +168,7 @@ M: %set-slot basic-block? drop t ;
|
|||
! known at compile time, so these become a single instruction
|
||||
VOP: %fast-slot
|
||||
: %fast-slot ( vreg n )
|
||||
swap <vreg> binary-vop <%fast-slot> ;
|
||||
swap <vreg> 2-vop <%fast-slot> ;
|
||||
M: %fast-slot basic-block? drop t ;
|
||||
|
||||
VOP: %fast-set-slot
|
||||
|
@ -178,22 +179,22 @@ VOP: %fast-set-slot
|
|||
M: %fast-set-slot basic-block? drop t ;
|
||||
|
||||
! fixnum intrinsics
|
||||
VOP: %fixnum+ : %fixnum+ binary-vop <%fixnum+> ;
|
||||
VOP: %fixnum- : %fixnum- binary-vop <%fixnum-> ;
|
||||
VOP: %fixnum* : %fixnum* binary-vop <%fixnum*> ;
|
||||
VOP: %fixnum-mod : %fixnum-mod binary-vop <%fixnum-mod> ;
|
||||
VOP: %fixnum/i : %fixnum/i binary-vop <%fixnum/i> ;
|
||||
VOP: %fixnum/mod : %fixnum/mod binary-vop <%fixnum/mod> ;
|
||||
VOP: %fixnum-bitand : %fixnum-bitand binary-vop <%fixnum-bitand> ;
|
||||
VOP: %fixnum-bitor : %fixnum-bitor binary-vop <%fixnum-bitor> ;
|
||||
VOP: %fixnum-bitxor : %fixnum-bitxor binary-vop <%fixnum-bitxor> ;
|
||||
VOP: %fixnum+ : %fixnum+ 3-vop <%fixnum+> ;
|
||||
VOP: %fixnum- : %fixnum- 3-vop <%fixnum-> ;
|
||||
VOP: %fixnum* : %fixnum* 3-vop <%fixnum*> ;
|
||||
VOP: %fixnum-mod : %fixnum-mod 3-vop <%fixnum-mod> ;
|
||||
VOP: %fixnum/i : %fixnum/i 3-vop <%fixnum/i> ;
|
||||
VOP: %fixnum/mod : %fixnum/mod f <%fixnum/mod> ;
|
||||
VOP: %fixnum-bitand : %fixnum-bitand 3-vop <%fixnum-bitand> ;
|
||||
VOP: %fixnum-bitor : %fixnum-bitor 3-vop <%fixnum-bitor> ;
|
||||
VOP: %fixnum-bitxor : %fixnum-bitxor 3-vop <%fixnum-bitxor> ;
|
||||
VOP: %fixnum-bitnot : %fixnum-bitnot <vreg> dest-vop <%fixnum-bitnot> ;
|
||||
|
||||
VOP: %fixnum<= : %fixnum<= binary-vop <%fixnum<=> ;
|
||||
VOP: %fixnum< : %fixnum< binary-vop <%fixnum<> ;
|
||||
VOP: %fixnum>= : %fixnum>= binary-vop <%fixnum>=> ;
|
||||
VOP: %fixnum> : %fixnum> binary-vop <%fixnum>> ;
|
||||
VOP: %eq? : %eq? binary-vop <%eq?> ;
|
||||
VOP: %fixnum<= : %fixnum<= 3-vop <%fixnum<=> ;
|
||||
VOP: %fixnum< : %fixnum< 3-vop <%fixnum<> ;
|
||||
VOP: %fixnum>= : %fixnum>= 3-vop <%fixnum>=> ;
|
||||
VOP: %fixnum> : %fixnum> 3-vop <%fixnum>> ;
|
||||
VOP: %eq? : %eq? 3-vop <%eq?> ;
|
||||
|
||||
! At the VOP level, the 'shift' operation is split into five
|
||||
! distinct operations:
|
||||
|
@ -203,11 +204,11 @@ VOP: %eq? : %eq? binary-vop <%eq?> ;
|
|||
! - shifts with a small negative count: %fixnum>>
|
||||
! - shifts with a small negative count: %fixnum>>
|
||||
! - shifts with a large negative count: %fixnum-sgn
|
||||
VOP: %fixnum<< : %fixnum<< binary-vop <%fixnum<<> ;
|
||||
VOP: %fixnum>> : %fixnum>> binary-vop <%fixnum>>> ;
|
||||
VOP: %fixnum<< : %fixnum<< 3-vop <%fixnum<<> ;
|
||||
VOP: %fixnum>> : %fixnum>> 3-vop <%fixnum>>> ;
|
||||
! due to x86 limitations the destination of this VOP must be
|
||||
! vreg 2 (EDX), and the source must be vreg 0 (EAX).
|
||||
VOP: %fixnum-sgn : %fixnum-sgn binary-vop <%fixnum-sgn> ;
|
||||
VOP: %fixnum-sgn : %fixnum-sgn 3-vop <%fixnum-sgn> ;
|
||||
|
||||
! Integer comparison followed by a conditional branch is
|
||||
! optimized
|
||||
|
|
|
@ -187,21 +187,12 @@ M: %fixnum>= generate-node ( vop -- )
|
|||
M: %eq? generate-node ( vop -- )
|
||||
fixnum-compare \ JE load-boolean ;
|
||||
|
||||
: fixnum-branch ( vop -- label )
|
||||
: fixnum-jump ( vop -- label )
|
||||
dup vop-in-2 v>operand over vop-in-1 v>operand CMP
|
||||
vop-label ;
|
||||
|
||||
M: %jump-fixnum< generate-node ( vop -- )
|
||||
fixnum-branch JL ;
|
||||
|
||||
M: %jump-fixnum<= generate-node ( vop -- )
|
||||
fixnum-branch JLE ;
|
||||
|
||||
M: %jump-fixnum> generate-node ( vop -- )
|
||||
fixnum-branch JG ;
|
||||
|
||||
M: %jump-fixnum>= generate-node ( vop -- )
|
||||
fixnum-branch JGE ;
|
||||
|
||||
M: %jump-eq? generate-node ( vop -- )
|
||||
fixnum-branch JE ;
|
||||
M: %jump-fixnum< generate-node ( vop -- ) fixnum-jump JL ;
|
||||
M: %jump-fixnum<= generate-node ( vop -- ) fixnum-jump JLE ;
|
||||
M: %jump-fixnum> generate-node ( vop -- ) fixnum-jump JG ;
|
||||
M: %jump-fixnum>= generate-node ( vop -- ) fixnum-jump JGE ;
|
||||
M: %jump-eq? generate-node ( vop -- ) fixnum-jump JE ;
|
||||
|
|
|
@ -97,15 +97,41 @@ math-internals test words ;
|
|||
[ -1 ] [ 0 [ fixnum-bitnot ] compile-1 ] unit-test
|
||||
[ -1 ] [ [ 0 fixnum-bitnot ] compile-1 ] unit-test
|
||||
|
||||
[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
|
||||
[ 3 ] [ 13 10 [ fixnum-mod ] compile-1 ] unit-test
|
||||
[ 3 ] [ 13 [ 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ 3 ] [ [ 13 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ -13 10 [ fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ -13 [ 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ [ -13 10 fixnum-mod ] compile-1 ] unit-test
|
||||
|
||||
[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 2 ] [ 4 2 [ fixnum/i ] compile-1 ] unit-test
|
||||
[ 2 ] [ 4 [ 2 fixnum/i ] compile-1 ] unit-test
|
||||
[ -2 ] [ 4 [ -2 fixnum/i ] compile-1 ] unit-test
|
||||
[ 3 1 ] [ 10 3 [ fixnum/mod ] compile-1 ] unit-test
|
||||
|
||||
[ 4 ] [ 1 3 [ fixnum+ ] compile-1 ] unit-test
|
||||
[ 4 ] [ 1 [ 3 fixnum+ ] compile-1 ] unit-test
|
||||
[ 4 ] [ [ 1 3 fixnum+ ] compile-1 ] unit-test
|
||||
|
||||
[ 6 ] [ 2 3 [ fixnum* ] compile-1 ] unit-test
|
||||
[ 6 ] [ 2 [ 3 fixnum* ] compile-1 ] unit-test
|
||||
[ 6 ] [ [ 2 3 fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 -3 [ fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 [ -3 fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ [ 2 -3 fixnum* ] compile-1 ] unit-test
|
||||
|
||||
[ t ] [ 3 type 3 [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ 3 >bignum type 3 >bignum [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ "hey" type "hey" [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ f type f [ type ] compile-1 eq? ] unit-test
|
||||
|
||||
[ 1 1 0 ] [ 1 1 [ arithmetic-type ] compile-1 ] unit-test
|
||||
[ 1.0 1.0 5 ] [ 1.0 1 [ arithmetic-type ] compile-1 ] unit-test
|
||||
|
||||
[ 5 ] [ 1 2 [ eq? [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
[ 3 ] [ 2 2 [ eq? [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
[ 3 ] [ 1 2 [ fixnum< [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
[ 5 ] [ 2 2 [ fixnum< [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
|
||||
[ 8 ] [ 1 3 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 8 ] [ 1 [ 3 fixnum-shift ] compile-1 ] unit-test
|
||||
|
@ -122,47 +148,21 @@ math-internals test words ;
|
|||
[ -1 ] [ [ -123 -64 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -1 ] [ -123 -64 [ fixnum-shift ] compile-1 ] unit-test
|
||||
|
||||
[ 3 ] [ 13 10 [ fixnum-mod ] compile-1 ] unit-test
|
||||
[ 3 ] [ 13 [ 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ 3 ] [ [ 13 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ -13 10 [ fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ -13 [ 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ [ -13 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
|
||||
|
||||
[ 4 ] [ 1 3 [ fixnum+ ] compile-1 ] unit-test
|
||||
[ 4 ] [ 1 [ 3 fixnum+ ] compile-1 ] unit-test
|
||||
[ 4 ] [ [ 1 3 fixnum+ ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
|
||||
|
||||
[ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-1 1 28 fixnum-shift = ] unit-test
|
||||
[ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
|
||||
|
||||
[ 6 ] [ 2 3 [ fixnum* ] compile-1 ] unit-test
|
||||
[ 6 ] [ 2 [ 3 fixnum* ] compile-1 ] unit-test
|
||||
[ 6 ] [ [ 2 3 fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 -3 [ fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 [ -3 fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ [ 2 -3 fixnum* ] compile-1 ] unit-test
|
||||
|
||||
[ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-1 1 40 shift = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-1 1 40 shift neg = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-1 1 40 shift = ] unit-test
|
||||
|
||||
[ 2 ] [ 4 2 [ fixnum/i ] compile-1 ] unit-test
|
||||
[ 2 ] [ 4 [ 2 fixnum/i ] compile-1 ] unit-test
|
||||
[ -2 ] [ 4 [ -2 fixnum/i ] compile-1 ] unit-test
|
||||
[ 268435456 ] [ -268435456 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
|
||||
|
||||
[ 3 1 ] [ 10 3 [ fixnum/mod ] compile-1 ] unit-test
|
||||
|
||||
[ t ] [ 3 type 3 [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ 3 >bignum type 3 >bignum [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ "hey" type "hey" [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ f type f [ type ] compile-1 eq? ] unit-test
|
||||
|
||||
[ 1 1 0 ] [ 1 1 [ arithmetic-type ] compile-1 ] unit-test
|
||||
[ 1.0 1.0 5 ] [ 1.0 1 [ arithmetic-type ] compile-1 ] unit-test
|
||||
|
||||
[ 5 ] [ 1 2 [ eq? [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
[ 3 ] [ 2 2 [ eq? [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
[ 3 ] [ 1 2 [ fixnum< [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
[ 5 ] [ 2 2 [ fixnum< [ 3 ] [ 5 ] ifte ] compile-1 ] unit-test
|
||||
|
|
Loading…
Reference in New Issue