cpu.ppc: update for recent changes

basis/cpu/ppc/ppc.factor

@@ -256,35 +256,22 @@ M: ppc %double>single-float FRSP ;
 M: ppc %unbox-alien ( dst src -- )
     alien-offset LWZ ;
 
-M:: ppc %unbox-any-c-ptr ( dst src temp -- )
+M:: ppc %unbox-any-c-ptr ( dst src -- )
     [
-        { "is-byte-array" "end" "start" } [ define-label ] each
+        "end" define-label
-        ! Address is computed in dst
         0 dst LI
-        ! Load object into scratch-reg
-        scratch-reg src MR
-        ! We come back here with displaced aliens
-        "start" resolve-label
         ! Is the object f?
-        0 scratch-reg \ f type-number CMPI
+        0 src \ f type-number CMPI
-        ! If so, done
         "end" get BEQ
+        ! Compute tag in dst register
+        dst src tag-mask get ANDI
         ! Is the object an alien?
-        0 scratch-reg header-offset LWZ
+        0 dst alien type-number CMPI
-        0 0 alien type-number tag-fixnum CMPI
+        ! Add an offset to start of byte array's data
-        "is-byte-array" get BNE
+        dst src byte-array-offset ADDI
-        ! If so, load the offset
+        "end" get BNE
-        0 scratch-reg alien-offset LWZ
+        ! If so, load the offset and add it to the address
-        ! Add it to address being computed
+        dst src alien-offset LWZ
-        dst dst 0 ADD
-        ! Now recurse on the underlying alien
-        scratch-reg scratch-reg underlying-alien-offset LWZ
-        "start" get B
-        "is-byte-array" resolve-label
-        ! Add byte array address to address being computed
-        dst dst scratch-reg ADD
-        ! Add an offset to start of byte array's data area
-        dst dst byte-array-offset ADDI
         "end" resolve-label
     ] with-scope ;
 
@@ -293,53 +280,84 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- )
 M:: ppc %box-alien ( dst src temp -- )
     [
         "f" define-label
-        dst  %load-immediate
+        dst \ f type-number %load-immediate
         0 src 0 CMPI
         "f" get BEQ
         dst 5 cells alien temp %allot
         temp \ f type-number %load-immediate
         temp dst 1 alien@ STW
         temp dst 2 alien@ STW
-        displacement dst 3 alien@ STW
+        src dst 3 alien@ STW
-        displacement dst 4 alien@ STW
+        src dst 4 alien@ STW
         "f" resolve-label
     ] with-scope ;
 
-M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
+M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
+    ! This is ridiculous
     [
         "end" define-label
-        "alloc" define-label
+        "not-f" define-label
-        "simple-case" define-label
+        "not-alien" define-label
+
         ! If displacement is zero, return the base
         dst base MR
         0 displacement 0 CMPI
         "end" get BEQ
-        ! Quickly use displacement' before its needed for real, as allot temporary
+
-        displacement' :> temp
+        ! Displacement is non-zero, we're going to be allocating a new
-        dst 4 cells alien temp %allot
+        ! object
-        ! If base is already a displaced alien, unpack it
+        dst 5 cells alien temp %allot
-        0 base \ f type-number CMPI
+
-        "simple-case" get BEQ
+        ! Set expired to f
-        temp base header-offset LWZ
-        0 temp alien type-number tag-fixnum CMPI
-        "simple-case" get BNE
-        ! displacement += base.displacement
-        temp base 3 alien@ LWZ
-        displacement' displacement temp ADD
-        ! base = base.base
-        base' base 1 alien@ LWZ
-        "alloc" get B
-        "simple-case" resolve-label
-        displacement' displacement MR
-        base' base MR
-        "alloc" resolve-label
-        ! Store underlying-alien slot
-        base' dst 1 alien@ STW
-        ! Store offset
-        displacement' dst 3 alien@ STW
-        ! Store expired slot (its ok to clobber displacement')
         temp \ f type-number %load-immediate
         temp dst 2 alien@ STW
+
+        ! Is base f?
+        0 base \ f type-number CMPI
+        "not-f" get BNE
+
+        ! Yes, it is f. Fill in new object
+        base dst 1 alien@ STW
+        displacement dst 3 alien@ STW
+        displacement dst 4 alien@ STW
+
+        "end" get B
+
+        "not-f" resolve-label
+
+        ! Check base type
+        temp base tag-mask get ANDI
+
+        ! Is base an alien?
+        0 temp alien type-number CMPI
+        "not-alien" get BNE
+
+        ! Yes, it is an alien. Set new alien's base to base.base
+        temp base 1 alien@ LWZ
+        temp dst 1 alien@ STW
+
+        ! Compute displacement
+        temp base 3 alien@ LWZ
+        temp temp displacement ADD
+        temp dst 3 alien@ STW
+
+        ! Compute address
+        temp base 4 alien@ LWZ
+        temp temp displacement ADD
+        temp dst 4 alien@ STW
+
+        ! We are done
+        "end" get B
+
+        ! Is base a byte array? It has to be, by now...
+        "not-alien" resolve-label
+
+        base dst 1 alien@ STW
+        displacement dst 3 alien@ STW
+        temp base byte-array-offset ADDI
+        temp temp displacement ADD
+        temp dst 4 alien@ STW
+
         "end" resolve-label
     ] with-scope ;