--- a/ExternalLibraryFunction.st Mon Mar 28 13:04:45 2016 +0200
+++ b/ExternalLibraryFunction.st Mon Mar 28 13:20:31 2016 +0200
@@ -314,6 +314,102 @@
"Modified: / 01-08-2006 / 13:44:57 / cg"
! !
+!ExternalLibraryFunction class methodsFor:'type name mapping'!
+
+ffiTypeSymbolForType:aType
+ "map type to one of the ffi-supported ones:
+ sint8, sint16, sint32, sint64
+ uint8, uint16, uint32, uint64
+ bool void pointer handle
+ "
+
+ aType == #sint8 ifTrue:[^ aType ].
+ aType == #sint16 ifTrue:[^ aType ].
+ aType == #sint32 ifTrue:[^ aType ].
+ aType == #sint64 ifTrue:[^ aType ].
+ aType == #uint8 ifTrue:[^ aType ].
+ aType == #uint16 ifTrue:[^ aType ].
+ aType == #uint32 ifTrue:[^ aType ].
+ aType == #uint64 ifTrue:[^ aType ].
+ aType == #double ifTrue:[^ aType ].
+ aType == #float ifTrue:[^ aType ].
+ aType == #char ifTrue:[^ aType ].
+ aType == #void ifTrue:[^ aType ].
+ aType == #bool ifTrue:[^ aType ].
+ aType == #pointer ifTrue:[^ aType ].
+ aType == #charPointer ifTrue:[^ aType ].
+ aType == #wcharPointer ifTrue:[^ aType ].
+
+ aType == #int8 ifTrue:[^ #sint8 ].
+ aType == #int16 ifTrue:[^ #sint16 ].
+ aType == #int32 ifTrue:[^ #sint32 ].
+ aType == #int64 ifTrue:[^ #sint64 ].
+
+ aType == #voidPointer ifTrue:[^ #pointer ].
+ aType == #uint8Pointer ifTrue:[^ #pointer ].
+ aType == #voidPointerPointer ifTrue:[^ #pointer ].
+
+ aType == #short ifTrue:[^ #sint16 ].
+ aType == #long ifTrue:[^ #long ].
+ aType == #int ifTrue:[^ #int ].
+ aType == #uint ifTrue:[^ #uint ].
+ aType == #ushort ifTrue:[^ #uint16 ].
+ aType == #unsignedShort ifTrue:[^ #uint16 ].
+ aType == #ulong ifTrue:[^ #ulong ].
+ aType == #unsignedLong ifTrue:[^ #ulong ].
+ aType == #uchar ifTrue:[^ #uint8 ].
+ aType == #unsignedChar ifTrue:[^ #uint8 ].
+ aType == #byte ifTrue:[^ #uint8 ].
+ aType == #longlong ifTrue:[^ #sint64 ].
+ aType == #longLong ifTrue:[^ #sint64 ].
+ aType == #ulonglong ifTrue:[^ #uint64 ].
+ aType == #ulongLong ifTrue:[^ #uint64 ].
+
+ "/ windefs
+ aType == #dword ifTrue:[^ #uint32 ].
+ aType == #sdword ifTrue:[^ #sint32 ].
+ aType == #word ifTrue:[^ #uint16 ].
+ aType == #sword ifTrue:[^ #sint16 ].
+ aType == #handle ifTrue:[^ #pointer ].
+ aType == #lpstr ifTrue:[^ #charPointer ].
+ aType == #hresult ifTrue:[^ #uint32 ].
+ aType == #boolean ifTrue:[^ #bool ].
+ "/ care for 64bit machines
+ aType == #ulongReturn ifTrue:[^ ExternalAddress pointerSize == 8 ifTrue:[#uint64] ifFalse:[#uint32]].
+ aType == #none ifTrue:[^ #void ].
+ aType == #struct ifTrue:[^ #pointer ].
+ aType == #structIn ifTrue:[^ #pointer ].
+ aType == #structOut ifTrue:[^ #pointer ].
+ aType == #structInOut ifTrue:[^ #pointer ].
+ aType == #unsigned ifTrue:[^ #uint ].
+
+ aType == #ATOM ifTrue:[^ #uint16 ].
+ aType == #BOOL ifTrue:[^ #int ].
+ aType == #BOOLEAN ifTrue:[^ #uint8 ].
+ aType == #BYTE ifTrue:[^ #uint8 ].
+ aType == #DWORD ifTrue:[^ #uint32 ].
+ aType == #HANDLE ifTrue:[^ #pointer ].
+ "/ care for 64bit machines
+ aType == #SIZE_T ifTrue:[^ ExternalAddress pointerSize == 8 ifTrue:[#uint64] ifFalse:[#uint32]].
+
+ (aType isString or:[aType isSymbol]) ifFalse:[
+ CType isNil ifTrue:[
+ self error:'unknown type'.
+ ].
+ ^ aType typeSymbol.
+ ].
+
+ (aType endsWith:'*') ifTrue:[
+ ^ #pointer.
+ ].
+ (aType endsWith:'Pointer') ifTrue:[
+ ^ #pointer.
+ ].
+ ^ aType
+
+ "Modified: / 14-06-2007 / 17:21:42 / cg"
+! !
+
!ExternalLibraryFunction methodsFor:'accessing'!
argumentTypes
@@ -448,18 +544,27 @@
!
isCallTypeAPI
+ "is this a windows API-call linkage call.
+ Attention: this uses a different call API (callee unwinds the stack),
+ and MUST be declared as such for many Kernel functions.
+ The calltype API is one of the worst historic garbage kept by MS..."
+
^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_API.
"Created: / 01-08-2006 / 15:21:16 / cg"
!
isCallTypeC
+ "is this a regular C-call (attention: on windows, there are two kinds of calls)"
+
^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_C.
"Created: / 01-08-2006 / 15:21:23 / cg"
!
isCallTypeOLE
+ "is this an OLE-object call ? (eg. a virtual c++ call; same as isCallTypeCPP)"
+
^ ((flags ? 0) bitTest: FLAG_VIRTUAL).
"Created: / 01-08-2006 / 15:21:23 / cg"
@@ -499,7 +604,7 @@
!
isVirtualCPP
- "is this a virtual c++-function ?"
+ "is this a virtual c++-function (same as isCallTypeOLE) ?"
^ (flags ? 0) bitTest: FLAG_VIRTUAL.
@@ -638,10 +743,16 @@
!ExternalLibraryFunction methodsFor:'private'!
adjustTypes
+ "map all those existing type names to a small number of definite ffi type names.
+ This is needed, because there are so many different C-type names found in code imported
+ from various Smalltalk dialects' library function call declarations.
+ For example: all of word, WORD, unsignedShort, ushort, uShort etc. will map to uint16.
+ Also, this deals with pointer size differences."
+
argumentTypes notEmptyOrNil ifTrue:[
- argumentTypes := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType].
+ argumentTypes := argumentTypes collect:[:argType | self class ffiTypeSymbolForType:argType].
].
- returnType := self ffiTypeSymbolForType:returnType.
+ returnType := self class ffiTypeSymbolForType:returnType.
!
linkToModule
@@ -694,11 +805,16 @@
!
loadLibrary:dllName
+ "load a dll.
+ Notice the dllMapping mechanism, which can be used to silently load different dlls.
+ This is useful, if some code has a hardcoded dll-name in it, which needs to be changed,
+ but you do not want or cannot recompile the methods (i.e. no source avail)"
+
|handle nameString filename|
filename := dllName.
DllMapping notNil ifTrue:[
- filename := DllMapping at:filename ifAbsent:[ filename ]
+ filename := DllMapping at:filename ifAbsent:[ filename ]
].
filename := filename asFilename.
@@ -709,25 +825,25 @@
handle notNil ifTrue:[^ handle ].
filename isAbsolute ifFalse:[
- "First ask the class defining the ExternalFunction for the location of the dlls ..."
- owningClass notNil ifTrue:[
- owningClass dllPath do:[:eachDirectory |
- handle := ObjectFileLoader
- loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
- handle notNil ifTrue:[^ handle ].
- ].
- ].
- ".. then ask the system"
- self class dllPath do:[:eachDirectory |
- handle := ObjectFileLoader
- loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
- handle notNil ifTrue:[^ handle ].
- ].
+ "First ask the class defining the ExternalFunction for the location of the dlls ..."
+ owningClass notNil ifTrue:[
+ owningClass dllPath do:[:eachDirectory |
+ handle := ObjectFileLoader
+ loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
+ handle notNil ifTrue:[^ handle ].
+ ].
+ ].
+ ".. then ask the system"
+ self class dllPath do:[:eachDirectory |
+ handle := ObjectFileLoader
+ loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
+ handle notNil ifTrue:[^ handle ].
+ ].
].
filename suffix isEmpty ifTrue:[
- "/ try again with the OS-specific dll-extension
- ^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix)
+ "/ try again with the OS-specific dll-extension
+ ^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix)
].
^ nil
@@ -736,108 +852,18 @@
!
prepareInvoke
+ "called before invoked.
+ When called the very first time, moduleHandle is nil,
+ and we ensure that the dll is loaded, the function address is extracted"
+
(moduleHandle isNil or:[self hasCode not]) ifTrue:[
- self linkToModule.
- self adjustTypes.
+ self linkToModule.
+ self adjustTypes.
].
! !
!ExternalLibraryFunction methodsFor:'private-accessing'!
-ffiTypeSymbolForType:aType
- "map type to one of the ffi-supported ones:
- sint8, sint16, sint32, sint64
- uint8, uint16, uint32, uint64
- bool void pointer handle
- "
-
- aType == #sint8 ifTrue:[^ aType ].
- aType == #sint16 ifTrue:[^ aType ].
- aType == #sint32 ifTrue:[^ aType ].
- aType == #sint64 ifTrue:[^ aType ].
- aType == #uint8 ifTrue:[^ aType ].
- aType == #uint16 ifTrue:[^ aType ].
- aType == #uint32 ifTrue:[^ aType ].
- aType == #uint64 ifTrue:[^ aType ].
- aType == #double ifTrue:[^ aType ].
- aType == #float ifTrue:[^ aType ].
- aType == #char ifTrue:[^ aType ].
- aType == #void ifTrue:[^ aType ].
- aType == #bool ifTrue:[^ aType ].
- aType == #pointer ifTrue:[^ aType ].
- aType == #charPointer ifTrue:[^ aType ].
- aType == #wcharPointer ifTrue:[^ aType ].
-
- aType == #int8 ifTrue:[^ #sint8 ].
- aType == #int16 ifTrue:[^ #sint16 ].
- aType == #int32 ifTrue:[^ #sint32 ].
- aType == #int64 ifTrue:[^ #sint64 ].
-
- aType == #voidPointer ifTrue:[^ #pointer ].
- aType == #uint8Pointer ifTrue:[^ #pointer ].
- aType == #voidPointerPointer ifTrue:[^ #pointer ].
-
- aType == #short ifTrue:[^ #sint16 ].
- aType == #long ifTrue:[^ #long ].
- aType == #int ifTrue:[^ #int ].
- aType == #uint ifTrue:[^ #uint ].
- aType == #ushort ifTrue:[^ #uint16 ].
- aType == #unsignedShort ifTrue:[^ #uint16 ].
- aType == #ulong ifTrue:[^ #ulong ].
- aType == #unsignedLong ifTrue:[^ #ulong ].
- aType == #uchar ifTrue:[^ #uint8 ].
- aType == #unsignedChar ifTrue:[^ #uint8 ].
- aType == #byte ifTrue:[^ #uint8 ].
- aType == #longlong ifTrue:[^ #sint64 ].
- aType == #longLong ifTrue:[^ #sint64 ].
- aType == #ulonglong ifTrue:[^ #uint64 ].
- aType == #ulongLong ifTrue:[^ #uint64 ].
-
- "/ windefs
- aType == #dword ifTrue:[^ #uint32 ].
- aType == #sdword ifTrue:[^ #sint32 ].
- aType == #word ifTrue:[^ #uint16 ].
- aType == #sword ifTrue:[^ #sint16 ].
- aType == #handle ifTrue:[^ #pointer ].
- aType == #lpstr ifTrue:[^ #charPointer ].
- aType == #hresult ifTrue:[^ #uint32 ].
- aType == #boolean ifTrue:[^ #bool ].
- "/ care for 64bit machines
- aType == #ulongReturn ifTrue:[^ ExternalAddress pointerSize == 8 ifTrue:[#uint64] ifFalse:[#uint32]].
- aType == #none ifTrue:[^ #void ].
- aType == #struct ifTrue:[^ #pointer ].
- aType == #structIn ifTrue:[^ #pointer ].
- aType == #structOut ifTrue:[^ #pointer ].
- aType == #structInOut ifTrue:[^ #pointer ].
- aType == #unsigned ifTrue:[^ #uint ].
-
- aType == #ATOM ifTrue:[^ #uint16 ].
- aType == #BOOL ifTrue:[^ #int ].
- aType == #BOOLEAN ifTrue:[^ #uint8 ].
- aType == #BYTE ifTrue:[^ #uint8 ].
- aType == #DWORD ifTrue:[^ #uint32 ].
- aType == #HANDLE ifTrue:[^ #pointer ].
- "/ care for 64bit machines
- aType == #SIZE_T ifTrue:[^ ExternalAddress pointerSize == 8 ifTrue:[#uint64] ifFalse:[#uint32]].
-
- (aType isString or:[aType isSymbol]) ifFalse:[
- CType isNil ifTrue:[
- self error:'unknown type'.
- ].
- ^ aType typeSymbol.
- ].
-
- (aType endsWith:'*') ifTrue:[
- ^ #pointer.
- ].
- (aType endsWith:'Pointer') ifTrue:[
- ^ #pointer.
- ].
- ^ aType
-
- "Modified: / 14-06-2007 / 17:21:42 / cg"
-!
-
name:functionNameOrVirtualIndex module:aModuleName returnType:aReturnType argumentTypes:argTypes
name := functionNameOrVirtualIndex.
functionNameOrVirtualIndex isNumber ifTrue:[