From 02a2752fa5c5558ca5b5240956781214259656b0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 03:45:34 -0600
Subject: [PATCH] Add 'class' slot to c-types
---
basis/alien/c-types/c-types.factor | 23 ++++++++++++++++++++++-
1 file changed, 22 insertions(+), 1 deletion(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 543af8dee8..46d63c3375 100644
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -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