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

removing non-branching fixnum comparison vops

cvs
Slava Pestov 2005-09-09 22:00:38 +00:00
parent 2bdd82ea53
commit d2eddcb4e8
7 changed files with 61 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
library/compiler/intrinsics.factor
View File

@ -105,24 +105,35 @@ sequences vectors words ;
: binary-op ( node op -- )
>r load-inputs first2 swap dup r> execute , out-1 ; inline
[
[[ fixnum+ %fixnum+ ]]
[[ fixnum- %fixnum- ]]
[[ fixnum* %fixnum* ]]
[[ fixnum/i %fixnum/i ]]
[[ fixnum-bitand %fixnum-bitand ]]
[[ fixnum-bitor %fixnum-bitor ]]
[[ fixnum-bitxor %fixnum-bitxor ]]
[[ fixnum<= %fixnum<= ]]
[[ fixnum< %fixnum< ]]
[[ fixnum>= %fixnum>= ]]
[[ fixnum> %fixnum> ]]
[[ eq? %eq? ]]
] [
uncons [ literalize , \ binary-op , ] [ ] make
{
{ fixnum+ %fixnum+ }
{ fixnum- %fixnum- }
{ fixnum* %fixnum* }
{ fixnum/i %fixnum/i }
{ fixnum-bitand %fixnum-bitand }
{ fixnum-bitor %fixnum-bitor }
{ fixnum-bitxor %fixnum-bitxor }
} [
first2 [ literalize , \ binary-op , ] [ ] make
"intrinsic" set-word-prop
] each
: binary-jump ( node label op -- )
>r >r node-in-d values>vregs
dup length neg %inc-d , first2 swap
r> r> execute , ; inline
{
{ fixnum<= %jump-fixnum<= }
{ fixnum< %jump-fixnum< }
{ fixnum>= %jump-fixnum>= }
{ fixnum> %jump-fixnum> }
{ eq? %jump-eq? }
} [
first2 [ literalize , \ binary-jump , ] [ ] make
"ifte-intrinsic" set-word-prop
] each
\ fixnum-mod [
! This is not clever. Because of x86, %fixnum-mod is
! hard-coded to put its output in vreg 2, which happends to

23
library/compiler/linearizer.factor
View File

@ -35,24 +35,33 @@ M: #label linearize* ( node -- )
: intrinsic ( #call -- quot ) node-param "intrinsic" word-prop ;
: ifte-intrinsic ( #call -- quot )
dup node-successor #ifte?
[ node-param "ifte-intrinsic" word-prop ] [ drop f ] ifte ;
: linearize-ifte ( node label -- )
#! Assume the quotation emits a VOP that jumps to the label
#! if some condition holds; we linearize the false branch,
#! then the label, then the true branch.
>r node-children first2 linearize* r> %label , linearize* ;
M: #call linearize* ( node -- )
dup ifte-intrinsic [
>r <label> 2dup r> call
>r node-successor r> linearize-ifte
] [
dup intrinsic [
dupd call linearize-next
] [
\ %call \ %jump ?tail-call
] ifte*
] ifte* ;
M: #call-label linearize* ( node -- )
\ %call-label \ %jump-label ?tail-call ;
: ifte-head ( label -- ) in-1 -1 %inc-d , 0 %jump-t , ;
M: #ifte linearize* ( node -- )
node-children first2
<label> dup ifte-head
swap linearize* ( false branch )
%label , ( branch target of BRANCH-T )
linearize* ( true branch ) ;
<label> dup in-1 -1 %inc-d , 0 %jump-t , linearize-ifte ;
: dispatch-head ( vtable -- label/code )
#! Output the jump table insn and return a list of

35
library/compiler/ppc/fixnum.factor
View File

@ -141,37 +141,12 @@ M: %fixnum>> generate-node ( vop -- )
M: %fixnum-sgn generate-node ( vop -- )
dest/src dupd 31 SRAWI dup untag ;
: compare ( vop -- )
dup 1 vop-in v>operand swap 0 vop-in 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
#! in dest depending on the jump being taken or not.
<label> "true" set
<label> "end" set
"true" get swap execute
f address over LI
"end" get B
"true" get save-xt
t load-indirect
"end" get save-xt ; inline
: fixnum-pred ( vop word -- dest )
>r [ compare ] keep 0 vop-out v>operand r> load-boolean ;
inline
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 ;
: fixnum-jump ( vop -- label )
[ compare ] keep vop-label ;
[
dup 1 vop-in v>operand
swap 0 vop-in v>operand
0 swap CMP
] keep vop-label ;
M: %jump-fixnum< generate-node ( vop -- ) fixnum-jump BLT ;
M: %jump-fixnum<= generate-node ( vop -- ) fixnum-jump BLE ;

26
library/compiler/vops.factor
View File

@ -261,17 +261,6 @@ TUPLE: %fixnum-bitnot ;
C: %fixnum-bitnot make-vop ; : %fixnum-bitnot 2-vop <%fixnum-bitnot> ;
M: %fixnum-bitnot basic-block? drop t ;
TUPLE: %fixnum<= ;
C: %fixnum<= make-vop ; : %fixnum<= 3-vop <%fixnum<=> ;
TUPLE: %fixnum< ;
C: %fixnum< make-vop ; : %fixnum< 3-vop <%fixnum<> ;
TUPLE: %fixnum>= ;
C: %fixnum>= make-vop ; : %fixnum>= 3-vop <%fixnum>=> ;
TUPLE: %fixnum> ;
C: %fixnum> make-vop ; : %fixnum> 3-vop <%fixnum>> ;
TUPLE: %eq? ;
C: %eq? make-vop ; : %eq? 3-vop <%eq?> ;
! At the VOP level, the 'shift' operation is split into five
! distinct operations:
! - shifts with a large positive count: calls runtime to make
@ -293,7 +282,6 @@ TUPLE: %fixnum-sgn ;
C: %fixnum-sgn make-vop ; : %fixnum-sgn src/dest-vop <%fixnum-sgn> ;
M: %fixnum-sgn basic-block? drop t ;
! Integer comparison followed by a conditional branch is
! optimized
TUPLE: %jump-fixnum<= ;
@ -316,20 +304,6 @@ TUPLE: %jump-eq? ;
C: %jump-eq? make-vop ;
: %jump-eq? 2-in/label-vop <%jump-eq?> ;
: fast-branch ( class -- class )
{{
[[ %fixnum<= %jump-fixnum<= ]]
[[ %fixnum< %jump-fixnum< ]]
[[ %fixnum>= %jump-fixnum>= ]]
[[ %fixnum> %jump-fixnum> ]]
[[ %eq? %jump-eq? ]]
}} hash ;
PREDICATE: tuple fast-branch
#! Class of VOPs whose class is a key in fast-branch
#! hashtable.
class fast-branch ;
! some slightly optimized inline assembly
TUPLE: %type ;
C: %type make-vop ;

30
library/compiler/x86/fixnum.factor
View File

@ -157,36 +157,6 @@ M: %fixnum-sgn generate-node
! give it a fixnum tag.
0 vop-out v>operand tag-bits SHL ;
: load-boolean ( dest cond -- )
#! Compile this after a conditional jump to store f or t
#! in dest depending on the jump being taken or not.
<label> "true" set
<label> "end" set
"true" get swap execute
dup f address MOV
"end" get JMP
"true" get save-xt
t load-indirect
"end" get save-xt ; inline
: fixnum-compare ( vop -- dest )
dup 0 vop-out v>operand dup rot 0 vop-in v>operand CMP ;
M: %fixnum< generate-node ( vop -- )
fixnum-compare \ JL load-boolean ;
M: %fixnum<= generate-node ( vop -- )
fixnum-compare \ JLE load-boolean ;
M: %fixnum> generate-node ( vop -- )
fixnum-compare \ JG load-boolean ;
M: %fixnum>= generate-node ( vop -- )
fixnum-compare \ JGE load-boolean ;
M: %eq? generate-node ( vop -- )
fixnum-compare \ JE load-boolean ;
: fixnum-jump ( vop -- label )
dup 1 vop-in v>operand over 0 vop-in v>operand CMP
vop-label ;

16
library/inference/known-words.factor
View File

@ -30,14 +30,14 @@ memory parser sequences strings vectors words prettyprint ;
\ eq? t "flushable" set-word-prop
\ eq? t "foldable" set-word-prop
! : manual-branch ( word -- )
! dup "infer-effect" word-prop consume/produce
! [ [ t ] [ f ] ifte ] infer-quot ;
!
! { fixnum<= fixnum< fixnum>= fixnum> eq? } [
! dup dup literalize [ manual-branch ] cons
! "infer" set-word-prop
! ] each
: manual-branch ( word -- )
dup "infer-effect" word-prop consume/produce
[ [ t ] [ f ] ifte ] infer-quot ;
{ fixnum<= fixnum< fixnum>= fixnum> eq? } [
dup dup literalize [ manual-branch ] cons
"infer" set-word-prop
] each
! Primitive combinators
\ call [ [ general-list ] [ ] ] "infer-effect" set-word-prop

5
library/test/compiler/intrinsics.factor
View File

@ -172,6 +172,7 @@ math-internals test words ;
[ t ] [ { 1 2 3 } { 1 2 3 } [ over type over type eq? ] compile-1 2nip ] unit-test
! regression
: blah over cons? [ "x" get >r 2cdr r> ] [ 2drop f f f ] ifte ; compiled
: bleh 3 ;
: blah over cons? [ bleh >r 2cdr r> ] [ 2drop f f f ] ifte ; compiled
[ f ] [ f "x" set [ 1 2 3 ] [ 1 3 2 ] blah drop 2car = ] unit-test
[ f ] [ f [ 1 2 3 ] [ 1 3 2 ] blah drop 2car = ] unit-test