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

Working on PowerPC overflow checks

db4
Slava Pestov 2008-11-28 20:02:50 -06:00
parent eb8c621b6f
commit 68dd6cc35a
3 changed files with 98 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -89,6 +89,9 @@ IN: compiler.cfg.intrinsics
alien.accessors:set-alien-double
} [ t "intrinsic" set-word-prop ] each ;
: enable-fixnum*-intrinsic ( -- )
\ math.private:fixnum* t "intrinsic" set-word-prop ;
: emit-intrinsic ( node word -- node/f )
{
{ \ kernel.private:tag [ drop emit-tag iterate-next ] }

58
basis/cpu/ppc/ppc.factor
View File

@ -17,6 +17,7 @@ IN: cpu.ppc
! f30, f31: float scratch
enable-float-intrinsics
enable-fixnum*-intrinsic
<< \ ##integer>float t frame-required? set-word-prop
\ ##float>integer t frame-required? set-word-prop >>
@ -164,6 +165,63 @@ M: ppc %shr-imm swapd SRWI ;
M: ppc %sar-imm SRAWI ;
M: ppc %not NOT ;
: %alien-invoke-tail ( func dll -- )
11 %load-dlsym 11 MTCTR BCTR ;
: exchange-regs ( r1 r2 -- )
scratch-reg swap MR scratch-reg MR ;
:: move>args ( src1 src2 -- )
{
{ [ src1 4 = ] [ 3 src2 ?MR 3 4 exchange-regs ] }
{ [ src1 3 = ] [ 4 src2 ?MR ] }
{ [ src2 3 = ] [ 4 src1 ?MR 3 4 exchange-regs ] }
{ [ src2 4 = ] [ 3 src1 ?MR ] }
[ 3 src1 MR 4 src2 MR ]
} cond ;
:: overflow-check ( src1 src2 insn insn-o func -- )
"no-overflow" define-label
0 0 LI
0 MTXER
scratch-reg src1 src2 insn-o execute
scratch-reg ds-reg 0 STW
"no-overflow" get BNO
move>args
%prepare-alien-invoke
func f %alien-invoke
"no-overflow" resolve-label ; inline
:: overflow-check-tail ( src1 src2 insn insn-o func -- )
"no-overflow" define-label
0 0 LI
0 MTXER
scratch-reg src1 src2 insn-o execute
"no-overflow" get BNO
move>args
%prepare-alien-invoke
func f %alien-invoke-tail
"no-overflow" resolve-label
scratch-reg ds-reg 0 STW ; inline
M: ppc %fixnum-add ( src1 src2 -- )
[ ADD ] [ ADDO. ] "overflow_fixnum_add" overflow-template ;
M: ppc %fixnum-add-tail ( src1 src2 -- )
[ ADD ] [ ADDO. ] "overflow_fixnum_add" overflow-template-tail ;
M: ppc %fixnum-sub ( src1 src2 -- )
[ SUBF ] [ SUBFO. ] "overflow_fixnum_subtract" overflow-template ;
M: ppc %fixnum-sub-tail ( src1 src2 -- )
[ SUBF ] [ SUBFO. ] "overflow_fixnum_subtract" overflow-template-tail ;
M: ppc %fixnum-mul ( src1 src2 -- )
[ MULLW ] [ MULLWO. ] "overflow_fixnum_multiply" overflow-template ;
M: ppc %fixnum-mul-tail ( src1 src2 -- )
[ MULLW ] [ MULLWO. ] "overflow_fixnum_multiply" overflow-template-tail ;
: bignum@ ( n -- offset ) cells bignum tag-number - ; inline
M:: ppc %integer>bignum ( dst src temp -- )

37
vm/cpu-ppc.S
View File

@ -2,6 +2,43 @@
in the public domain. */
#include "asm.h"
#define DS_REG 29
DEF(void,primitive_fixnum_add,(void)):
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
addo. r5,r3,r4
bo MANGLE(overflow_fixnum_add)
stw r5,0(DS_REG)
blr
DEF(void,primitive_fixnum_subtract,(void)):
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
subfo. r5,r3,r4
bo MANGLE(overflow_fixnum_subtract)
stw r5,0(DS_REG)
blr
DEF(void,primitive_fixnum_multiply,(void)):
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
srawi r3,r3,3
mullwo. r5,r3,r4
bo multiply_overflow
stw r5,0(DS_REG)
blr
multiply_overflow:
srawi r4,r4,3
jmp MANGLE(overflow_fixnum_multiply)
/* Note that the XT is passed to the quotation in r11 */
#define CALL_OR_JUMP_QUOT \
lwz r11,9(r3) /* load quotation-xt slot */ XX \