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

Fix struct field alignment on PowerPC

db4
Slava Pestov 2009-11-10 19:34:14 -06:00
parent aed9dcff53
commit e9a7191050
7 changed files with 79 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/alien/arrays/arrays.factor
View File

@ -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

43
basis/alien/c-types/c-types.factor
View File

@ -30,8 +30,9 @@ TUPLE: abstract-c-type
{ unboxer-quot callable }
{ getter callable }
{ setter callable }
size
align ;
{ size integer }
{ 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?
drop f ;
M: c-type-name c-struct?
dup void? [ drop f ] [ c-type c-struct? ] if ;
M: object c-struct? drop f ;
M: c-type-name c-struct? 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

15
basis/classes/struct/struct-tests.factor
View File

@ -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

39
basis/classes/struct/struct.factor
View File

@ -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 ;
GENERIC: align-offset ( offset class -- offset' )
class (boxer-quot) >>boxer-quot ;
M: struct-slot-spec align-offset
[ type>> c-type-align 8 * align ] keep
GENERIC: compute-slot-offset ( offset class -- offset' )
: c-type-align-at ( class offset -- n )
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 )
0 [ align-offset ] reduce 8 align 8 /i ;
: compute-struct-offsets ( slots -- size )
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: struct binary-zero?
[ byte-length iota ] [ >c-ptr ] bi
[ <displaced-alien> *uchar zero? ] curry all? ;
M: number binary-zero? 0 = ;
M: struct binary-zero? >c-ptr [ 0 = ] 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 ;

6
basis/cpu/ppc/macosx/macosx.factor
View File

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

1
basis/half-floats/half-floats.factor
View File

@ -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

2
basis/math/vectors/simd/functor/functor.factor
View File

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