--- a/ExternalLibraryFunction.st Mon Apr 24 10:49:16 2006 +0200
+++ b/ExternalLibraryFunction.st Tue Apr 25 12:33:27 2006 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -19,12 +19,38 @@
category:'System-Support'
!
+!ExternalLibraryFunction primitiveDefinitions!
+%{
+# include <ffi.h>
+
+# define MAX_ARGS 128
+
+# define STX_FFI_TYPE_VOID 0
+# define STX_FFI_TYPE_INT 1
+# define STX_FFI_TYPE_FLOAT 2
+# define STX_FFI_TYPE_DOUBLE 3
+# define STX_FFI_TYPE_LONGDOUBLE 4
+# define STX_FFI_TYPE_UINT8 5
+# define STX_FFI_TYPE_SINT8 6
+# define STX_FFI_TYPE_UINT16 7
+# define STX_FFI_TYPE_SINT16 8
+# define STX_FFI_TYPE_UINT32 9
+# define STX_FFI_TYPE_SINT32 10
+# define STX_FFI_TYPE_UINT64 11
+# define STX_FFI_TYPE_SINT64 12
+# define STX_FFI_TYPE_STRUCT 0x10000 /* + size */
+# define STX_FFI_TYPE_STRUCT_SIZE_MASK 0x0FFFF /* size mask */
+# define STX_FFI_TYPE_POINTER 13
+
+%}
+! !
+
!ExternalLibraryFunction class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -33,15 +59,30 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+example
+"
+ |f|
+
+ f := ExternalLibraryFunction new.
+ f name:'MessageBeep'
+ module:'user32.dll'
+ callType:#WINAPI
+ returnType:#boolean
+ argumentTypes:#(uint).
+
+ f invokeWith:1.
+"
! !
!ExternalLibraryFunction class methodsFor:'instance creation'!
-name:functionName module:moduleName callType:callType
- returnType:returnType argumentTypes:argTypes
+name:functionName module:moduleName callType:callType
+ returnType:returnType argumentTypes:argTypes
^ self new
- name:functionName module:moduleName callType:callType
- returnType:returnType argumentTypes:argTypes
+ name:functionName module:moduleName callType:callType
+ returnType:returnType argumentTypes:argTypes
! !
!ExternalLibraryFunction class methodsFor:'constants'!
@@ -72,42 +113,42 @@
invoke
self hasCode ifFalse:[
- self prepareInvoke.
+ self prepareInvoke.
].
^ self invokeFFIWithArguments:#()
!
invokeWith:arg
self hasCode ifFalse:[
- self prepareInvoke.
+ self prepareInvoke.
].
^ self invokeFFIWithArguments:(Array with:arg)
!
invokeWith:arg1 with:arg2
self hasCode ifFalse:[
- self prepareInvoke.
+ self prepareInvoke.
].
^ self invokeFFIWithArguments:(Array with:arg1 with:arg2)
!
invokeWith:arg1 with:arg2 with:arg3
self hasCode ifFalse:[
- self prepareInvoke.
+ self prepareInvoke.
].
^ self invokeFFIWithArguments:(Array with:arg1 with:arg2 with:arg3)
!
invokeWith:arg1 with:arg2 with:arg3 with:arg4
self hasCode ifFalse:[
- self prepareInvoke.
+ self prepareInvoke.
].
^ self invokeFFIWithArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
!
invokeWithArguments:argArray
self hasCode ifFalse:[
- self prepareInvoke.
+ self prepareInvoke.
].
^ self invokeFFIWithArguments:argArray
! !
@@ -127,79 +168,66 @@
!ExternalLibraryFunction methodsFor:'private'!
invokeFFIWithArguments:arguments
- |ffiArgTypes failureCode|
+ |argTypeSymbols returnTypeSymbol failureCode|
argumentTypes notNil ifTrue:[
- ffiArgTypes := argumentTypes collect:[:argType | self ffiArgTypeForType:argType].
+ argTypeSymbols := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType].
].
+ returnTypeSymbol := self ffiTypeSymbolForType:returnType.
+
%{
-#if defined(i386)
-# ifndef STX_FFI_TYPE_VOID
-# define STX_FFI_TYPE_VOID 0
-# define STX_FFI_TYPE_INT 1
-# define STX_FFI_TYPE_FLOAT 2
-# define STX_FFI_TYPE_DOUBLE 3
-# define STX_FFI_TYPE_LONGDOUBLE 4
-# define STX_FFI_TYPE_UINT8 5
-# define STX_FFI_TYPE_SINT8 6
-# define STX_FFI_TYPE_UINT16 7
-# define STX_FFI_TYPE_SINT16 8
-# define STX_FFI_TYPE_UINT32 9
-# define STX_FFI_TYPE_SINT32 10
-# define STX_FFI_TYPE_UINT64 11
-# define STX_FFI_TYPE_SINT64 12
-# define STX_FFI_TYPE_STRUCT 13
-# define STX_FFI_TYPE_POINTER 14
-
-# define MAX_NUMARGS 128
-typedef void * ffi_type;
-# endif
-
- void *argValues[MAX_NUMARGS];
- ffi_type *argtypes[MAX_NUMARGS];
+ ffi_type *argTypes[MAX_ARGS];
+ union {
+ int iVal;
+ } argValues[MAX_ARGS];
+ void *argValuePointers[MAX_ARGS];
int numArgs;
int i;
+ static int null = 0;
if (arguments == nil) {
numArgs = 0;
- if (ffiArgTypes != nil) {
- if (! __isArray(ffiArgTypes)) goto error;
- if (__arraySize(ffiArgTypes) != numArgs) goto error;
+ if (argTypeSymbols != nil) {
+ if (! __isArray(argTypeSymbols)) goto error;
+ if (__arraySize(argTypeSymbols) != numArgs) goto error;
}
} else {
if (! __isArray(arguments)) goto error;
numArgs = __arraySize(arguments);
- if (! __isArray(ffiArgTypes)) goto error;
- if (__arraySize(ffiArgTypes) != numArgs) goto error;
+ if (! __isArray(argTypeSymbols)) goto error;
+ if (__arraySize(argTypeSymbols) != numArgs) goto error;
}
- if (numArgs > MAX_NUMARGS) {
+ if (numArgs > MAX_ARGS) {
failureCode = @symbol(TooManyArguments);
goto error;
}
+
for (i=0; i<numArgs; i++) {
- switch (__intVal( __ArrayInstPtr(ffiArgTypes)->a_element[i]) ) {
- case STX_FFI_TYPE_VOID:
- case STX_FFI_TYPE_INT:
- case STX_FFI_TYPE_FLOAT:
- case STX_FFI_TYPE_DOUBLE:
- case STX_FFI_TYPE_LONGDOUBLE:
- case STX_FFI_TYPE_UINT8:
- case STX_FFI_TYPE_SINT8:
- case STX_FFI_TYPE_UINT16:
- case STX_FFI_TYPE_SINT16:
- case STX_FFI_TYPE_UINT32:
- case STX_FFI_TYPE_SINT32:
- case STX_FFI_TYPE_UINT64:
- case STX_FFI_TYPE_SINT64:
- case STX_FFI_TYPE_STRUCT:
- case STX_FFI_TYPE_POINTER:
- default:
- failureCode = @symbol(UnknownArgumentType);
- goto error;
+ ffi_type *argType;
+ void *argValuePtr;
+ OBJ typeSymbol;
+
+ typeSymbol = __ArrayInstPtr(argTypeSymbols)->a_element[i];
+ if (typeSymbol == @symbol(int)) {
+ } else if (typeSymbol == @symbol(void)) {
+#if 0
+ argType = &ffi_type_void;
+#endif
+ argValuePtr = &null;
+ } else {
+ failureCode = @symbol(UnknownArgumentType);
+ goto error;
}
+
+ argTypes[i] = argType;
+ argValuePointers[i] = argValuePtr;
}
-#else
+# if 0
+ /* Initialize the cif */
+ CHECK(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1,
+ &ffi_type_sint64, args) == FFI_OK);
+
argtypes = (ffi_type **)C_alloca(sizeof(ffi_type *) * (n + 3));
argvalues = (void **)C_alloca(sizeof(void *) * (n + 3));
argtypes[ 0 ] = &ffi_type_pointer;
@@ -219,7 +247,8 @@
status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, n + 3, &ffi_type_void, argtypes);
assert(status == FFI_OK);
ffi_call(&cif, (void *)C_block_item(fn, 0), NULL, argvalues);
-#endif
+# endif
+
error: ;
%}
!
@@ -231,26 +260,26 @@
|handle code|
moduleName isNil ifTrue:[
- self error:'Missing moduleName'.
+ self error:'Missing moduleName'.
].
handle := ObjectFileLoader loadDynamicObject:moduleName.
handle isNil ifTrue:[
- self error:'Cannot load module: ', moduleName.
+ self error:'Cannot load module: ', moduleName.
].
moduleHandle := handle.
code := moduleHandle getFunctionAddress:name into:self.
code isNil ifTrue:[
- self error:'Missing function: ', name, ' in module: ', moduleName.
+ self error:'Missing function: ', name, ' in module: ', moduleName.
].
!
prepareInvoke
self hasCode ifFalse:[
- moduleHandle isNil ifTrue:[
- self linkToModule.
- self setupFFI.
- ].
+ moduleHandle isNil ifTrue:[
+ self linkToModule.
+ self setupFFI.
+ ].
].
!
@@ -261,14 +290,211 @@
"/ #if defined(WIN32) && defined(i386)
"/ /* Have special code for this case - no need to use of ffi code. */
"/ #else
-"/ if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1, &ffi_type_uint, args)) != FFI_OK)
-"/ #endif
-"/ %}
+"/ if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1, &ffi_type_uint, args))
! !
!ExternalLibraryFunction methodsFor:'private-accessing'!
-name:functionName module:aModuleName callType:aCallType returnType:aReturnType argumentTypes:argTypes
+STX_FFI_TYPE_DOUBLE
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_DOUBLE));
+%}.
+
+ "
+ self new STX_FFI_TYPE_DOUBLE
+ "
+!
+
+STX_FFI_TYPE_FLOAT
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_FLOAT));
+%}.
+
+ "
+ self new STX_FFI_TYPE_FLOAT
+ "
+!
+
+STX_FFI_TYPE_LONGDOUBLE
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_LONGDOUBLE));
+%}.
+
+ "
+ self new STX_FFI_TYPE_LONGDOUBLE
+ "
+!
+
+STX_FFI_TYPE_POINTER
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_POINTER));
+%}.
+
+ "
+ self new STX_FFI_TYPE_POINTER
+ "
+!
+
+STX_FFI_TYPE_SINT
+%{
+#if sizeof(int) == 4
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_SINT32));
+#endif
+#if sizeof(int) == 8
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_SINT64));
+#endif
+%}.
+ self primitiveFailed
+
+ "
+ self new STX_FFI_TYPE_SINT
+ "
+!
+
+STX_FFI_TYPE_SINT16
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_SINT16));
+%}.
+
+ "
+ self new STX_FFI_TYPE_SINT16
+ "
+!
+
+STX_FFI_TYPE_SINT32
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_SINT32));
+%}.
+
+ "
+ self new STX_FFI_TYPE_SINT32
+ "
+!
+
+STX_FFI_TYPE_SINT64
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_SINT64));
+%}.
+
+ "
+ self new STX_FFI_TYPE_SINT64
+ "
+!
+
+STX_FFI_TYPE_SINT8
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_SINT8));
+%}.
+
+ "
+ self new STX_FFI_TYPE_SINT8
+ "
+!
+
+STX_FFI_TYPE_STRUCT
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_STRUCT));
+%}.
+
+ "
+ self new STX_FFI_TYPE_STRUCT
+ "
+!
+
+STX_FFI_TYPE_STRUCT:size
+ ^ self STX_FFI_TYPE_STRUCT + size
+
+ "
+ self new STX_FFI_TYPE_STRUCT:0
+ self new STX_FFI_TYPE_STRUCT:16
+ "
+!
+
+STX_FFI_TYPE_UINT
+%{
+#if sizeof(int) == 4
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_UINT32));
+#endif
+#if sizeof(int) == 8
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_UINT64));
+#endif
+%}.
+ self primitiveFailed
+
+ "
+ self new STX_FFI_TYPE_UINT
+ "
+!
+
+STX_FFI_TYPE_UINT16
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_UINT16));
+%}.
+
+ "
+ self new STX_FFI_TYPE_UINT16
+ "
+!
+
+STX_FFI_TYPE_UINT64
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_UINT64));
+%}.
+
+ "
+ self new STX_FFI_TYPE_UINT64
+ "
+!
+
+STX_FFI_TYPE_UINT8
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_UINT8));
+%}.
+
+ "
+ self new STX_FFI_TYPE_UINT8
+ "
+!
+
+STX_FFI_TYPE_VOID
+%{
+ RETURN(__MKSMALLINT(STX_FFI_TYPE_VOID));
+%}
+
+ "
+ self new STX_FFI_TYPE_VOID
+ "
+!
+
+ffiTypeForType:aType
+ "/ kludge
+
+ aType isSymbol ifTrue:[
+ "/ for those who do not have the CType package...
+ aType == #int ifTrue:[ ^ self STX_FFI_TYPE_INT ].
+ aType == #uint ifTrue:[ ^ self STX_FFI_TYPE_UINT ].
+ aType == #short ifTrue:[ ^ self STX_FFI_TYPE_SHORT ].
+ aType == #ushort ifTrue:[ ^ self STX_FFI_TYPE_USHORT ].
+ aType == #long ifTrue:[ ^ self STX_FFI_TYPE_LONG ].
+ aType == #ulong ifTrue:[ ^ self STX_FFI_TYPE_ULONG ].
+ aType == #float ifTrue:[ ^ self STX_FFI_TYPE_FLOAT ].
+ aType == #double ifTrue:[ ^ self STX_FFI_TYPE_DOUBLE ].
+ aType == #void ifTrue:[ ^ self STX_FFI_TYPE_VOID ].
+ self error:'unknown type'.
+ ].
+ self error:'unknown type'.
+!
+
+ffiTypeSymbolForType:aType
+ "/ kludge for those who do not have the CType package...
+ aType isSymbol ifTrue:[ ^ aType ].
+ CType isNil ifTrue:[
+ self error:'unknown type'.
+ ].
+ ^ aType typeSymbol
+!
+
+name:functionName module:aModuleName callType:aCallType returnType:aReturnType argumentTypes:argTypes
name := functionName.
moduleName := aModuleName.
callType := aCallType.
@@ -279,5 +505,5 @@
!ExternalLibraryFunction class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.5 2006-04-24 08:49:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.6 2006-04-25 10:33:27 cg Exp $'
! !