\ ADD \ SUBF simple-overflow ;
M: %fixnum* generate-node ( vop -- )
- dup >3-vop< dup dup tag-bits SRAWI
+ #! Note that this assumes the output will be in r3.
+ >3-vop< dup dup tag-bits SRAWI
0 MTXER
[ >r >r drop 4 r> r> MULLWO. 3 ] 2keep
<label> "end" set
"s48_bignum_arithmetic_shift" f compile-c-call
! An untagged pointer to the bignum is now in r3; tag it
3 4 bignum-tag ORI
- "end" get save-xt
- vop-out-1 v>operand 4 MR ;
+ "end" get save-xt ;
M: %fixnum/i generate-node ( vop -- )
dup >3-vop< swap DIVW
#! 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
- 21 20 18 MULLW ! multiply out1 by in1, store result in in1
- 19 21 17 SUBF ! subtract in2 from in1, store result in out1.
+ 6 3 4 DIVW ! divide in2 by in1, store result in out1
+ 7 6 4 MULLW ! multiply out1 by in1, store result in in1
+ 5 8 3 SUBF ! subtract in2 from in1, store result in out1.
;
M: %fixnum-mod generate-node ( vop -- )
M: %fixnum/mod generate-node ( vop -- )
#! This has specific vreg requirements.
drop generate-fixnum/mod
- 17 20 MR
- 17 17 tag-fixnum ;
+ 3 6 MR
+ 3 3 tag-fixnum ;
M: %fixnum-bitand generate-node ( vop -- )
>3-vop< AND ;
M: %fixnum-sgn generate-node ( vop -- )
dest/src dupd 31 SRAWI dup 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
: compile-c-call ( symbol dll -- )
2dup dlsym 19 LOAD32 0 1 rel-dlsym 19 MTLR BLRL ;
-M: vreg v>operand vreg-n 17 + ;
-
M: %prologue generate-node ( vop -- )
drop
1 1 -16 STWU
B ;
: word-addr ( word -- )
- dup word-xt 19 LOAD32 0 1 rel-word ;
+ #! Load a word address into r3.
+ dup word-xt 3 LOAD32 0 1 rel-word ;
: compile-call ( label -- )
#! Far C call for primitives, near C call for compiled defs.
- dup primitive? [ word-addr 19 MTLR BLRL ] [ BL ] ifte ;
+ dup primitive? [ word-addr 3 MTLR BLRL ] [ BL ] ifte ;
M: %call generate-node ( vop -- )
vop-label dup postpone-word compile-call ;
: compile-jump ( label -- )
#! For tail calls. IP not saved on C stack.
- dup primitive? [ word-addr 19 MTCTR BCTR ] [ B ] ifte ;
+ dup primitive? [ word-addr 3 MTCTR BCTR ] [ B ] ifte ;
M: %jump generate-node ( vop -- )
vop-label dup postpone-word compile-epilogue compile-jump ;
conditional BNE ;
M: %return-to generate-node ( vop -- )
- vop-label 0 18 LOAD32 absolute-16/16
+ vop-label 0 3 LOAD32 absolute-16/16
1 1 -16 STWU
- 18 1 20 STW ;
+ 3 1 20 STW ;
M: %return generate-node ( vop -- )
drop compile-epilogue BLR ;
M: %dispatch generate-node ( vop -- )
0 <vreg> check-src
- 17 17 2 SLWI
+ 3 3 2 SLWI
! The value 24 is a magic number. It is the length of the
! instruction sequence that follows to be generated.
- 0 1 rel-address compiled-offset 24 + 18 LOAD32
- 17 17 18 ADD
- 17 17 0 LWZ
- 17 MTLR
+ 0 1 rel-address compiled-offset 24 + 4 LOAD32
+ 3 3 4 ADD
+ 3 3 0 LWZ
+ 3 MTLR
BLR ;
M: %type generate-node ( vop -- )
<label> "f" set
<label> "end" set
! Get the tag
- 17 18 tag-mask ANDI
+ 3 4 tag-mask ANDI
! Compare with object tag number (3).
- 0 18 object-tag CMPI
+ 0 4 object-tag CMPI
! Jump if the object doesn't store type info in its header
"end" get BNE
! It does store type info in its header
! Is the pointer itself equal to 3? Then its F_TYPE (9).
- 0 17 object-tag CMPI
+ 0 3 object-tag CMPI
"f" get BEQ
! The pointer is not equal to 3. Load the object header.
- 18 17 object-tag neg LWZ
- 18 18 3 SRAWI
+ 4 3 object-tag neg LWZ
+ 4 4 3 SRAWI
"end" get B
"f" get save-xt
! The pointer is equal to 3. Load F_TYPE (9).
- f type 18 LI
+ f type 4 LI
"end" get save-xt
- 17 18 MR ;
+ 3 4 MR ;
M: %tag generate-node ( vop -- )
dup vop-in-1 v>operand swap vop-out-1 v>operand tag-mask ANDI ;