cpu.ppc: fix %box-displaced-alien

db4
Slava Pestov 2009-08-30 20:56:04 -05:00
parent 2e40f83393
commit 6f1a7c731c
1 changed files with 9 additions and 6 deletions

View File

@ -338,7 +338,8 @@ M:: ppc %box-alien ( dst src temp -- )
M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- ) M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- )
[ [
"end" define-label "end" define-label
"ok" define-label "alloc" define-label
"simple-case" define-label
! If displacement is zero, return the base ! If displacement is zero, return the base
dst base MR dst base MR
0 displacement 0 CMPI 0 displacement 0 CMPI
@ -347,19 +348,21 @@ M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- )
displacement' :> temp displacement' :> temp
dst 4 cells alien temp %allot dst 4 cells alien temp %allot
! If base is already a displaced alien, unpack it ! If base is already a displaced alien, unpack it
base' base MR
displacement' displacement MR
0 base \ f tag-number CMPI 0 base \ f tag-number CMPI
"ok" get BEQ "simple-case" get BEQ
temp base header-offset LWZ temp base header-offset LWZ
0 temp alien type-number tag-fixnum CMPI 0 temp alien type-number tag-fixnum CMPI
"ok" get BNE "simple-case" get BNE
! displacement += base.displacement ! displacement += base.displacement
temp base 3 alien@ LWZ temp base 3 alien@ LWZ
displacement' displacement temp ADD displacement' displacement temp ADD
! base = base.base ! base = base.base
base' base 1 alien@ LWZ base' base 1 alien@ LWZ
"ok" resolve-label "alloc" get B
"simple-case" resolve-label
displacement' displacement MR
base' base MR
"alloc" resolve-label
! Store underlying-alien slot ! Store underlying-alien slot
base' dst 1 alien@ STW base' dst 1 alien@ STW
! Store offset ! Store offset