Found a few more places to use lookup-c-type
parent
4246c0ad36
commit
0d059e0f19
|
@ -11,5 +11,5 @@ IN: alien.complex
|
|||
<<
|
||||
! This overrides the fact that small structures are never returned
|
||||
! in registers on NetBSD, Linux and Solaris running on 32-bit x86.
|
||||
\ complex-float c-type t >>return-in-registers? drop
|
||||
\ complex-float lookup-c-type t >>return-in-registers? drop
|
||||
>>
|
||||
|
|
|
@ -173,7 +173,6 @@ TUPLE: struct-c-type < abstract-c-type
|
|||
|
||||
INSTANCE: struct-c-type value-type
|
||||
|
||||
! M: struct-c-type c-type ;
|
||||
M: struct-c-type lookup-c-type ;
|
||||
|
||||
M: struct-c-type base-type ;
|
||||
|
|
|
@ -20,8 +20,8 @@ M: ppc param-regs
|
|||
} ;
|
||||
|
||||
M: ppc value-struct?
|
||||
c-type [ complex-double c-type = ]
|
||||
[ complex-float c-type = ] bi or ;
|
||||
lookup-c-type [ complex-double lookup-c-type = ]
|
||||
[ complex-float lookup-c-type = ] bi or ;
|
||||
|
||||
M: ppc dummy-stack-params? f ;
|
||||
|
||||
|
@ -37,10 +37,10 @@ M: ppc float-right-align-on-stack? f ;
|
|||
|
||||
M: ppc flatten-struct-type ( type -- seq )
|
||||
{
|
||||
{ [ dup c-type complex-double c-type = ]
|
||||
{ [ dup lookup-c-type complex-double lookup-c-type = ]
|
||||
[ drop { { int-rep f f } { int-rep f f }
|
||||
{ int-rep f f } { int-rep f f } } ] }
|
||||
{ [ dup c-type complex-float c-type = ]
|
||||
{ [ dup lookup-c-type complex-float lookup-c-type = ]
|
||||
[ drop { { int-rep f f } { int-rep f f } } ] }
|
||||
[ call-next-method [ first t f 3array ] map ]
|
||||
} cond ;
|
||||
|
|
|
@ -35,18 +35,18 @@ M: ppc float-right-align-on-stack? t ;
|
|||
|
||||
M: ppc flatten-struct-type ( type -- seq )
|
||||
{
|
||||
{ [ dup c-type complex-double c-type = ]
|
||||
{ [ dup lookup-c-type complex-double lookup-c-type = ]
|
||||
[ drop { { double-rep f f } { double-rep f f } } ] }
|
||||
{ [ dup c-type complex-float c-type = ]
|
||||
{ [ dup lookup-c-type complex-float lookup-c-type = ]
|
||||
[ drop { { float-rep f f } { float-rep f f } } ] }
|
||||
[ heap-size cell align cell /i { int-rep f f } <repetition> ]
|
||||
} cond ;
|
||||
|
||||
M: ppc flatten-struct-type-return ( type -- seq )
|
||||
{
|
||||
{ [ dup c-type complex-double c-type = ]
|
||||
{ [ dup lookup-c-type complex-double lookup-c-type = ]
|
||||
[ drop { { double-rep f f } { double-rep f f } } ] }
|
||||
{ [ dup c-type complex-float c-type = ]
|
||||
{ [ dup lookup-c-type complex-float lookup-c-type = ]
|
||||
[ drop { { float-rep f f } { float-rep f f } } ] }
|
||||
[ heap-size cell align cell /i { int-rep t f } <repetition> ]
|
||||
} cond ;
|
||||
|
|
|
@ -360,7 +360,7 @@ M: ppc return-regs ( -- regs )
|
|||
|
||||
! Is this structure small enough to be returned in registers?
|
||||
M: ppc return-struct-in-registers? ( c-type -- ? )
|
||||
c-type return-in-registers?>> ;
|
||||
lookup-c-type return-in-registers?>> ;
|
||||
|
||||
! If t, floats are never passed in param regs
|
||||
M: ppc float-on-stack? ( -- ? ) f ;
|
||||
|
@ -1081,4 +1081,4 @@ USE: vocabs.loader
|
|||
[ ]
|
||||
} cond
|
||||
|
||||
complex-double c-type t >>return-in-registers? drop
|
||||
complex-double lookup-c-type t >>return-in-registers? drop
|
||||
|
|
|
@ -85,7 +85,7 @@ ERROR: unknown-type-error type ;
|
|||
qualified-type-name type-infos get-global at ;
|
||||
|
||||
:: register-type ( c-type type-info name -- )
|
||||
type-info c-type >>c-type name
|
||||
type-info lookup-c-type >>c-type name
|
||||
type-infos get-global set-at ;
|
||||
|
||||
: register-standard-type ( c-type name -- )
|
||||
|
@ -104,7 +104,7 @@ ERROR: unknown-type-error type ;
|
|||
ERROR: deferred-type-error ;
|
||||
|
||||
<<
|
||||
void* c-type clone
|
||||
void* lookup-c-type clone
|
||||
[ drop deferred-type-error ] >>unboxer-quot
|
||||
[ drop deferred-type-error ] >>boxer-quot
|
||||
object >>boxed-class
|
||||
|
|
|
@ -32,9 +32,9 @@ SYMBOLS: CUdouble CUlonglong CUulonglong ;
|
|||
: always-8-byte-align ( c-type -- c-type )
|
||||
8 >>align 8 >>align-first ;
|
||||
|
||||
longlong c-type clone always-8-byte-align \ CUlonglong typedef
|
||||
ulonglong c-type clone always-8-byte-align \ CUulonglong typedef
|
||||
double c-type clone always-8-byte-align \ CUdouble typedef
|
||||
longlong lookup-c-type clone always-8-byte-align \ CUlonglong typedef
|
||||
ulonglong lookup-c-type clone always-8-byte-align \ CUulonglong typedef
|
||||
double lookup-c-type clone always-8-byte-align \ CUdouble typedef
|
||||
>>
|
||||
|
||||
STRUCT: CUuuid
|
||||
|
|
|
@ -183,110 +183,110 @@ STRUCT: double4
|
|||
{ z double }
|
||||
{ w double } ;
|
||||
|
||||
char2 c-type
|
||||
char2 lookup-c-type
|
||||
2 >>align
|
||||
2 >>align-first
|
||||
drop
|
||||
char4 c-type
|
||||
char4 lookup-c-type
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
drop
|
||||
|
||||
uchar2 c-type
|
||||
uchar2 lookup-c-type
|
||||
2 >>align
|
||||
2 >>align-first
|
||||
drop
|
||||
uchar4 c-type
|
||||
uchar4 lookup-c-type
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
drop
|
||||
|
||||
short2 c-type
|
||||
short2 lookup-c-type
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
drop
|
||||
short4 c-type
|
||||
short4 lookup-c-type
|
||||
8 >>align
|
||||
8 >>align-first
|
||||
drop
|
||||
|
||||
ushort2 c-type
|
||||
ushort2 lookup-c-type
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
drop
|
||||
ushort4 c-type
|
||||
ushort4 lookup-c-type
|
||||
8 >>align
|
||||
8 >>align-first
|
||||
drop
|
||||
|
||||
int2 c-type
|
||||
int2 lookup-c-type
|
||||
8 >>align
|
||||
8 >>align-first
|
||||
drop
|
||||
int4 c-type
|
||||
int4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
||||
uint2 c-type
|
||||
uint2 lookup-c-type
|
||||
8 >>align
|
||||
8 >>align-first
|
||||
drop
|
||||
uint4 c-type
|
||||
uint4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
||||
long2 c-type
|
||||
long2 lookup-c-type
|
||||
long heap-size 2 * >>align
|
||||
long heap-size 2 * >>align-first
|
||||
drop
|
||||
long4 c-type
|
||||
long4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
||||
ulong2 c-type
|
||||
ulong2 lookup-c-type
|
||||
long heap-size 2 * >>align
|
||||
long heap-size 2 * >>align-first
|
||||
drop
|
||||
ulong4 c-type
|
||||
ulong4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
||||
longlong2 c-type
|
||||
longlong2 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
longlong4 c-type
|
||||
longlong4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
||||
ulonglong2 c-type
|
||||
ulonglong2 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
ulonglong4 c-type
|
||||
ulonglong4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
||||
float2 c-type
|
||||
float2 lookup-c-type
|
||||
8 >>align
|
||||
8 >>align-first
|
||||
drop
|
||||
float4 c-type
|
||||
float4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
||||
double2 c-type
|
||||
double2 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
double4 c-type
|
||||
double4 lookup-c-type
|
||||
16 >>align
|
||||
16 >>align-first
|
||||
drop
|
||||
|
|
|
@ -40,8 +40,8 @@ TUPLE: function name alien return params ;
|
|||
"alien.llvm" create swap
|
||||
[
|
||||
dup name>> function-pointer ,
|
||||
dup return>> c-type ,
|
||||
dup params>> [ second c-type ] map ,
|
||||
dup return>> lookup-c-type ,
|
||||
dup params>> [ second lookup-c-type ] map ,
|
||||
cdecl , \ alien-indirect ,
|
||||
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue