[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] Add CType>>#from:
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] [PATCH] Add CType>>#from: |
Date: |
Mon, 13 Aug 2007 13:44:48 +0200 |
User-agent: |
Thunderbird 2.0.0.6 (Macintosh/20070728) |
This is refactored out of CCompound (CStruct's abstract superclass).
Example:
st> (CType from: #{VFS.CStatStruct}) inspect
An instance of CType
cObjectType: VFS.CStatStruct
st> (CType from: #(#ptr #{VFS.CStatStruct})) inspect
An instance of CPtrCType
cObjectType: CPtr
elementType: a CType
st> (CType from: #(#array #{VFS.CStatStruct} 2)) inspect
An instance of CArrayCType
cObjectType: CArray
elementType: a CType
numElements: 2
Together with two overridden #storeOn: methods, it allows to improve the
code in CStruct too.
I also took the occasion to make the numbering of CFunctionDescriptor
members consistent with the numbering of the integer "type" parameter of
CObject primitives.
Paolo
* looking for address@hidden/smalltalk--devo--2.2--patch-513 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-513
M kernel/CStruct.st
M kernel/CType.st
M kernel/CompildMeth.st
M libgst/cint.c
M libgst/cint.h
M libgst/sym.c
M libgst/sym.h
M libgst/prims.def
* modified files
--- orig/kernel/CStruct.st
+++ mod/kernel/CStruct.st
@@ -34,7 +34,7 @@
CObject variableWordSubclass: #CCompound
instanceVariableNames: ''
- classVariableNames: 'TypeMap'
+ classVariableNames: ''
poolDictionaries: ''
category: 'Language-C interface'
!
@@ -76,29 +76,6 @@ new
!CCompound class methodsFor: 'subclass creation'!
-initialize
- "Initialize the receiver's TypeMap"
- TypeMap := IdentityDictionary new
- at: #long put: #{CLongType};
- at: #uLong put: #{CULongType};
- at: #byte put: #{CByteType};
- at: #char put: #{CCharType};
- at: #uChar put: #{CUCharType};
- at: #uchar put: #{CUCharType};
- at: #short put: #{CShortType};
- at: #uShort put: #{CUShortType};
- at: #ushort put: #{CUShortType};
- at: #int put: #{CIntType};
- at: #uInt put: #{CUIntType};
- at: #uint put: #{CUIntType};
- at: #float put: #{CFloatType};
- at: #double put: #{CDoubleType};
- at: #longDouble put: #{CLongDoubleType};
- at: #string put: #{CStringType};
- at: #smalltalk put: #{CSmalltalkType};
- yourself
-!
-
sizeof
"Answer 0, the size of an empty struct"
^0
@@ -169,99 +146,30 @@ declaration: array inject: startOffset i
"Iterate through each member, doing alignment, size calculations,
and creating accessor methods"
- array do: [ :dcl || type name |
+ array do: [ :dcl || typeDecl name str type |
name := dcl at: 1.
- type := dcl at: 2.
+ typeDecl := dcl at: 2.
self emitInspectTo: inspStr for: name.
- self computeTypeString: type block: [ :typeInfo :typeString |
- | str |
- offset := aBlock value: offset value: typeInfo alignof.
- maxAlignment := typeInfo alignof max: maxAlignment.
-
- str := WriteStream on: (String new: 20).
- str nextPutAll: name;
- nl;
- nextPutAll: ' ^self at: ';
- print: offset;
- nextPutAll: ' type: ';
- nextPutAll: typeString.
- self compile: str classified: 'accessing'.
- offset := offset + typeInfo sizeof
- ]
+ type := CType from: typeDecl.
+ offset := aBlock value: offset value: type alignof.
+ maxAlignment := type alignof max: maxAlignment.
+
+ str := WriteStream on: (String new: 20).
+ str nextPutAll: name;
+ nl;
+ nextPutAll: ' ^self at: ';
+ print: offset;
+ nextPutAll: ' type: ';
+ store: type.
+ self compile: str classified: 'accessing'.
+ offset := offset + type sizeof
].
self compile: inspStr contents, ')' classified: 'debugging'.
self compileSize: offset align: maxAlignment
!
-computeAggregateType: type block: aBlock
- "Private - Called by computeTypeString:block: for pointers/arrays.
- Format of type:
- (array int 3) or
- (ptr FooStruct)
- "
- | structureType |
- structureType := type at: 1.
- structureType == #array
- ifTrue: [ ^self computeArrayType: type block: aBlock ].
- structureType == #ptr
- ifTrue: [ ^self computePtrType: type block: aBlock ].
-!
-
-computeTypeString: type block: aBlock
- "Private - Pass the size, alignment, and description of CType for aBlock,
- given the field description in `type' (the second element of each pair)."
- | typeInfo typeString |
- type class == Array
- ifTrue: [ ^self computeAggregateType: type block: aBlock ].
-
- "must be a type name, either built in or struct, either a Symbol
- or an Association"
-
- type isSymbol ifFalse: [
- typeString := '#{%1} value type'
- % { type value nameIn: Namespace current }.
-
- ^aBlock value: type value value: typeString.
- ].
-
- TypeMap at: type ifPresent: [ :binding |
- ^aBlock value: binding value value: binding key
- ].
-
- ^aBlock
- value: (Namespace current at: type)
- value: type, ' type'
-!
-
-
-computeArrayType: type block: aBlock
- "Private - Called by computeAggregateType:block: for arrays"
- | numElts elementType |
- elementType := type at: 2.
- numElts := type at: 3.
- self computeTypeString: elementType
- block: [ :typeInfo :typeString |
- aBlock value: (CArrayCType elementType: typeInfo
- numberOfElements: numElts)
- value: '(CArrayCType elementType: ', typeString,
- ' numberOfElements: ', (numElts printString), ')'
- ]
-!
-
-computePtrType: type block: aBlock
- "Private - Called by computeAggregateType:block: for pointers"
- | subType |
- subType := type at: 2.
- self computeTypeString: subType
- block: [ :typeInfo :typeString |
- aBlock value: CPtr
- value: '(CPtrCType elementType: ', typeString, ')'
- ]
-!
-
-
compileSize: size align: alignment
"Private - Compile sizeof and alignof methods"
| sizeofMethod alignofMethod |
--- orig/kernel/CType.st
+++ mod/kernel/CType.st
@@ -35,7 +35,7 @@
Object subclass: #CType
instanceVariableNames: 'cObjectType'
- classVariableNames: ''
+ classVariableNames: 'TypeMap'
poolDictionaries: ''
category: 'Language-C interface'
!
@@ -85,11 +85,79 @@ CPtrCType subclass: #CArrayCType
+!CType class methodsFor: 'initialization'!
+
+initialize
+ "Initialize the receiver's TypeMap"
+ Smalltalk at: #CObjectType put: (CType cObjectType: CObject).
+ Smalltalk at: #CCharType put: (CScalarCType cObjectType: CChar).
+ Smalltalk at: #CUCharType put: (CScalarCType cObjectType: CUChar).
+ Smalltalk at: #CShortType put: (CScalarCType cObjectType: CShort).
+ Smalltalk at: #CUShortType put: (CScalarCType cObjectType: CUShort).
+ Smalltalk at: #CLongType put: (CScalarCType cObjectType: CLong).
+ Smalltalk at: #CULongType put: (CScalarCType cObjectType: CULong).
+ Smalltalk at: #CIntType put: (CScalarCType cObjectType: CInt).
+ Smalltalk at: #CUIntType put: (CScalarCType cObjectType: CUInt).
+ Smalltalk at: #CSmalltalkType put: (CScalarCType cObjectType: CSmalltalk).
+ Smalltalk at: #CFloatType put: (CScalarCType cObjectType: CFloat).
+ Smalltalk at: #CDoubleType put: (CScalarCType cObjectType: CDouble).
+ Smalltalk at: #CLongDoubleType put: (CScalarCType cObjectType:
CLongDouble).
+ Smalltalk at: #CStringType put: (CStringCType cObjectType: CString).
+ Smalltalk at: #CByteType put: (CScalarCType cObjectType: CByte).
+ Smalltalk at: #CBooleanType put: (CScalarCType cObjectType:
CBoolean).
+
+ TypeMap := IdentityDictionary new
+ at: #long put: CLongType;
+ at: #uLong put: CULongType;
+ at: #byte put: CByteType;
+ at: #char put: CCharType;
+ at: #uChar put: CUCharType;
+ at: #uchar put: CUCharType;
+ at: #short put: CShortType;
+ at: #uShort put: CUShortType;
+ at: #ushort put: CUShortType;
+ at: #int put: CIntType;
+ at: #uInt put: CUIntType;
+ at: #uint put: CUIntType;
+ at: #float put: CFloatType;
+ at: #double put: CDoubleType;
+ at: #longDouble put: CLongDoubleType;
+ at: #string put: CStringType;
+ at: #smalltalk put: CSmalltalkType;
+ yourself
+! !
+
!CType class methodsFor: 'C instance creation'!
cObjectType: aCObjectSubclassBinding
"Create a new CType for the given subclass of CObject"
^self basicNew init: aCObjectSubclassBinding
+!
+
+from: type
+ "Private - Pass the size, alignment, and description of CType for aBlock,
+ given the field description in `type' (the second element of each pair)."
+ | typeInfo typeString |
+ type class == Array
+ ifTrue: [ ^self computeAggregateType: type ].
+
+ "must be a type name, either built in or struct, either a Symbol
+ or an Association"
+
+ type isSymbol ifFalse: [ ^type value type ].
+ ^TypeMap at: type ifAbsent: [ Namespace current at: type ]
+!
+
+computeAggregateType: type
+ "Private - Called by from: for pointers/arrays.
+ Format of type:
+ (#array #int 3) or
+ (#ptr #{FooStruct})
+ "
+ | structureType |
+ structureType := type at: 1.
+ structureType == #array ifTrue: [ ^CArrayCType from: type ].
+ structureType == #ptr ifTrue: [ ^CPtrCType from: type ].
! !
@@ -207,6 +275,13 @@ elementType
!CPtrCType class methodsFor: 'instance creation'!
+computePtrType: type
+ "Private - Called by computeAggregateType: for pointers"
+ | subType typeInfo |
+ subType := type at: 2.
+ typeInfo := self from: subType.
+ ^self elementType: typeInfo!
+
elementType: aCType
"Answer a new instance of CPtrCType that maps pointers to the given CType"
^self new init: CPtr; elementType: aCType
@@ -227,6 +302,15 @@ new: size
^CObject alloc: elementType sizeof * size type: self
! !
+!CPtrCType methodsFor: 'storing'!
+
+storeOn: aStream
+ aStream
+ nextPutAll: '(CPtrCType elementType: ';
+ store: self elementType;
+ nextPut: $)
+! !
+
!CPtrCType methodsFor: 'private'!
elementType: aCType
@@ -238,6 +322,16 @@ elementType: aCType
!CArrayCType class methodsFor: 'instance creation'!
+from: type
+ "Private - Called by CType>>from: for arrays"
+ | numElts elementType typeInfo |
+ elementType := type at: 2.
+ numElts := type at: 3.
+ typeInfo := self from: elementType.
+ ^self
+ elementType: typeInfo
+ numberOfElements: numElts!
+
elementType: aCType
self shouldNotImplement
!
@@ -254,6 +348,17 @@ elementType: aCType numberOfElements: an
! !
+!CArrayCType methodsFor: 'storing'!
+
+storeOn: aStream
+ aStream
+ nextPutAll: '(CArrayCType elementType: ';
+ store: self elementType;
+ nextPutAll: ' numberOfElements: ';
+ store: numElements printString;
+ nextPut: $)
+! !
+
!CArrayCType methodsFor: 'accessing'!
sizeof
@@ -279,20 +384,4 @@ numberOfElements: anInteger
! !
-Smalltalk at: #CObjectType put: (CType cObjectType: CObject).
-Smalltalk at: #CCharType put: (CScalarCType cObjectType: CChar).
-Smalltalk at: #CUCharType put: (CScalarCType cObjectType: CUChar).
-Smalltalk at: #CShortType put: (CScalarCType cObjectType: CShort).
-Smalltalk at: #CUShortType put: (CScalarCType cObjectType: CUShort).
-Smalltalk at: #CLongType put: (CScalarCType cObjectType: CLong).
-Smalltalk at: #CULongType put: (CScalarCType cObjectType: CULong).
-Smalltalk at: #CIntType put: (CScalarCType cObjectType: CInt).
-Smalltalk at: #CUIntType put: (CScalarCType cObjectType: CUInt).
-Smalltalk at: #CSmalltalkType put: (CScalarCType cObjectType: CSmalltalk).
-Smalltalk at: #CFloatType put: (CScalarCType cObjectType: CFloat).
-Smalltalk at: #CDoubleType put: (CScalarCType cObjectType: CDouble).
-Smalltalk at: #CLongDoubleType put: (CScalarCType cObjectType: CLongDouble).
-Smalltalk at: #CStringType put: (CStringCType cObjectType: CString).
-Smalltalk at: #CByteType put: (CScalarCType cObjectType: CByte).
-Smalltalk at: #CBooleanType put: (CScalarCType cObjectType: CBoolean).
-!
+CType initialize!
--- orig/kernel/CompildMeth.st
+++ mod/kernel/CompildMeth.st
@@ -540,15 +540,19 @@ rewriteAsCCall: func for: aClass
^self rewriteAsCCall: func returning: #smalltalk args: args!
rewriteAsCCall: func returning: returnType args: argsArray
- | descr literals bytecodes newMethod |
+ | descr literals bytecodes newMethod returnCType |
self isValidCCall
ifFalse: [ ^'C call-out not empty' ].
(CFunctionDescriptor isFunction: func)
ifFalse: [ ^'C function not defined '].
+ returnCType := (returnType isSymbol or: [ returnType isKindOf: CType ])
+ ifTrue: [ returnType ]
+ ifFalse: [ (CType from: returnType) cObjStoredType ].
+
descr := CFunctionDescriptor
for: func
- returning: returnType
+ returning: returnCType
withArgs: argsArray.
"One of these:
@@ -561,9 +565,9 @@ rewriteAsCCall: func returning: returnTy
bytecodes := #[ 136 1 45 0 30 34 67 0 ] ]
ifFalse: [
literals := { descr. #{ValueHolder}. }.
- bytecodes := returnType isSymbol
- ifTrue: [ #[ 136 1 95 1 30 34 22 0 51 0 ] ]
- ifFalse: [ #[ 136 1 95 1 30 34 22 0 30 35 51 0 ] ] ].
+ bytecodes := (returnCType isKindOf: CType)
+ ifTrue: [ #[ 136 1 95 1 30 34 22 0 30 35 51 0 ] ]
+ ifFalse: [ #[ 136 1 95 1 30 34 22 0 51 0 ] ] ].
newMethod := CompiledMethod
literals: literals
--- orig/libgst/cint.c
+++ mod/libgst/cint.c
@@ -58,45 +58,6 @@
#include "../libffi/include/ffi.h"
#include <ltdl.h>
-typedef enum
-{ /* types for C parameters */
- CDATA_UNKNOWN, /* when there is no type a priori */
- CDATA_CHAR,
- CDATA_STRING,
- CDATA_STRING_OUT, /* for things that modify string params */
- CDATA_SYMBOL,
- CDATA_BYTEARRAY,
- CDATA_BYTEARRAY_OUT,
- CDATA_BOOLEAN,
- CDATA_INT,
- CDATA_UINT,
- CDATA_LONG,
- CDATA_ULONG,
- CDATA_FLOAT,
- CDATA_DOUBLE,
- CDATA_LONG_DOUBLE,
- CDATA_VOID, /* valid only as a return type */
- CDATA_VARIADIC, /* for parameters, this param is an
- array to be interpreted as
- arguments. Note that only simple
- conversions are performed in this
- case. */
- CDATA_VARIADIC_OOP, /* for parameters, this param is an
- array whose elements are OOPs to be
- passed. */
- CDATA_COBJECT, /* a C object is being passed */
- CDATA_COBJECT_PTR, /* a C object pointer is being passed */
- CDATA_OOP, /* no conversion to-from C (OOP) */
- CDATA_SELF, /* pass self as the corresponding
- argument */
- CDATA_SELF_OOP, /* pass self as an OOP */
- CDATA_WCHAR,
- CDATA_WSTRING,
- CDATA_WSTRING_OUT,
- CDATA_SYMBOL_OUT
-}
-cdata_type;
-
typedef struct symbol_type_map
{
OOP *symbol;
@@ -228,38 +189,46 @@ static cfunc_info *c_func_cur = NULL;
/* printable names for corresponding C types */
static const char *c_type_name[] = {
- "void?", /* CDATA_UNKNOWN */
"char", /* CDATA_CHAR */
+ "unsigned char", /* CDATA_UCHAR */
+ "short", /* CDATA_SHORT */
+ "unsigned short", /* CDATA_USHORT */
+ "long", /* CDATA_LONG */
+ "unsigned long", /* CDATA_ULONG */
+ "float", /* CDATA_FLOAT */
+ "double", /* CDATA_DOUBLE */
"char *", /* CDATA_STRING */
+ "OOP", /* CDATA_OOP */
+ "int", /* CDATA_INT */
+ "unsigned int", /* CDATA_UINT */
+ "long double", /* CDATA_LONG_DOUBLE */
+
+ "void?", /* CDATA_UNKNOWN */
"char *", /* CDATA_STRING_OUT */
"char *", /* CDATA_SYMBOL */
"char *", /* CDATA_BYTEARRAY */
"char *", /* CDATA_BYTEARRAY_OUT */
"int", /* CDATA_BOOLEAN */
- "int", /* CDATA_INT */
- "unsigned int", /* CDATA_UINT */
- "long", /* CDATA_LONG */
- "unsigned long", /* CDATA_ULONG */
- "float", /* CDATA_FLOAT */
- "double", /* CDATA_DOUBLE */
- "long double", /* CDATA_LONG_DOUBLE */
"void?", /* CDATA_VOID */
"...", /* CDATA_VARIADIC */
"...", /* CDATA_VARIADIC_OOP */
"void *", /* CDATA_COBJECT -- this is misleading */
"void **", /* CDATA_COBJECT_PTR */
- "OOP", /* CDATA_OOP */
"void?", /* CDATA_SELF */
"OOP", /* CDATA_SELF_OOP */
"wchar_t", /* CDATA_WCHAR */
"wchar_t *", /* CDATA_WSTRING */
"wchar_t *", /* CDATA_WSTRING_OUT */
+ "char *", /* CDATA_SYMBOL_OUT */
};
/* A map between symbols and the cdata_type enum. */
static const symbol_type_map type_map[] = {
{&_gst_unknown_symbol, CDATA_UNKNOWN},
{&_gst_char_symbol, CDATA_CHAR},
+ {&_gst_uchar_symbol, CDATA_UCHAR},
+ {&_gst_short_symbol, CDATA_SHORT},
+ {&_gst_ushort_symbol, CDATA_USHORT},
{&_gst_string_symbol, CDATA_STRING},
{&_gst_string_out_symbol, CDATA_STRING_OUT},
{&_gst_symbol_symbol, CDATA_SYMBOL},
@@ -754,12 +723,17 @@ get_ffi_type (OOP returnTypeOOP)
case CDATA_VOID:
case CDATA_INT:
- case CDATA_UINT:
case CDATA_CHAR:
+ case CDATA_SHORT:
case CDATA_WCHAR:
case CDATA_BOOLEAN:
return &ffi_type_sint;
+ case CDATA_UINT:
+ case CDATA_UCHAR:
+ case CDATA_USHORT:
+ return &ffi_type_uint;
+
case CDATA_FLOAT:
return &ffi_type_float;
@@ -860,11 +834,30 @@ push_smalltalk_obj (OOP oop,
case CDATA_INT:
case CDATA_UINT:
- case CDATA_CHAR:
cp->u.intVal = TO_C_INT (oop);
SET_TYPE (&ffi_type_sint);
return;
+ case CDATA_CHAR:
+ cp->u.intVal = (char) TO_C_INT (oop);
+ SET_TYPE (&ffi_type_sint);
+ return;
+
+ case CDATA_UCHAR:
+ cp->u.intVal = (unsigned char) TO_C_INT (oop);
+ SET_TYPE (&ffi_type_sint);
+ return;
+
+ case CDATA_SHORT:
+ cp->u.intVal = (short) TO_C_INT (oop);
+ SET_TYPE (&ffi_type_sint);
+ return;
+
+ case CDATA_USHORT:
+ cp->u.intVal = (unsigned short) TO_C_INT (oop);
+ SET_TYPE (&ffi_type_sint);
+ return;
+
case CDATA_DOUBLE:
cp->u.doubleVal = (double) TO_C_LONG (oop);
SET_TYPE (&ffi_type_double);
@@ -894,6 +887,9 @@ push_smalltalk_obj (OOP oop,
case CDATA_INT:
case CDATA_UINT:
case CDATA_CHAR:
+ case CDATA_UCHAR:
+ case CDATA_SHORT:
+ case CDATA_USHORT:
case CDATA_BOOLEAN:
cp->u.intVal = (oop == _gst_true_oop);
SET_TYPE (&ffi_type_sint);
@@ -902,7 +898,7 @@ push_smalltalk_obj (OOP oop,
}
else if ((class == _gst_char_class
- && (cType == CDATA_CHAR || cType == CDATA_WCHAR))
+ && (cType == CDATA_CHAR || cType == CDATA_UCHAR || cType ==
CDATA_WCHAR))
|| (class == _gst_unicode_character_class && cType == CDATA_WCHAR))
{
cp->u.intVal = CHAR_OOP_VALUE (oop);
@@ -1027,16 +1023,28 @@ c_to_smalltalk (cparam *result, OOP retu
resultOOP = char_new ((wchar_t) result->u.intVal);
break;
+ case CDATA_UCHAR:
+ resultOOP = FROM_INT ((gst_uchar) result->u.intVal);
+ break;
+
case CDATA_BOOLEAN:
resultOOP = result->u.intVal ? _gst_true_oop : _gst_false_oop;
break;
case CDATA_INT:
- resultOOP = FROM_C_INT ((long) result->u.intVal);
+ resultOOP = FROM_C_INT ((int) result->u.intVal);
break;
case CDATA_UINT:
- resultOOP = FROM_C_INT ((long) result->u.intVal);
+ resultOOP = FROM_C_UINT ((unsigned int) result->u.intVal);
+ break;
+
+ case CDATA_SHORT:
+ resultOOP = FROM_INT ((short) result->u.intVal);
+ break;
+
+ case CDATA_USHORT:
+ resultOOP = FROM_INT ((unsigned short) result->u.intVal);
break;
case CDATA_LONG:
--- orig/libgst/cint.h
+++ mod/libgst/cint.h
@@ -56,6 +56,49 @@
#ifndef GST_CINT_H
#define GST_CINT_H
+typedef enum
+{ /* types for C parameters */
+ CDATA_CHAR,
+ CDATA_UCHAR,
+ CDATA_SHORT,
+ CDATA_USHORT,
+ CDATA_LONG,
+ CDATA_ULONG,
+ CDATA_FLOAT,
+ CDATA_DOUBLE,
+ CDATA_STRING,
+ CDATA_OOP, /* no conversion to-from C (OOP) */
+ CDATA_INT,
+ CDATA_UINT,
+ CDATA_LONG_DOUBLE,
+
+ CDATA_UNKNOWN, /* when there is no type a priori */
+ CDATA_STRING_OUT, /* for things that modify string params */
+ CDATA_SYMBOL,
+ CDATA_BYTEARRAY,
+ CDATA_BYTEARRAY_OUT,
+ CDATA_BOOLEAN,
+ CDATA_VOID, /* valid only as a return type */
+ CDATA_VARIADIC, /* for parameters, this param is an
+ array to be interpreted as
+ arguments. Note that only simple
+ conversions are performed in this
+ case. */
+ CDATA_VARIADIC_OOP, /* for parameters, this param is an
+ array whose elements are OOPs to be
+ passed. */
+ CDATA_COBJECT, /* a C object is being passed */
+ CDATA_COBJECT_PTR, /* a C object pointer is being passed */
+ CDATA_SELF, /* pass self as the corresponding
+ argument */
+ CDATA_SELF_OOP, /* pass self as an OOP */
+ CDATA_WCHAR,
+ CDATA_WSTRING,
+ CDATA_WSTRING_OUT,
+ CDATA_SYMBOL_OUT
+}
+cdata_type;
+
/* Value of errno which is checked by the Smalltalk base classes. */
extern int _gst_errno
ATTRIBUTE_HIDDEN;
--- orig/libgst/prims.def
+++ mod/libgst/prims.def
@@ -3436,45 +3436,45 @@ primitive VMpr_Memory_at [succeed,fail]
arg2 = TO_C_LONG (oop3);
switch (arg1)
{
- case 0: /* char */
- case 1: /* unsigned char */
+ case CDATA_CHAR: /* char */
+ case CDATA_UCHAR: /* unsigned char */
PUSH_OOP (CHAR_OOP_AT (*(unsigned char *) arg2));
PRIM_SUCCEEDED;
- case 2: /* short */
+ case CDATA_SHORT: /* short */
PUSH_INT (*(short *) arg2);
PRIM_SUCCEEDED;
- case 3: /* unsigned short */
+ case CDATA_USHORT: /* unsigned short */
PUSH_INT (*(unsigned short *) arg2);
PRIM_SUCCEEDED;
- case 4: /* long */
+ case CDATA_LONG: /* long */
PUSH_OOP (FROM_C_LONG (*(long *) arg2));
PRIM_SUCCEEDED;
- case 5: /* unsigned long */
+ case CDATA_ULONG: /* unsigned long */
PUSH_OOP (FROM_C_ULONG (*(unsigned long *) arg2));
PRIM_SUCCEEDED;
- case 6: /* float */
+ case CDATA_FLOAT: /* float */
PUSH_OOP (floate_new (*(float *) arg2));
PRIM_SUCCEEDED;
- case 7: /* double */
+ case CDATA_DOUBLE: /* double */
PUSH_OOP (floatd_new (*(double *) arg2));
PRIM_SUCCEEDED;
- case 8: /* string */
+ case CDATA_STRING: /* string */
if (*(char **) arg2)
PUSH_OOP (_gst_string_new (*(char **) arg2));
else
PUSH_OOP (_gst_nil_oop);
PRIM_SUCCEEDED;
- case 9: /* OOP */
+ case CDATA_OOP: /* OOP */
PUSH_OOP (*(OOP *) arg2);
PRIM_SUCCEEDED;
- case 10: /* int */
+ case CDATA_INT: /* int */
PUSH_OOP (FROM_C_INT (*(int *) arg2));
PRIM_SUCCEEDED;
- case 11: /* unsigned int */
+ case CDATA_UINT: /* unsigned int */
PUSH_OOP (FROM_C_UINT (*(unsigned int *) arg2));
PRIM_SUCCEEDED;
- case 12: /* long double */
+ case CDATA_LONG_DOUBLE: /* long double */
PUSH_OOP (floatq_new (*(long double *) arg2));
PRIM_SUCCEEDED;
}
@@ -3503,8 +3503,8 @@ primitive VMpr_Memory_atPut [succeed,fai
arg2 = TO_C_LONG (oop3);
switch (arg1)
{
- case 0: /* char */
- case 1: /* unsigned char */
+ case CDATA_CHAR: /* char */
+ case CDATA_UCHAR: /* unsigned char */
/* may want to use Character instead? */
if (IS_CLASS (oop3, _gst_char_class)
|| (IS_CLASS (oop3, _gst_unicode_character_class)
@@ -3519,23 +3519,23 @@ primitive VMpr_Memory_atPut [succeed,fai
PRIM_SUCCEEDED;
}
break;
- case 2: /* short */
- case 3: /* unsigned short */
+ case CDATA_SHORT: /* short */
+ case CDATA_USHORT: /* unsigned short */
if (IS_INT (oop4))
{
*(short *) arg2 = (short) TO_INT (oop4);
PRIM_SUCCEEDED;
}
break;
- case 4: /* long */
- case 5: /* unsigned long */
+ case CDATA_LONG: /* long */
+ case CDATA_ULONG: /* unsigned long */
if (IS_C_LONG (oop4))
{
*(long *) arg2 = TO_C_LONG (oop4);
PRIM_SUCCEEDED;
}
break;
- case 6: /* float */
+ case CDATA_FLOAT: /* float */
if (IS_CLASS (oop4, _gst_floatd_class))
{
*(float *) arg2 = (float) FLOATD_OOP_VALUE (oop4);
@@ -3552,7 +3552,7 @@ primitive VMpr_Memory_atPut [succeed,fai
PRIM_SUCCEEDED;
}
break;
- case 7: /* double */
+ case CDATA_DOUBLE: /* double */
if (IS_CLASS (oop4, _gst_floatd_class))
{
*(double *) arg2 = FLOATD_OOP_VALUE (oop4);
@@ -3569,7 +3569,7 @@ primitive VMpr_Memory_atPut [succeed,fai
PRIM_SUCCEEDED;
}
break;
- case 8: /* string */
+ case CDATA_STRING: /* string */
if (IS_CLASS (oop4, _gst_string_class)
|| IS_CLASS (oop4, _gst_symbol_class))
{
@@ -3579,18 +3579,18 @@ primitive VMpr_Memory_atPut [succeed,fai
PRIM_SUCCEEDED;
}
break;
- case 9: /* OOP */
+ case CDATA_OOP: /* OOP */
*(OOP *) arg2 = oop4;
PRIM_SUCCEEDED;
- case 10: /* int */
- case 11: /* unsigned int */
+ case CDATA_INT: /* int */
+ case CDATA_UINT: /* unsigned int */
if (IS_C_INT (oop4))
{
*(int *) arg2 = TO_C_INT (oop4);
PRIM_SUCCEEDED;
}
break;
- case 12: /* long double */
+ case CDATA_LONG_DOUBLE: /* long double */
if (IS_CLASS (oop4, _gst_floatd_class))
{
*(long double *) arg2 = (long double) FLOATD_OOP_VALUE (oop4);
@@ -4420,36 +4420,36 @@ primitive VMpr_CObject_at :
switch (arg3)
{
- case 0:
- case 1:
+ case CDATA_CHAR:
+ case CDATA_UCHAR:
PUSH_OOP (CHAR_OOP_AT (*(gst_uchar *) addr));
PRIM_SUCCEEDED;
- case 2:
+ case CDATA_SHORT:
PUSH_INT (*(short *) addr);
PRIM_SUCCEEDED;
- case 3:
+ case CDATA_USHORT:
PUSH_INT (*(unsigned short *) addr);
PRIM_SUCCEEDED;
- case 4:
+ case CDATA_LONG:
PUSH_OOP (FROM_C_LONG (*(long *) addr));
PRIM_SUCCEEDED;
- case 5:
+ case CDATA_ULONG:
PUSH_OOP (FROM_C_ULONG (*(unsigned long *) addr));
PRIM_SUCCEEDED;
- case 6:
+ case CDATA_FLOAT:
PUSH_OOP (floate_new (*(float *) addr));
PRIM_SUCCEEDED;
- case 7:
+ case CDATA_DOUBLE:
PUSH_OOP (floatd_new (*(double *) addr));
PRIM_SUCCEEDED;
- case 8:
+ case CDATA_STRING:
{
char **strAddr;
strAddr = (char **) addr;
@@ -4464,19 +4464,19 @@ primitive VMpr_CObject_at :
PRIM_SUCCEEDED;
}
}
- case 9:
+ case CDATA_OOP:
PUSH_OOP (*(OOP *) addr);
PRIM_SUCCEEDED;
- case 10:
+ case CDATA_INT:
PUSH_OOP (FROM_C_INT (*(int *) addr));
PRIM_SUCCEEDED;
- case 11:
+ case CDATA_UINT:
PUSH_OOP (FROM_C_UINT (*(unsigned int *) addr));
PRIM_SUCCEEDED;
- case 12:
+ case CDATA_LONG_DOUBLE:
PUSH_OOP (floatq_new (*(long double *) addr));
PRIM_SUCCEEDED;
}
@@ -4538,8 +4538,8 @@ primitive VMpr_CObject_atPut :
arg4 = TO_INT (oop4);
switch (arg4)
{
- case 0: /* char */
- case 1: /* uchar */
+ case CDATA_CHAR: /* char */
+ case CDATA_UCHAR: /* uchar */
if (IS_CLASS (oop3, _gst_char_class)
|| (IS_CLASS (oop3, _gst_unicode_character_class)
&& CHAR_OOP_VALUE (oop3) <= 127))
@@ -4554,8 +4554,8 @@ primitive VMpr_CObject_atPut :
}
break;
- case 2: /* short */
- case 3: /* ushort */
+ case CDATA_SHORT: /* short */
+ case CDATA_USHORT: /* ushort */
if (IS_INT (oop3))
{
*(short *) addr = (short) TO_INT (oop3);
@@ -4563,8 +4563,8 @@ primitive VMpr_CObject_atPut :
}
break;
- case 4: /* long */
- case 5: /* ulong */
+ case CDATA_LONG: /* long */
+ case CDATA_ULONG: /* ulong */
if (IS_C_LONG (oop3))
{
*(long *) addr = (long) TO_C_LONG (oop3);
@@ -4572,7 +4572,7 @@ primitive VMpr_CObject_atPut :
}
break;
- case 6:
+ case CDATA_FLOAT:
{
float *floatAddr;
floatAddr = (float *) addr;
@@ -4599,7 +4599,7 @@ primitive VMpr_CObject_atPut :
}
break;
- case 7: /* double */
+ case CDATA_DOUBLE: /* double */
{
double *doubleAddr;
doubleAddr = (double *) addr;
@@ -4626,7 +4626,7 @@ primitive VMpr_CObject_atPut :
}
break;
- case 8: /* string */
+ case CDATA_STRING: /* string */
{ /* note that this does not allow for
replacemnt in place */
/* to replace in place, use replaceFrom: */
@@ -4649,12 +4649,12 @@ primitive VMpr_CObject_atPut :
break;
}
- case 9:
+ case CDATA_OOP:
*(OOP *) addr = oop3;
PRIM_SUCCEEDED;
- case 10: /* int */
- case 11: /* uint */
+ case CDATA_INT: /* int */
+ case CDATA_UINT: /* uint */
if (IS_C_INT (oop3))
{
*(int *) addr = (int) TO_C_INT (oop3);
@@ -4662,7 +4662,7 @@ primitive VMpr_CObject_atPut :
}
break;
- case 12: /* long double */
+ case CDATA_LONG_DOUBLE: /* long double */
{
long double *longDoubleAddr;
longDoubleAddr = (long double *) addr;
--- orig/libgst/sym.c
+++ mod/libgst/sym.c
@@ -128,6 +128,7 @@ OOP _gst_primitive_symbol = NULL;
OOP _gst_repeat_symbol = NULL;
OOP _gst_self_smalltalk_symbol = NULL;
OOP _gst_self_symbol = NULL;
+OOP _gst_short_symbol = NULL;
OOP _gst_smalltalk_symbol = NULL;
OOP _gst_smalltalk_namespace_symbol = NULL;
OOP _gst_start_execution_symbol = NULL;
@@ -142,8 +143,10 @@ OOP _gst_times_repeat_symbol = NULL;
OOP _gst_to_by_do_symbol = NULL;
OOP _gst_to_do_symbol = NULL;
OOP _gst_true_symbol = NULL;
+OOP _gst_uchar_symbol = NULL;
OOP _gst_uint_symbol = NULL;
OOP _gst_ulong_symbol = NULL;
+OOP _gst_ushort_symbol = NULL;
OOP _gst_undeclared_symbol = NULL;
OOP _gst_unknown_symbol = NULL;
OOP _gst_value_with_rec_with_args_symbol = NULL;
@@ -268,6 +271,7 @@ static const symbol_info sym_info[] = {
{&_gst_c_object_ptr_symbol, "cObjectPtr"},
{&_gst_category_symbol, "category:"},
{&_gst_char_symbol, "char"},
+ {&_gst_uchar_symbol, "uChar"},
{&_gst_does_not_understand_symbol, "doesNotUnderstand:"},
{&_gst_float_symbol, "float"},
{&_gst_double_symbol, "double"},
@@ -288,6 +292,8 @@ static const symbol_info sym_info[] = {
{&_gst_repeat_symbol, "repeat"},
{&_gst_self_symbol, "self"},
{&_gst_self_smalltalk_symbol, "selfSmalltalk"},
+ {&_gst_short_symbol, "short"},
+ {&_gst_ushort_symbol, "uShort"},
{&_gst_smalltalk_symbol, "smalltalk"},
{&_gst_smalltalk_namespace_symbol, "Smalltalk"},
{&_gst_start_execution_symbol, "startExecution:"},
--- orig/libgst/sym.h
+++ mod/libgst/sym.h
@@ -135,6 +135,8 @@ extern OOP _gst_primitive_symbol ATTRIBU
extern OOP _gst_repeat_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_self_smalltalk_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_self_symbol ATTRIBUTE_HIDDEN;
+extern OOP _gst_short_symbol ATTRIBUTE_HIDDEN;
+extern OOP _gst_ushort_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_smalltalk_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_smalltalk_namespace_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_start_execution_symbol ATTRIBUTE_HIDDEN;
@@ -149,6 +151,7 @@ extern OOP _gst_times_repeat_symbol ATTR
extern OOP _gst_to_by_do_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_to_do_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_true_symbol ATTRIBUTE_HIDDEN;
+extern OOP _gst_uchar_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_uint_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_ulong_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_undeclared_symbol ATTRIBUTE_HIDDEN;
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] Add CType>>#from:,
Paolo Bonzini <=