diff --git a/kernel/CCallable.st b/kernel/CCallable.st index 2b3feb6..e12f5a1 100644 --- a/kernel/CCallable.st +++ b/kernel/CCallable.st @@ -52,7 +52,7 @@ to perform the actual call-out to C routines.'> #string #smalltalk #int #uInt #longDouble #unknown #stringOut #symbol #byteArray #byteArrayOut #boolean #void #variadic #variadicSmalltalk #cObject #cObjectPtr #self #selfSmalltalk - #wchar #wstring #wstringOut #symbolOut). + #wchar #wstring #wstringOut #symbolOut #longLong #uLongLong). dict := LookupTable new. reverse keysAndValuesDo: [ :k :v | diff --git a/kernel/CObject.st b/kernel/CObject.st index c6cc65f..775fed9 100644 --- a/kernel/CObject.st +++ b/kernel/CObject.st @@ -613,6 +613,103 @@ CScalar subclass: CSmalltalk [ ] ] + +CScalar subclass: CLongLong [ + + + + + CLongLong class >> sizeof [ + "Answer the receiver's instances size" + + + ^CLongLongSize + ] + + CLongLong class >> alignof [ + "Answer the receiver's instances required aligment" + + + ^CLongLongSize + ] + + CLongLong class >> cObjStoredType [ + "Private - Answer an index referring to the receiver's instances scalar type" + + + ^30 + ] + + sizeof [ + "Answer the receiver's size" + + + ^CLongLongSize + ] + + alignof [ + "Answer the receiver's required aligment" + + + ^CLongLongSize + ] + + cObjStoredType [ + "Private - Answer an index referring to the receiver's scalar type" + + + ^30 + ] +] + + +CScalar subclass: CULongLong [ + + + + + CULongLong class >> sizeof [ + "Answer the receiver's instances size" + + + ^CLongLongSize + ] + + CULongLong class >> alignof [ + "Answer the receiver's instances required aligment" + + + ^CLongLongSize + ] + + CULongLong class >> cObjStoredType [ + "Private - Answer an index referring to the receiver's instances scalar type" + + + ^31 + ] + + sizeof [ + "Answer the receiver's size" + + + ^CLongLongSize + ] + + alignof [ + "Answer the receiver's required aligment" + + + ^CLongLongSize + ] + + cObjStoredType [ + "Private - Answer an index referring to the receiver's scalar type" + + + ^31 + ] +] CScalar subclass: CLong [ diff --git a/kernel/CType.st b/kernel/CType.st index 6f02ed9..a730c7e 100644 --- a/kernel/CType.st +++ b/kernel/CType.st @@ -64,6 +64,8 @@ elements.'> Smalltalk at: #CUShortType put: (CScalarCType cObjectType: CUShort). Smalltalk at: #CLongType put: (CScalarCType cObjectType: CLong). Smalltalk at: #CULongType put: (CScalarCType cObjectType: CULong). + Smalltalk at: #CLongLongType put: (CScalarCType cObjectType: CLongLong). + Smalltalk at: #CULongLongType put: (CScalarCType cObjectType: CULongLong). Smalltalk at: #CIntType put: (CScalarCType cObjectType: CInt). Smalltalk at: #CUIntType put: (CScalarCType cObjectType: CUInt). Smalltalk at: #CSmalltalkType put: (CScalarCType cObjectType: CSmalltalk). @@ -76,6 +78,8 @@ elements.'> TypeMap := (IdentityDictionary new) at: #long put: CLongType; at: #uLong put: CULongType; + at: #longLong put: CLongLongType; + at: #uLongLong put: CULongLongType; at: #byte put: CByteType; at: #char put: CCharType; at: #uChar put: CUCharType; diff --git a/libgst/cint.c b/libgst/cint.c index 0d0baf3..364c021 100644 --- a/libgst/cint.c +++ b/libgst/cint.c @@ -74,6 +74,7 @@ typedef struct cparam float floatVal; double doubleVal; long double longDoubleVal; + long long longLongVal; struct { PTR pPtrVal; PTR ptrVal; @@ -432,6 +433,12 @@ my_opendir (const char *dir) return (result); } +void +test_longlong (long long aVerylongInt) +{ + printf ("Getting a long long 0x%llx\n", aVerylongInt); +} + void test_callin (OOP oop, int(*callback)(const char *)) { @@ -585,6 +592,7 @@ _gst_init_cfuncs (void) _gst_define_cfunc ("getArgv", get_argv); /* Test functions */ + _gst_define_cfunc ("testLongLong", test_longlong); _gst_define_cfunc ("testCallin", test_callin); _gst_define_cfunc ("testCString", test_cstring); _gst_define_cfunc ("testCObjectPtr", test_cobject_ptr); @@ -973,6 +981,9 @@ get_ffi_type (OOP returnTypeOOP) #else return &ffi_type_sint64; #endif + case CDATA_LONGLONG: + case CDATA_ULONGLONG: + return &ffi_type_sint64; case CDATA_VOID: case CDATA_INT: @@ -1041,6 +1052,10 @@ smalltalk_to_c (OOP oop, { switch (cType) { + case CDATA_LONGLONG: + case CDATA_ULONGLONG: + cp->u.longLongVal = to_c_int_64 (oop); + return &ffi_type_sint64; case CDATA_LONG: case CDATA_ULONG: cp->u.longVal = TO_C_LONG (oop); @@ -1088,6 +1103,10 @@ smalltalk_to_c (OOP oop, { switch (cType) { + case CDATA_LONGLONG: + case CDATA_ULONGLONG: + cp->u.longLongVal = (long long)(oop == _gst_true_oop); + return &ffi_type_sint64; case CDATA_LONG: case CDATA_ULONG: cp->u.longVal = (oop == _gst_true_oop); diff --git a/libgst/cint.h b/libgst/cint.h index a0ea7d8..fd9c07b 100644 --- a/libgst/cint.h +++ b/libgst/cint.h @@ -95,7 +95,9 @@ typedef enum CDATA_WCHAR, CDATA_WSTRING, CDATA_WSTRING_OUT, - CDATA_SYMBOL_OUT + CDATA_SYMBOL_OUT, + CDATA_LONGLONG, + CDATA_ULONGLONG } cdata_type; diff --git a/libgst/dict.c b/libgst/dict.c index 0b54dbf..e32d13b 100644 --- a/libgst/dict.c +++ b/libgst/dict.c @@ -1135,6 +1135,8 @@ init_c_symbols () FROM_INT (sizeof (double))); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleSize"), FROM_INT (sizeof (long double))); + NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongLongSize"), + FROM_INT (sizeof (long long))); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CPtrSize"), FROM_INT (sizeof (PTR))); diff --git a/libgst/prims.def b/libgst/prims.def index fd68d86..01ca2fc 100644 --- a/libgst/prims.def +++ b/libgst/prims.def @@ -3647,6 +3647,12 @@ primitive VMpr_Memory_at [succeed,fail] case CDATA_ULONG: /* unsigned long */ PUSH_OOP (FROM_C_ULONG (*(unsigned long *) arg2)); PRIM_SUCCEEDED; + case CDATA_LONGLONG: /* long */ + PUSH_OOP (from_c_int_64 (*(long long *) arg2)); + PRIM_SUCCEEDED; + case CDATA_ULONGLONG: /* unsigned long */ + PUSH_OOP (from_c_uint_64 (*(unsigned long long *) arg2)); + PRIM_SUCCEEDED; case CDATA_FLOAT: /* float */ PUSH_OOP (floate_new (*(float *) arg2)); PRIM_SUCCEEDED; @@ -3730,6 +3736,14 @@ primitive VMpr_Memory_atPut [succeed,fail] PRIM_SUCCEEDED; } break; + case CDATA_LONGLONG: /* long */ + case CDATA_ULONGLONG: /* unsigned long */ + if (IS_C_LONG (oop4)) + { + *(long long *) arg2 = to_c_int_64 (oop4); + PRIM_SUCCEEDED; + } + break; case CDATA_FLOAT: /* float */ if (IS_CLASS (oop4, _gst_floatd_class)) { @@ -4623,6 +4637,14 @@ primitive VMpr_CObject_at : SET_STACKTOP_INT (*(unsigned short *) addr); PRIM_SUCCEEDED; + case CDATA_LONGLONG: + SET_STACKTOP (from_c_int_64 (*(long long *) addr)); + PRIM_SUCCEEDED; + + case CDATA_ULONGLONG: + SET_STACKTOP (from_c_uint_64 (*(unsigned long long *) addr)); + PRIM_SUCCEEDED; + case CDATA_LONG: SET_STACKTOP (FROM_C_LONG (*(long *) addr)); PRIM_SUCCEEDED; @@ -4779,6 +4801,15 @@ primitive VMpr_CObject_atPut [succeed,fail] } break; + case CDATA_LONGLONG: /* long */ + case CDATA_ULONGLONG: /* ulong */ + if (IS_C_LONG (oop3)) + { + *(long long *) addr = (long long) to_c_int_64 (oop3); + PRIM_SUCCEEDED; + } + break; + case CDATA_FLOAT: { float *floatAddr; diff --git a/tests/cobjects.ok b/tests/cobjects.ok index b78bec7..8fb2db4 100644 --- a/tests/cobjects.ok +++ b/tests/cobjects.ok @@ -100,6 +100,10 @@ The string is this is a test returned value is nil Execution begins... +Getting a long long 0x100110012002 +returned value is nil + +Execution begins... returned value is 'this is a test' Execution begins... diff --git a/tests/cobjects.st b/tests/cobjects.st index e8488c5..f618783 100644 --- a/tests/cobjects.st +++ b/tests/cobjects.st @@ -119,12 +119,18 @@ Object extend [ testCObjectPtr: cObject [ ] + + testLongLong: aLong [ + + ] ] Eval [ true testCallin: (CCallbackDescriptor for: [ :x | x printNl. 3 ] returning: #int withArgs: #(#string)) ] Eval [ nil testCString: (CString value: 'this is a test') ] +Eval [ nil testLongLong: 16r100110012002. ^nil ] + Eval [ cObject := CCharType new. nil testCObjectPtr: cObject.