     src card# deck-bits SRWI
     table scratch-reg card# STBX ;
 
-M:: ppc %gc ( temp1 temp2 gc-roots gc-root-count -- )
-    "end" define-label
+M:: ppc %check-nursery ( label temp1 temp2 -- )
     temp2 load-zone-ptr
     temp1 temp2 cell LWZ
     temp2 temp2 3 cells LWZ
-    temp1 temp1 1024 ADDI ! add ALLOT_BUFFER_ZONE to here
-    temp1 0 temp2 CMP ! is here >= end?
-    "end" get BLE
+    ! add ALLOT_BUFFER_ZONE to here
+    temp1 temp1 1024 ADDI
+    ! is here >= end?
+    temp1 0 temp2 CMP
+    label BLE ;
+
+M:: ppc %save-gc-root ( gc-root register -- )
+    register 1 gc-root gc-root@ STW ;
+
+M:: ppc %load-gc-root ( gc-root register -- )
+    register 1 gc-root gc-root@ LWZ ;
+
+M:: ppc %call-gc ( gc-root-count -- )
     %prepare-alien-invoke
-    0 3 LI
-    0 4 LI
+    3 1 gc-root-base param@ ADDI
+    gc-root-count 4 LI
     "inline_gc" f %alien-invoke
     "end" resolve-label ;
 

M: ppc %or-imm  ORI ;
M: ppc %xor     XOR ;
M: ppc %xor-imm XORI ;
M: ppc %shl-imm swapd SLWI ;
M: ppc %shr-imm swapd SRWI ;
M: ppc %sar-imm SRAWI ;
M: ppc %not     NOT ;

: %alien-invoke-tail ( func dll -- )
    [ scratch-reg ] 2dip %alien-global scratch-reg MTCTR BCTR ;

:: exchange-regs ( r1 r2 -- )
    scratch-reg r1 MR
    r1 r2 MR
    r2 scratch-reg MR ;

: ?MR ( r1 r2 -- ) 2dup = [ 2drop ] [ MR ] if ;

:: 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 ;

: clear-xer ( -- )
    0 0 LI
    0 MTXER ; inline

:: overflow-template ( src1 src2 insn func -- )
    "no-overflow" define-label
    clear-xer
    scratch-reg src2 src1 insn call
    scratch-reg ds-reg 0 STW
    "no-overflow" get BNO
    src1 src2 move>args
    %prepare-alien-invoke
    func f %alien-invoke
    "no-overflow" resolve-label ; inline

:: overflow-template-tail ( src1 src2 insn func -- )
    "overflow" define-label
    clear-xer
    scratch-reg src2 src1 insn call
    "overflow" get BO
    scratch-reg ds-reg 0 STW
    BLR
    "overflow" resolve-label
    src1 src2 move>args
    %prepare-alien-invoke
    func f %alien-invoke-tail ; inline

M: ppc %fixnum-add ( src1 src2 -- )
    [ ADDO. ] "overflow_fixnum_add" overflow-template ;

M: ppc %fixnum-add-tail ( src1 src2 -- )
    [ ADDO. ] "overflow_fixnum_add" overflow-template-tail ;

M: ppc %fixnum-sub ( src1 src2 -- )
    [ SUBFO. ] "overflow_fixnum_subtract" overflow-template ;

M: ppc %fixnum-sub-tail ( src1 src2 -- )
    [ SUBFO. ] "overflow_fixnum_subtract" overflow-template-tail ;

M:: ppc %fixnum-mul ( src1 src2 temp1 temp2 -- )
    "no-overflow" define-label
    clear-xer
    temp1 src1 tag-bits get SRAWI
    temp2 temp1 src2 MULLWO.
    temp2 ds-reg 0 STW
    "no-overflow" get BNO
    src2 src2 tag-bits get SRAWI
    temp1 src2 move>args
    %prepare-alien-invoke
    "overflow_fixnum_multiply" f %alien-invoke
    "no-overflow" resolve-label ;

M:: ppc %fixnum-mul-tail ( src1 src2 temp1 temp2 -- )
    "overflow" define-label
    clear-xer
    temp1 src1 tag-bits get SRAWI
    temp2 temp1 src2 MULLWO.
    "overflow" get BO
    temp2 ds-reg 0 STW
    BLR
    "overflow" resolve-label
    src2 src2 tag-bits get SRAWI
    temp1 src2 move>args
    %prepare-alien-invoke
    "overflow_fixnum_multiply" f %alien-invoke-tail ;

: bignum@ ( n -- offset ) cells bignum tag-number - ; inline


: local@ ( n -- x )
    reserved-area-size param-save-size + + ; inline

: spill-integer@ ( n -- offset )
    spill-integer-offset param@ ;

: spill-float@ ( n -- offset )
    spill-float-offset param@ ;

! Some FP intrinsics need a temporary scratch area in the stack
! frame, 8 bytes in size. This is in the param-save area so it
! should not overlap with spill slots.
: scratch@ ( n -- offset )
    stack-frame get total-size>>
    factor-area-size -
    param-save-size -
    + ;

! GC root area
: gc-root@ ( n -- offset )
    gc-root-offset param@ ;

! Finally we have the linkage area
HOOK: lr-save os ( -- n )

M: ppc stack-frame-size ( stack-frame -- i )
    (stack-frame-size)
    param-save-size +
    reserved-area-size +
    factor-area-size +
