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

Clean up PPC backend a bit

db4
Slava Pestov 2008-12-16 02:03:21 -06:00
parent 6537c789fe
commit 97fd662d61
3 changed files with 29 additions and 26 deletions
basis/cpu/ppc

2
basis/cpu/ppc/assembler/assembler.factor
View File

@ -204,6 +204,6 @@ MTSPR: CTR 9
: (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline
: SRWI ( d a b -- ) (SRWI) RLWINM ;
: SRWI. ( d a b -- ) (SRWI) RLWINM. ;
: LOAD32 ( n r -- ) >r w>h/h r> tuck LIS dup rot ORI ;
: LOAD32 ( n r -- ) [ w>h/h ] dip tuck LIS dup rot ORI ;
: immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;

4
basis/cpu/ppc/assembler/backend/backend.factor
View File

@ -79,8 +79,8 @@ M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ;
GENERIC: BC ( a b c -- )
M: integer BC 0 0 16 b-insn ;
M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ;
M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ;
M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ;
M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
: CREATE-B ( -- word ) scan "B" prepend create-in ;

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

@ -467,19 +467,21 @@ M: ppc %gc
M: ppc %prologue ( n -- )
0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
0 MFLR
1 1 pick neg ADDI
11 1 pick xt-save STW
dup 11 LI
11 1 pick next-save STW
0 1 rot lr-save + STW ;
{
[ [ 1 1 ] dip neg ADDI ]
[ [ 11 1 ] dip xt-save STW ]
[ 11 LI ]
[ [ 11 1 ] dip next-save STW ]
[ [ 0 1 ] dip lr-save + STW ]
} cleave ;
M: ppc %epilogue ( n -- )
#! At the end of each word that calls a subroutine, we store
#! the previous link register value in r0 by popping it off
#! the stack, set the link register to the contents of r0,
#! and jump to the link register.
0 1 pick lr-save + LWZ
1 1 rot ADDI
[ [ 0 1 ] dip lr-save + LWZ ]
[ [ 1 1 ] dip ADDI ] bi
0 MTLR ;
:: (%boolean) ( dst temp word -- )
@ -541,17 +543,17 @@ GENERIC: STF ( src dst off reg-class -- )
M: single-float-regs STF drop STFS ;
M: double-float-regs STF drop STFD ;
M: float-regs %save-param-reg >r 1 rot local@ r> STF ;
M: float-regs %save-param-reg [ 1 rot local@ ] dip STF ;
GENERIC: LF ( dst src off reg-class -- )
M: single-float-regs LF drop LFS ;
M: double-float-regs LF drop LFD ;
M: float-regs %load-param-reg >r 1 rot local@ r> LF ;
M: float-regs %load-param-reg [ 1 rot local@ ] dip LF ;
M: stack-params %load-param-reg ( stack reg reg-class -- )
drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ;
drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ;
: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
@ -559,8 +561,8 @@ M: stack-params %save-param-reg ( stack reg reg-class -- )
#! Funky. Read the parameter from the caller's stack frame.
#! This word is used in callbacks
drop
0 1 rot next-param@ LWZ
0 1 rot local@ STW ;
[ 0 1 ] dip next-param@ LWZ
[ 0 1 ] dip local@ STW ;
M: ppc %prepare-unbox ( -- )
! First parameter is top of stack
@ -580,14 +582,14 @@ M: ppc %unbox-long-long ( n func -- )
f %alien-invoke
! Store the return value on the C stack
[
3 1 pick local@ STW
4 1 rot cell + local@ STW
[ [ 3 1 ] dip local@ STW ]
[ [ 4 1 ] dip cell + local@ STW ] bi
] when* ;
M: ppc %unbox-large-struct ( n c-type -- )
! Value must be in r3
! Compute destination address and load struct size
[ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi*
[ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi*
! Call the function
"to_value_struct" f %alien-invoke ;
@ -595,15 +597,16 @@ M: ppc %box ( n reg-class func -- )
! If the source is a stack location, load it into freg #0.
! If the source is f, then we assume the value is already in
! freg #0.
>r
over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if
r> f %alien-invoke ;
[ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip
f %alien-invoke ;
M: ppc %box-long-long ( n func -- )
>r [
3 1 pick local@ LWZ
4 1 rot cell + local@ LWZ
] when* r> f %alien-invoke ;
[
[
[ [ 3 1 ] dip local@ LWZ ]
[ [ 4 1 ] dip cell + local@ LWZ ] bi
] when*
] dip f %alien-invoke ;
: struct-return@ ( n -- n )
[ stack-frame get params>> ] unless* local@ ;
@ -616,7 +619,7 @@ M: ppc %prepare-box-struct ( -- )
M: ppc %box-large-struct ( n c-type -- )
! If n = f, then we're boxing a returned struct
! Compute destination address and load struct size
[ 3 1 rot struct-return@ ADDI ] [ heap-size 4 LI ] bi*
[ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
! Call the function
"box_value_struct" f %alien-invoke ;