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