Fix struct field alignment on PowerPC

basis/alien/arrays/arrays.factor

@@ -20,6 +20,8 @@ M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ;
 
 M: array c-type-align first c-type-align ;
 
+M: array c-type-align-first first c-type-align-first ;
+
 M: array c-type-stack-align? drop f ;
 
 M: array unbox-parameter drop void* unbox-parameter ;
@@ -55,6 +57,9 @@ M: string-type heap-size
 M: string-type c-type-align
     drop void* c-type-align ;
 
+M: string-type c-type-align-first
+    drop void* c-type-align-first ;
+
 M: string-type c-type-stack-align?
     drop void* c-type-stack-align? ;
 
@@ -97,5 +102,5 @@ M: string-type c-type-setter
 { char* utf8 } char* typedef
 char* uchar* typedef
 
-char  char*  "pointer-c-type" set-word-prop
+char char* "pointer-c-type" set-word-prop
 uchar uchar* "pointer-c-type" set-word-prop

basis/alien/c-types/c-types.factor

@@ -30,8 +30,9 @@ TUPLE: abstract-c-type
 { unboxer-quot callable }
 { getter callable }
 { setter callable }
-size
+{ size integer }
-align ;
+{ align integer }
+{ align-first integer } ;
 
 TUPLE: c-type < abstract-c-type
 boxer
@@ -104,10 +105,9 @@ M: word c-type
 
 GENERIC: c-struct? ( c-type -- ? )
 
-M: object c-struct?
+M: object c-struct? drop f ;
-    drop f ;
+
-M: c-type-name c-struct?
+M: c-type-name c-struct? dup void? [ drop f ] [ c-type c-struct? ] if ;
-    dup void? [ drop f ] [ c-type c-struct? ] if ;
 
 ! These words being foldable means that words need to be
 ! recompiled if a C type is redefined. Even so, folding the
@@ -172,6 +172,12 @@ M: abstract-c-type c-type-align align>> ;
 
 M: c-type-name c-type-align c-type c-type-align ;
 
+GENERIC: c-type-align-first ( name -- n )
+
+M: c-type-name c-type-align-first c-type c-type-align-first ;
+
+M: abstract-c-type c-type-align-first align-first>> ;
+
 GENERIC: c-type-stack-align? ( name -- ? )
 
 M: c-type c-type-stack-align? stack-align?>> ;
@@ -324,6 +330,13 @@ SYMBOLS:
     ptrdiff_t intptr_t uintptr_t size_t
     char* uchar* ;
 
+: 8-byte-alignment ( c-type -- c-type )
+    {
+        { [ cpu ppc? os macosx? and ] [ 4 >>align 8 >>align-first ] }
+        { [ cpu x86.32? os windows? not and ] [ 4 >>align 4 >>align-first ] }
+        [ 8 >>align 8 >>align-first ]
+    } cond ;
+
 [
     <c-type>
         c-ptr >>class
@@ -332,6 +345,7 @@ SYMBOLS:
         [ [ >c-ptr ] 2dip set-alien-cell ] >>setter
         bootstrap-cell >>size
         bootstrap-cell >>align
+        bootstrap-cell >>align-first
         [ >c-ptr ] >>unboxer-quot
         "box_alien" >>boxer
         "alien_offset" >>unboxer
@@ -343,7 +357,7 @@ SYMBOLS:
         [ alien-signed-8 ] >>getter
         [ set-alien-signed-8 ] >>setter
         8 >>size
-        cpu x86.32? os windows? not and 4 8 ? >>align
+        8-byte-alignment
         "box_signed_8" >>boxer
         "to_signed_8" >>unboxer
     \ longlong define-primitive-type
@@ -354,7 +368,7 @@ SYMBOLS:
         [ alien-unsigned-8 ] >>getter
         [ set-alien-unsigned-8 ] >>setter
         8 >>size
-        cpu x86.32? os windows? not and 4 8 ? >>align
+        8-byte-alignment
         "box_unsigned_8" >>boxer
         "to_unsigned_8" >>unboxer
     \ ulonglong define-primitive-type
@@ -366,6 +380,7 @@ SYMBOLS:
         [ set-alien-signed-cell ] >>setter
         bootstrap-cell >>size
         bootstrap-cell >>align
+        bootstrap-cell >>align-first
         "box_signed_cell" >>boxer
         "to_fixnum" >>unboxer
     \ long define-primitive-type
@@ -377,6 +392,7 @@ SYMBOLS:
         [ set-alien-unsigned-cell ] >>setter
         bootstrap-cell >>size
         bootstrap-cell >>align
+        bootstrap-cell >>align-first
         "box_unsigned_cell" >>boxer
         "to_cell" >>unboxer
     \ ulong define-primitive-type
@@ -388,6 +404,7 @@ SYMBOLS:
         [ set-alien-signed-4 ] >>setter
         4 >>size
         4 >>align
+        4 >>align-first
         "box_signed_4" >>boxer
         "to_fixnum" >>unboxer
     \ int define-primitive-type
@@ -399,6 +416,7 @@ SYMBOLS:
         [ set-alien-unsigned-4 ] >>setter
         4 >>size
         4 >>align
+        4 >>align-first
         "box_unsigned_4" >>boxer
         "to_cell" >>unboxer
     \ uint define-primitive-type
@@ -410,6 +428,7 @@ SYMBOLS:
         [ set-alien-signed-2 ] >>setter
         2 >>size
         2 >>align
+        2 >>align-first
         "box_signed_2" >>boxer
         "to_fixnum" >>unboxer
     \ short define-primitive-type
@@ -421,6 +440,7 @@ SYMBOLS:
         [ set-alien-unsigned-2 ] >>setter
         2 >>size
         2 >>align
+        2 >>align-first
         "box_unsigned_2" >>boxer
         "to_cell" >>unboxer
     \ ushort define-primitive-type
@@ -432,6 +452,7 @@ SYMBOLS:
         [ set-alien-signed-1 ] >>setter
         1 >>size
         1 >>align
+        1 >>align-first
         "box_signed_1" >>boxer
         "to_fixnum" >>unboxer
     \ char define-primitive-type
@@ -443,6 +464,7 @@ SYMBOLS:
         [ set-alien-unsigned-1 ] >>setter
         1 >>size
         1 >>align
+        1 >>align-first
         "box_unsigned_1" >>boxer
         "to_cell" >>unboxer
     \ uchar define-primitive-type
@@ -453,6 +475,7 @@ SYMBOLS:
             [ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter
             4 >>size
             4 >>align
+            4 >>align-first
             "box_boolean" >>boxer
             "to_boolean" >>unboxer
     ] [
@@ -461,6 +484,7 @@ SYMBOLS:
             [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
             1 >>size
             1 >>align
+            1 >>align-first
             "box_boolean" >>boxer
             "to_boolean" >>unboxer
     ] if
@@ -473,6 +497,7 @@ SYMBOLS:
         [ [ >float ] 2dip set-alien-float ] >>setter
         4 >>size
         4 >>align
+        4 >>align-first
         "box_float" >>boxer
         "to_float" >>unboxer
         float-rep >>rep
@@ -485,7 +510,7 @@ SYMBOLS:
         [ alien-double ] >>getter
         [ [ >float ] 2dip set-alien-double ] >>setter
         8 >>size
-        cpu x86.32? os windows? not and 4 8 ? >>align
+        8-byte-alignment
         "box_double" >>boxer
         "to_double" >>unboxer
         double-rep >>rep

basis/classes/struct/struct-tests.factor

@@ -365,3 +365,18 @@ STRUCT: bit-field-test
 [ -2 ] [ bit-field-test <struct> 2 >>b b>> ] unit-test
 [ 1 ] [ bit-field-test <struct> 257 >>c c>> ] unit-test
 [ 3 ] [ bit-field-test heap-size ] unit-test
+
+cpu ppc? [
+    STRUCT: ppc-align-test-1
+        { x longlong }
+        { y int } ;
+
+    [ 16 ] [ ppc-align-test-1 heap-size ] unit-test
+
+    STRUCT: ppc-align-test-2
+        { y int }
+        { x longlong } ;
+
+    [ 12 ] [ ppc-align-test-2 heap-size ] unit-test
+    [ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
+] when

basis/classes/struct/struct.factor

@@ -211,27 +211,32 @@ M: struct-c-type c-struct? drop t ;
         slots >>fields
         size >>size
         align >>align
+        align >>align-first
         class (unboxer-quot) >>unboxer-quot
-        class (boxer-quot)   >>boxer-quot ;
+        class (boxer-quot) >>boxer-quot ;
 
-GENERIC: align-offset ( offset class -- offset' )
+GENERIC: compute-slot-offset ( offset class -- offset' )
 
-M: struct-slot-spec align-offset
+: c-type-align-at ( class offset -- n )
-    [ type>> c-type-align 8 * align ] keep
+    0 = [ c-type-align-first ] [ c-type-align ] if ;
+
+M: struct-slot-spec compute-slot-offset
+    [ type>> over c-type-align-at 8 * align ] keep
     [ [ 8 /i ] dip (>>offset) ] [ type>> heap-size 8 * + ] 2bi ;
 
-M: struct-bit-slot-spec align-offset
+M: struct-bit-slot-spec compute-slot-offset
     [ (>>offset) ] [ bits>> + ] 2bi ;
 
-: struct-offsets ( slots -- size )
+: compute-struct-offsets ( slots -- size )
-    0 [ align-offset ] reduce 8 align 8 /i ;
+    0 [ compute-slot-offset ] reduce 8 align 8 /i ;
 
-: union-struct-offsets ( slots -- size )
+: compute-union-offsets ( slots -- size )
     1 [ 0 >>offset type>> heap-size max ] reduce ;
 
-: struct-align ( slots -- align )
+: struct-alignment ( slots -- align )
     [ struct-bit-slot-spec? not ] filter
-    1 [ type>> c-type-align max ] reduce ;
+    1 [ [ type>> ] [ offset>> ] bi c-type-align-at max ] reduce ;
+
 PRIVATE>
 
 M: struct byte-length class "struct-size" word-prop ; foldable
@@ -243,10 +248,8 @@ GENERIC: binary-zero? ( value -- ? )
 
 M: object binary-zero? drop f ;
 M: f binary-zero? drop t ;
-M: number binary-zero? zero? ;
+M: number binary-zero? 0 = ;
-M: struct binary-zero?
+M: struct binary-zero? >c-ptr [ 0 = ] all? ;
-    [ byte-length iota ] [ >c-ptr ] bi
-    [ <displaced-alien> *uchar zero? ] curry all? ;
 
 : struct-needs-prototype? ( class -- ? )
     struct-slots [ initial>> binary-zero? ] all? not ;
@@ -278,7 +281,7 @@ M: struct binary-zero?
     slots empty? [ struct-must-have-slots ] when
     class redefine-struct-tuple-class
     slots make-slots dup check-struct-slots :> slot-specs
-    slot-specs struct-align :> alignment
+    slot-specs struct-alignment :> alignment
     slot-specs offsets-quot call alignment align :> size
 
     class  slot-specs  size  alignment  c-type-for-class :> c-type
@@ -291,10 +294,10 @@ M: struct binary-zero?
 PRIVATE>
 
 : define-struct-class ( class slots -- )
-    [ struct-offsets ] (define-struct-class) ;
+    [ compute-struct-offsets ] (define-struct-class) ;
 
 : define-union-struct-class ( class slots -- )
-    [ union-struct-offsets ] (define-struct-class) ;
+    [ compute-union-offsets ] (define-struct-class) ;
 
 M: struct-class reset-class
     [ call-next-method ] [ name>> c-types get delete-at ] bi ;

basis/cpu/ppc/macosx/macosx.factor

@@ -4,12 +4,6 @@ USING: accessors system kernel layouts
 alien.c-types cpu.architecture cpu.ppc ;
 IN: cpu.ppc.macosx
 
-<<
-4 "longlong" c-type (>>align)
-4 "ulonglong" c-type (>>align)
-4 "double" c-type (>>align)
->>
-
 M: macosx reserved-area-size 6 cells ;
 
 M: macosx lr-save 2 cells ;

basis/half-floats/half-floats.factor

@@ -39,6 +39,7 @@ SYMBOL: half
     [ [ >float half>bits ] 2dip set-alien-unsigned-2 ] >>setter
     2 >>size
     2 >>align
+    2 >>align-first
     [ >float ] >>unboxer-quot
 \ half define-primitive-type
 

basis/math/vectors/simd/functor/functor.factor

@@ -147,6 +147,7 @@ TUPLE: simd class elt-class ops special-wrappers schema-wrappers ctor rep ;
         [ [ underlying>> ] 2dip rep set-alien-vector ] >>setter
         16 >>size
         16 >>align
+        16 >>align-first
         rep >>rep
     class c:typedef ;
 
@@ -316,6 +317,7 @@ SLOT: underlying2
         ] >>setter
         32 >>size
         16 >>align
+        16 >>align-first
         rep >>rep
     class c:typedef ;