help-smalltalk
[Top][All Lists]
Advanced

[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;




reply via email to

[Prev in Thread] Current Thread [Next in Thread]