Found a few more places to use lookup-c-type

db4
Doug Coleman 2011-10-24 15:57:37 -07:00
parent 4246c0ad36
commit 0d059e0f19
9 changed files with 42 additions and 43 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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