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

More work on overflow instructions: don't need temp register anymore, add -tail variants which don't need stack frame

db4
Slava Pestov 2008-11-28 06:36:30 -06:00
parent 5634becda1
commit f44506089d
12 changed files with 137 additions and 88 deletions

4
basis/compiler/cfg/builder/builder.factor
View File

@ -21,8 +21,6 @@ IN: compiler.cfg.builder
! Convert tree SSA IR to CFG SSA IR.
: stop-iterating ( -- next ) end-basic-block f ;
SYMBOL: procedures
SYMBOL: current-word
SYMBOL: current-label
@ -211,7 +209,7 @@ M: #dispatch emit-node
! #call
M: #call emit-node
dup word>> dup "intrinsic" word-prop
[ emit-intrinsic iterate-next ] [ nip emit-call ] if ;
[ emit-intrinsic ] [ nip emit-call ] if ;
! #call-recursive
M: #call-recursive emit-node label>> id>> emit-call ;

1
basis/compiler/cfg/def-use/def-use.factor
View File

@ -18,7 +18,6 @@ M: ##string-nth defs-vregs dst/tmp-vregs ;
M: ##compare defs-vregs dst/tmp-vregs ;
M: ##compare-imm defs-vregs dst/tmp-vregs ;
M: ##compare-float defs-vregs dst/tmp-vregs ;
M: ##fixnum-overflow defs-vregs temp>> 1array ;
M: insn defs-vregs drop f ;
M: ##unary uses-vregs src>> 1array ;

5
basis/compiler/cfg/instructions/instructions.factor
View File

@ -93,10 +93,13 @@ INSN: ##sar-imm < ##binary-imm ;
INSN: ##not < ##unary ;
! Overflowing arithmetic
TUPLE: ##fixnum-overflow < insn src1 src2 temp ;
TUPLE: ##fixnum-overflow < insn src1 src2 ;
INSN: ##fixnum-add < ##fixnum-overflow ;
INSN: ##fixnum-add-tail < ##fixnum-overflow ;
INSN: ##fixnum-sub < ##fixnum-overflow ;
INSN: ##fixnum-sub-tail < ##fixnum-overflow ;
INSN: ##fixnum-mul < ##fixnum-overflow ;
INSN: ##fixnum-mul-tail < ##fixnum-overflow ;
: ##tag-fixnum ( dst src -- ) tag-bits get ##shl-imm ; inline
: ##untag-fixnum ( dst src -- ) tag-bits get ##sar-imm ; inline

18
basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
View File

@ -3,7 +3,10 @@
USING: sequences accessors layouts kernel math namespaces
combinators fry locals
compiler.tree.propagation.info
compiler.cfg.stacks compiler.cfg.hats compiler.cfg.instructions
compiler.cfg.hats
compiler.cfg.stacks
compiler.cfg.iterator
compiler.cfg.instructions
compiler.cfg.utilities ;
IN: compiler.cfg.intrinsics.fixnum
@ -65,5 +68,14 @@ IN: compiler.cfg.intrinsics.fixnum
: emit-fixnum>bignum ( -- )
ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
: emit-fixnum-overflow-op ( quot -- )
[ 2inputs i 1 ##inc-d ] dip call begin-basic-block ; inline
: emit-fixnum-overflow-op ( quot quot-tail -- next )
[ 2inputs 1 ##inc-d ] 2dip
tail-call? [
##epilogue
nip call
stop-iterating
] [
drop call
begin-basic-block
iterate-next
] if ; inline

119
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -8,7 +8,8 @@ compiler.cfg.intrinsics.alien
compiler.cfg.intrinsics.allot
compiler.cfg.intrinsics.fixnum
compiler.cfg.intrinsics.float
compiler.cfg.intrinsics.slots ;
compiler.cfg.intrinsics.slots
compiler.cfg.iterator ;
QUALIFIED: kernel
QUALIFIED: arrays
QUALIFIED: byte-arrays
@ -87,63 +88,63 @@ IN: compiler.cfg.intrinsics
alien.accessors:set-alien-double
} [ t "intrinsic" set-word-prop ] each ;
: emit-intrinsic ( node word -- )
: emit-intrinsic ( node word -- node/f )
{
{ \ kernel.private:tag [ drop emit-tag ] }
{ \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] }
{ \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] }
{ \ math.private:fixnum* [ drop [ ##fixnum-mul ] emit-fixnum-overflow-op ] }
{ \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op ] }
{ \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op ] }
{ \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op ] }
{ \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op ] }
{ \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op ] }
{ \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
{ \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
{ \ math.private:fixnum*fast [ emit-fixnum*fast ] }
{ \ math.private:fixnum< [ cc< emit-fixnum-comparison ] }
{ \ math.private:fixnum<= [ cc<= emit-fixnum-comparison ] }
{ \ math.private:fixnum>= [ cc>= emit-fixnum-comparison ] }
{ \ math.private:fixnum> [ cc> emit-fixnum-comparison ] }
{ \ kernel:eq? [ cc= emit-fixnum-comparison ] }
{ \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] }
{ \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] }
{ \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
{ \ math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
{ \ math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
{ \ math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
{ \ math.private:float< [ drop cc< emit-float-comparison ] }
{ \ math.private:float<= [ drop cc<= emit-float-comparison ] }
{ \ math.private:float>= [ drop cc>= emit-float-comparison ] }
{ \ math.private:float> [ drop cc> emit-float-comparison ] }
{ \ math.private:float= [ drop cc= emit-float-comparison ] }
{ \ math.private:float>fixnum [ drop emit-float>fixnum ] }
{ \ math.private:fixnum>float [ drop emit-fixnum>float ] }
{ \ slots.private:slot [ emit-slot ] }
{ \ slots.private:set-slot [ emit-set-slot ] }
{ \ strings.private:string-nth [ drop emit-string-nth ] }
{ \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
{ \ arrays:<array> [ emit-<array> ] }
{ \ byte-arrays:<byte-array> [ emit-<byte-array> ] }
{ \ math.private:<complex> [ emit-simple-allot ] }
{ \ math.private:<ratio> [ emit-simple-allot ] }
{ \ kernel:<wrapper> [ emit-simple-allot ] }
{ \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
{ \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
{ \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
{ \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
{ \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
{ \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
{ \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
{ \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
{ \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
{ \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
{ \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
{ \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
{ \ alien.accessors:alien-cell [ emit-alien-cell-getter ] }
{ \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
{ \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter ] }
{ \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter ] }
{ \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter ] }
{ \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter ] }
{ \ kernel.private:tag [ drop emit-tag iterate-next ] }
{ \ math.private:fixnum+ [ drop [ ##fixnum-add ] [ ##fixnum-add-tail ] emit-fixnum-overflow-op ] }
{ \ math.private:fixnum- [ drop [ ##fixnum-sub ] [ ##fixnum-sub-tail ] emit-fixnum-overflow-op ] }
{ \ math.private:fixnum* [ drop [ ##fixnum-mul ] [ ##fixnum-mul-tail ] emit-fixnum-overflow-op ] }
{ \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op iterate-next ] }
{ \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op iterate-next ] }
{ \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op iterate-next ] }
{ \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op iterate-next ] }
{ \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op iterate-next ] }
{ \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast iterate-next ] }
{ \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot iterate-next ] }
{ \ math.private:fixnum*fast [ emit-fixnum*fast iterate-next ] }
{ \ math.private:fixnum< [ cc< emit-fixnum-comparison iterate-next ] }
{ \ math.private:fixnum<= [ cc<= emit-fixnum-comparison iterate-next ] }
{ \ math.private:fixnum>= [ cc>= emit-fixnum-comparison iterate-next ] }
{ \ math.private:fixnum> [ cc> emit-fixnum-comparison iterate-next ] }
{ \ kernel:eq? [ cc= emit-fixnum-comparison iterate-next ] }
{ \ math.private:bignum>fixnum [ drop emit-bignum>fixnum iterate-next ] }
{ \ math.private:fixnum>bignum [ drop emit-fixnum>bignum iterate-next ] }
{ \ math.private:float+ [ drop [ ^^add-float ] emit-float-op iterate-next ] }
{ \ math.private:float- [ drop [ ^^sub-float ] emit-float-op iterate-next ] }
{ \ math.private:float* [ drop [ ^^mul-float ] emit-float-op iterate-next ] }
{ \ math.private:float/f [ drop [ ^^div-float ] emit-float-op iterate-next ] }
{ \ math.private:float< [ drop cc< emit-float-comparison iterate-next ] }
{ \ math.private:float<= [ drop cc<= emit-float-comparison iterate-next ] }
{ \ math.private:float>= [ drop cc>= emit-float-comparison iterate-next ] }
{ \ math.private:float> [ drop cc> emit-float-comparison iterate-next ] }
{ \ math.private:float= [ drop cc= emit-float-comparison iterate-next ] }
{ \ math.private:float>fixnum [ drop emit-float>fixnum iterate-next ] }
{ \ math.private:fixnum>float [ drop emit-fixnum>float iterate-next ] }
{ \ slots.private:slot [ emit-slot iterate-next ] }
{ \ slots.private:set-slot [ emit-set-slot iterate-next ] }
{ \ strings.private:string-nth [ drop emit-string-nth iterate-next ] }
{ \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> iterate-next ] }
{ \ arrays:<array> [ emit-<array> iterate-next ] }
{ \ byte-arrays:<byte-array> [ emit-<byte-array> iterate-next ] }
{ \ math.private:<complex> [ emit-simple-allot iterate-next ] }
{ \ math.private:<ratio> [ emit-simple-allot iterate-next ] }
{ \ kernel:<wrapper> [ emit-simple-allot iterate-next ] }
{ \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter iterate-next ] }
{ \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter iterate-next ] }
{ \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter iterate-next ] }
{ \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter iterate-next ] }
{ \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter iterate-next ] }
{ \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter iterate-next ] }
{ \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter iterate-next ] }
{ \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter iterate-next ] }
{ \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter iterate-next ] }
{ \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter iterate-next ] }
{ \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter iterate-next ] }
{ \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter iterate-next ] }
{ \ alien.accessors:alien-cell [ emit-alien-cell-getter iterate-next ] }
{ \ alien.accessors:set-alien-cell [ emit-alien-cell-setter iterate-next ] }
{ \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter iterate-next ] }
{ \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter iterate-next ] }
{ \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter iterate-next ] }
{ \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter iterate-next ] }
} case ;

3
basis/compiler/cfg/stack-frame/stack-frame.factor
View File

@ -37,6 +37,9 @@ M: insn compute-stack-frame*
\ ##fixnum-add t frame-required? set-word-prop
\ ##fixnum-sub t frame-required? set-word-prop
\ ##fixnum-mul t frame-required? set-word-prop
\ ##fixnum-add-tail f frame-required? set-word-prop
\ ##fixnum-sub-tail f frame-required? set-word-prop
\ ##fixnum-mul-tail f frame-required? set-word-prop
: compute-stack-frame ( insns -- )
frame-required? off

2
basis/compiler/cfg/utilities/utilities.factor
View File

@ -33,5 +33,7 @@ IN: compiler.cfg.utilities
building off
basic-block off ;
: stop-iterating ( -- next ) end-basic-block f ;
: emit-primitive ( node -- )
word>> ##call ##branch begin-basic-block ;

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

@ -156,14 +156,15 @@ M: ##shr-imm generate-insn dst/src1/src2 %shr-imm ;
M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ;
M: ##not generate-insn dst/src %not ;
: src1/src2/temp ( insn -- src1 src2 temp )
[ src1>> register ]
[ src2>> register ]
[ temp>> register ] tri ; inline
: src1/src2 ( insn -- src1 src2 )
[ src1>> register ] [ src2>> register ] bi ; inline
M: ##fixnum-add generate-insn src1/src2/temp %fixnum-add ;
M: ##fixnum-sub generate-insn src1/src2/temp %fixnum-sub ;
M: ##fixnum-mul generate-insn src1/src2/temp %fixnum-mul ;
M: ##fixnum-add generate-insn src1/src2 %fixnum-add ;
M: ##fixnum-add-tail generate-insn src1/src2 %fixnum-add-tail ;
M: ##fixnum-sub generate-insn src1/src2 %fixnum-sub ;
M: ##fixnum-sub-tail generate-insn src1/src2 %fixnum-sub-tail ;
M: ##fixnum-mul generate-insn src1/src2 %fixnum-mul ;
M: ##fixnum-mul-tail generate-insn src1/src2 %fixnum-mul-tail ;
: dst/src/temp ( insn -- dst src temp )
[ dst/src ] [ temp>> register ] bi ; inline

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

@ -77,9 +77,12 @@ HOOK: %shr-imm cpu ( dst src1 src2 -- )
HOOK: %sar-imm cpu ( dst src1 src2 -- )
HOOK: %not cpu ( dst src -- )
HOOK: %fixnum-add cpu ( src1 src2 temp -- )
HOOK: %fixnum-sub cpu ( src1 src2 temp -- )
HOOK: %fixnum-mul cpu ( src1 src2 temp -- )
HOOK: %fixnum-add cpu ( src1 src2 -- )
HOOK: %fixnum-add-tail cpu ( src1 src2 -- )
HOOK: %fixnum-sub cpu ( src1 src2 -- )
HOOK: %fixnum-sub-tail cpu ( src1 src2 -- )
HOOK: %fixnum-mul cpu ( src1 src2 -- )
HOOK: %fixnum-mul-tail cpu ( src1 src2 -- )
HOOK: %integer>bignum cpu ( dst src temp -- )
HOOK: %bignum>integer cpu ( dst src temp -- )

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

@ -48,6 +48,8 @@ M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
M: x86.32 %alien-invoke (CALL) rel-dlsym ;
M: x86.32 %alien-invoke-tail (JMP) rel-dlsym ;
M: x86.32 struct-small-enough? ( size -- ? )
heap-size { 1 2 4 8 } member?
os { linux netbsd solaris } member? not and ;

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

@ -168,6 +168,11 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
M: x86.64 %alien-invoke-tail
R11 0 MOV
rc-absolute-cell rel-dlsym
R11 JMP ;
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
RBP RAX MOV ;

42
basis/cpu/x86/x86.factor
View File

@ -108,22 +108,42 @@ M: x86 %not drop NOT ;
]
} cond ;
:: overflow-template ( src1 src2 temp insn func -- )
<label> "end" set
temp src1 MOV
temp src2 insn call
ds-reg [] temp MOV
"end" get JNO
HOOK: %alien-invoke-tail cpu ( func dll -- )
:: overflow-template ( src1 src2 insn inverse func -- )
<label> "no-overflow" set
src1 src2 insn call
ds-reg [] src1 MOV
"no-overflow" get JNO
src1 src2 inverse call
src1 src2 move>args
%prepare-alien-invoke
func f %alien-invoke
"end" resolve-label ;
"no-overflow" resolve-label ; inline
M: x86 %fixnum-add ( src1 src2 temp -- )
[ ADD ] "overflow_fixnum_add" overflow-template ;
:: overflow-template-tail ( src1 src2 insn inverse func -- )
<label> "no-overflow" set
src1 src2 insn call
"no-overflow" get JNO
src1 src2 inverse call
src1 src2 move>args
%prepare-alien-invoke
func f %alien-invoke-tail
"no-overflow" resolve-label
ds-reg [] src1 MOV
0 RET ; inline
M: x86 %fixnum-sub ( src1 src2 temp -- )
[ SUB ] "overflow_fixnum_subtract" overflow-template ;
M: x86 %fixnum-add ( src1 src2 -- )
[ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template ;
M: x86 %fixnum-add-tail ( src1 src2 -- )
[ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template-tail ;
M: x86 %fixnum-sub ( src1 src2 -- )
[ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template ;
M: x86 %fixnum-sub-tail ( src1 src2 -- )
[ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template-tail ;
: bignum@ ( reg n -- op )
cells bignum tag-number - [+] ; inline