Add 'class' slot to c-types

db4
Slava Pestov 2008-11-29 03:45:34 -06:00
parent c43690a8fb
commit 02a2752fa5
1 changed files with 22 additions and 1 deletions

View File

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