Add 'class' slot to c-types
parent
c43690a8fb
commit
02a2752fa5
|
@ -13,13 +13,15 @@ DEFER: *char
|
|||
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
|
||||
|
||||
TUPLE: c-type
|
||||
class
|
||||
boxer boxer-quot unboxer unboxer-quot
|
||||
getter setter
|
||||
reg-class size align stack-align? ;
|
||||
|
||||
: new-c-type ( class -- type )
|
||||
new
|
||||
int-regs >>reg-class ;
|
||||
int-regs >>reg-class
|
||||
object >>class ;
|
||||
|
||||
: <c-type> ( -- type )
|
||||
\ c-type new-c-type ;
|
||||
|
@ -63,6 +65,12 @@ M: string c-type ( name -- type )
|
|||
] ?if
|
||||
] if ;
|
||||
|
||||
GENERIC: c-type-class ( name -- class )
|
||||
|
||||
M: c-type c-type-class class>> ;
|
||||
|
||||
M: string c-type-class c-type c-type-class ;
|
||||
|
||||
GENERIC: c-type-boxer ( name -- boxer )
|
||||
|
||||
M: c-type c-type-boxer boxer>> ;
|
||||
|
@ -306,6 +314,7 @@ M: long-long-type box-return ( type -- )
|
|||
|
||||
[
|
||||
<c-type>
|
||||
c-ptr >>class
|
||||
[ alien-cell ] >>getter
|
||||
[ set-alien-cell ] >>setter
|
||||
bootstrap-cell >>size
|
||||
|
@ -315,6 +324,7 @@ M: long-long-type box-return ( type -- )
|
|||
"void*" define-primitive-type
|
||||
|
||||
<long-long-type>
|
||||
integer >>class
|
||||
[ alien-signed-8 ] >>getter
|
||||
[ set-alien-signed-8 ] >>setter
|
||||
8 >>size
|
||||
|
@ -324,6 +334,7 @@ M: long-long-type box-return ( type -- )
|
|||
"longlong" define-primitive-type
|
||||
|
||||
<long-long-type>
|
||||
integer >>class
|
||||
[ alien-unsigned-8 ] >>getter
|
||||
[ set-alien-unsigned-8 ] >>setter
|
||||
8 >>size
|
||||
|
@ -333,6 +344,7 @@ M: long-long-type box-return ( type -- )
|
|||
"ulonglong" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
integer >>class
|
||||
[ alien-signed-cell ] >>getter
|
||||
[ set-alien-signed-cell ] >>setter
|
||||
bootstrap-cell >>size
|
||||
|
@ -342,6 +354,7 @@ M: long-long-type box-return ( type -- )
|
|||
"long" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
integer >>class
|
||||
[ alien-unsigned-cell ] >>getter
|
||||
[ set-alien-unsigned-cell ] >>setter
|
||||
bootstrap-cell >>size
|
||||
|
@ -351,6 +364,7 @@ M: long-long-type box-return ( type -- )
|
|||
"ulong" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
integer >>class
|
||||
[ alien-signed-4 ] >>getter
|
||||
[ set-alien-signed-4 ] >>setter
|
||||
4 >>size
|
||||
|
@ -360,6 +374,7 @@ M: long-long-type box-return ( type -- )
|
|||
"int" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
integer >>class
|
||||
[ alien-unsigned-4 ] >>getter
|
||||
[ set-alien-unsigned-4 ] >>setter
|
||||
4 >>size
|
||||
|
@ -369,6 +384,7 @@ M: long-long-type box-return ( type -- )
|
|||
"uint" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
[ alien-signed-2 ] >>getter
|
||||
[ set-alien-signed-2 ] >>setter
|
||||
2 >>size
|
||||
|
@ -378,6 +394,7 @@ M: long-long-type box-return ( type -- )
|
|||
"short" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
[ alien-unsigned-2 ] >>getter
|
||||
[ set-alien-unsigned-2 ] >>setter
|
||||
2 >>size
|
||||
|
@ -387,6 +404,7 @@ M: long-long-type box-return ( type -- )
|
|||
"ushort" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
[ alien-signed-1 ] >>getter
|
||||
[ set-alien-signed-1 ] >>setter
|
||||
1 >>size
|
||||
|
@ -396,6 +414,7 @@ M: long-long-type box-return ( type -- )
|
|||
"char" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
[ alien-unsigned-1 ] >>getter
|
||||
[ set-alien-unsigned-1 ] >>setter
|
||||
1 >>size
|
||||
|
@ -414,6 +433,7 @@ M: long-long-type box-return ( type -- )
|
|||
"bool" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
float >>class
|
||||
[ alien-float ] >>getter
|
||||
[ [ >float ] 2dip set-alien-float ] >>setter
|
||||
4 >>size
|
||||
|
@ -425,6 +445,7 @@ M: long-long-type box-return ( type -- )
|
|||
"float" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
float >>class
|
||||
[ alien-double ] >>getter
|
||||
[ [ >float ] 2dip set-alien-double ] >>setter
|
||||
8 >>size
|
||||
|
|
Loading…
Reference in New Issue