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

Fixing PPC backend

db4
Slava Pestov 2008-12-06 15:30:40 -06:00
parent 03dd5db902
commit d2ce4355f8
1 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -37,8 +37,8 @@ M: ppc %load-immediate ( reg n -- ) swap LOAD ;
M: ppc %load-indirect ( reg obj -- ) M: ppc %load-indirect ( reg obj -- )
[ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-immediate ] bi* ; [ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-immediate ] bi* ;
: %load-dlsym ( symbol dll register -- ) M: ppc %alien-global ( register symbol dll -- )
0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ; [ 0 swap LOAD32 ] 2dip rc-absolute-ppc-2/2 rel-dlsym ;
: ds-reg 29 ; inline : ds-reg 29 ; inline
: rs-reg 30 ; inline : rs-reg 30 ; inline
@ -145,8 +145,8 @@ M:: ppc %string-nth ( dst src index temp -- )
temp temp index ADD temp temp index ADD
temp temp index ADD temp temp index ADD
temp temp byte-array-offset LHZ temp temp byte-array-offset LHZ
temp temp 8 SLWI temp temp 7 SLWI
dst dst temp OR dst dst temp XOR
"end" resolve-label "end" resolve-label
] with-scope ; ] with-scope ;
@ -172,7 +172,7 @@ M: ppc %sar-imm SRAWI ;
M: ppc %not NOT ; M: ppc %not NOT ;
: %alien-invoke-tail ( func dll -- ) : %alien-invoke-tail ( func dll -- )
scratch-reg %load-dlsym scratch-reg MTCTR BCTR ; [ scratch-reg ] 2dip %alien-global scratch-reg MTCTR BCTR ;
:: exchange-regs ( r1 r2 -- ) :: exchange-regs ( r1 r2 -- )
scratch-reg r1 MR scratch-reg r1 MR
@ -411,7 +411,7 @@ M: ppc %set-alien-float swap 0 STFS ;
M: ppc %set-alien-double swap 0 STFD ; M: ppc %set-alien-double swap 0 STFD ;
: load-zone-ptr ( reg -- ) : load-zone-ptr ( reg -- )
[ "nursery" f ] dip %load-dlsym ; "nursery" f %alien-global ;
: load-allot-ptr ( nursery-ptr allot-ptr -- ) : load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap 4 LWZ ] 2bi ; [ drop load-zone-ptr ] [ swap 4 LWZ ] 2bi ;
@ -433,14 +433,11 @@ M:: ppc %allot ( dst size class nursery-ptr -- )
dst class store-header dst class store-header
dst class store-tagged ; dst class store-tagged ;
: %alien-global ( dst name -- )
[ f rot %load-dlsym ] [ drop dup 0 LWZ ] 2bi ;
: load-cards-offset ( dst -- ) : load-cards-offset ( dst -- )
"cards_offset" %alien-global ; [ "cards_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
: load-decks-offset ( dst -- ) : load-decks-offset ( dst -- )
"decks_offset" %alien-global ; [ "decks_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
M:: ppc %write-barrier ( src card# table -- ) M:: ppc %write-barrier ( src card# table -- )
card-mark scratch-reg LI card-mark scratch-reg LI
@ -627,14 +624,14 @@ M: ppc %prepare-alien-invoke
#! Save Factor stack pointers in case the C code calls a #! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace #! callback which does a GC, which must reliably trace
#! all roots. #! all roots.
"stack_chain" f scratch-reg %load-dlsym scratch-reg "stack_chain" f %alien-global
scratch-reg scratch-reg 0 LWZ scratch-reg scratch-reg 0 LWZ
1 scratch-reg 0 STW 1 scratch-reg 0 STW
ds-reg scratch-reg 8 STW ds-reg scratch-reg 8 STW
rs-reg scratch-reg 12 STW ; rs-reg scratch-reg 12 STW ;
M: ppc %alien-invoke ( symbol dll -- ) M: ppc %alien-invoke ( symbol dll -- )
11 %load-dlsym 11 MTLR BLRL ; [ 11 ] 2dip %alien-global 11 MTLR BLRL ;
M: ppc %alien-callback ( quot -- ) M: ppc %alien-callback ( quot -- )
3 swap %load-indirect "c_to_factor" f %alien-invoke ; 3 swap %load-indirect "c_to_factor" f %alien-invoke ;