diff -r e08f675fe45f -r 4d29d49edd98 ExternalLibraryFunction.st --- 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:[