factor/library/compiler/ppc/fixnum.factor

159 lines
4.2 KiB
Factor
Raw Normal View History

! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: compiler-backend
2005-12-03 16:13:09 -05:00
USING: assembler compiler kernel kernel-internals math
math-internals memory namespaces words ;
2005-06-07 03:44:34 -04:00
: >3-imm< ( vop -- out1 in2 in1 )
2005-09-08 22:23:54 -04:00
[ 0 vop-out v>operand ] keep
[ 1 vop-in v>operand ] keep
0 vop-in ;
2005-06-07 03:44:34 -04:00
: >3-vop< ( vop -- out1 in1 in2 )
>3-imm< v>operand swap ;
2005-06-05 02:43:05 -04:00
: simple-overflow ( vop inv word -- )
>r >r
<label> "end" set
"end" get BNO
2005-06-07 03:44:34 -04:00
dup >3-vop< 3dup r> execute
2005-06-05 02:43:05 -04:00
2dup
dup untag-fixnum
dup untag-fixnum
2005-06-05 02:43:05 -04:00
3 -rot r> execute
2005-06-07 03:44:34 -04:00
drop
2005-06-05 02:43:05 -04:00
"s48_long_to_bignum" f compile-c-call
! An untagged pointer to the bignum is now in r3; tag it
2005-09-08 22:23:54 -04:00
3 swap 0 vop-out v>operand bignum-tag ORI
2005-06-05 02:43:05 -04:00
"end" get save-xt ; inline
M: %fixnum+ generate-node ( vop -- )
2005-06-05 02:43:05 -04:00
0 MTXER
2005-06-07 03:44:34 -04:00
dup >3-vop< ADDO.
2005-06-05 02:43:05 -04:00
\ SUBF \ ADD simple-overflow ;
M: %fixnum- generate-node ( vop -- )
2005-06-05 02:43:05 -04:00
0 MTXER
2005-06-07 03:44:34 -04:00
dup >3-vop< SUBFO.
2005-06-05 02:43:05 -04:00
\ ADD \ SUBF simple-overflow ;
M: %fixnum* generate-node ( vop -- )
#! Note that this assumes the output will be in r3.
>3-vop< dup dup untag-fixnum
2005-06-07 03:44:34 -04:00
0 MTXER
2005-09-05 03:06:47 -04:00
[ >r >r drop 6 r> r> MULLWO. 3 ] 2keep
2005-06-07 03:44:34 -04:00
<label> "end" set
"end" get BNO
MULHW
2005-09-05 03:06:47 -04:00
4 6 MR
2005-06-07 03:44:34 -04:00
"s48_long_long_to_bignum" f compile-c-call
! now we have to shift it by three bits to remove the second
! tag
tag-bits neg 4 LI
"s48_bignum_arithmetic_shift" f compile-c-call
! An untagged pointer to the bignum is now in r3; tag it
2005-09-05 03:06:47 -04:00
3 6 bignum-tag ORI
"end" get save-xt
3 6 MR ;
: generate-fixnum/i
6 3 4 DIVW ! divide in2 by in1, store result in out1
! if the result is greater than the most positive fixnum,
! which can only ever happen if we do
! most-negative-fixnum -1 /i, then the result is a bignum.
2005-09-05 03:06:47 -04:00
<label> "end" set
<label> "no-overflow" set
most-positive-fixnum 7 LOAD
6 0 7 CMP
"no-overflow" get BLE
2005-09-05 03:06:47 -04:00
most-negative-fixnum neg 3 LOAD
"s48_long_to_bignum" f compile-c-call
3 3 bignum-tag ORI ;
M: %fixnum/i generate-node ( vop -- )
#! This has specific vreg requirements.
drop
generate-fixnum/i
"end" get B
"no-overflow" get save-xt
6 3 tag-fixnum
2005-09-05 03:06:47 -04:00
"end" get save-xt ;
: generate-fixnum-mod
7 6 4 MULLW ! multiply out1 by in1, store result in in1
2005-09-05 03:06:47 -04:00
5 7 3 SUBF ! subtract in2 from in1, store result in out1.
;
M: %fixnum-mod generate-node ( vop -- )
#! This has specific vreg requirements.
drop
6 3 4 DIVW ! divide in2 by in1, store result in out1
generate-fixnum-mod ;
M: %fixnum/mod generate-node ( vop -- )
#! This has specific vreg requirements.
drop
generate-fixnum/i
0 5 LI
"end" get B
"no-overflow" get save-xt
generate-fixnum-mod
6 3 tag-fixnum
"end" get save-xt ;
M: %fixnum-bitand generate-node ( vop -- )
2005-06-07 03:44:34 -04:00
>3-vop< AND ;
M: %fixnum-bitor generate-node ( vop -- )
2005-06-07 03:44:34 -04:00
>3-vop< OR ;
M: %fixnum-bitxor generate-node ( vop -- )
2005-06-07 03:44:34 -04:00
>3-vop< XOR ;
M: %fixnum-bitnot generate-node ( vop -- )
2005-06-05 02:43:05 -04:00
dest/src dupd NOT dup untag ;
M: %fixnum<< generate-node ( vop -- )
2005-06-07 03:44:34 -04:00
! This has specific register requirements.
<label> "no-overflow" set
<label> "end" set
2005-09-08 22:23:54 -04:00
0 vop-in
2005-06-07 03:44:34 -04:00
! check for potential overflow
2005-09-05 03:06:47 -04:00
dup shift-add dup 5 LOAD
4 3 5 ADD
2005-09-16 22:47:28 -04:00
2 * 1- 5 LOAD
2005-09-05 03:06:47 -04:00
5 0 4 CMPL
2005-06-07 03:44:34 -04:00
! is there going to be an overflow?
"no-overflow" get BGE
! there is going to be an overflow, make a bignum
3 3 untag-fixnum
2005-06-07 03:44:34 -04:00
"s48_long_to_bignum" f compile-c-call
dup 4 LI
"s48_bignum_arithmetic_shift" f compile-c-call
! tag the result
2005-09-05 03:06:47 -04:00
3 3 bignum-tag ORI
2005-06-07 03:44:34 -04:00
"end" get B
! there is not going to be an overflow
"no-overflow" get save-xt
2005-09-05 17:14:15 -04:00
3 3 rot SLWI.
2005-06-07 03:44:34 -04:00
"end" get save-xt ;
M: %fixnum>> generate-node ( vop -- )
2005-06-07 03:44:34 -04:00
>3-imm< pick >r SRAWI r> dup untag ;
M: %fixnum-sgn generate-node ( vop -- )
2005-06-05 02:43:05 -04:00
dest/src dupd 31 SRAWI dup untag ;
: fixnum-jump ( 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 ;
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 ;