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 *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 ; : ( -- 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-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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + float >>class [ alien-double ] >>getter [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size