--- a/ExternalLibraryFunction.st Tue Apr 30 13:00:22 2019 +0200
+++ b/ExternalLibraryFunction.st Tue Apr 30 18:16:15 2019 +0200
@@ -21,7 +21,7 @@
CALLTYPE_UNIX64 CALLTYPE_V8 CALLTYPE_V9 DLLPATH DllMapping
FLAG_ASYNC FLAG_NONVIRTUAL FLAG_OBJECTIVEC FLAG_RETVAL_IS_CONST
FLAG_UNLIMITEDSTACK FLAG_VIRTUAL LastModuleHandleHolder
- LastModuleHandleName Verbose FLAG_RETVAL_MUST_FREE'
+ LastModuleHandleName Verbose FLAG_RETVAL_MUST_FREE TypeMap'
poolDictionaries:''
category:'System-Support'
!
@@ -548,12 +548,18 @@
ffiTypeSymbolForType:aType
"map aType to one of the ffi-supported ones:
- sint8, sint16, sint32, sint64
- uint8, uint16, uint32, uint64
- long ulong int uint
- bool float double void pointer handle
+ sint8, sint16, sint32, sint64
+ uint8, uint16, uint32, uint64
+ long ulong int uint
+ bool float double void pointer handle
"
+ |mappedType|
+
+ TypeMap notNil ifTrue:[
+ (mappedType := TypeMap at:aType ifAbsent:nil) notNil ifTrue:[^ mappedType].
+ ].
+
aType == #sint8 ifTrue:[^ aType ].
aType == #sint16 ifTrue:[^ aType ].
aType == #sint32 ifTrue:[^ aType ].
@@ -599,13 +605,18 @@
aType == #unsignedChar ifTrue:[^ #uint8 ].
"/ windefs
- aType == #dword ifTrue:[^ #uint32 ].
- aType == #sdword ifTrue:[^ #sint32 ].
- aType == #word ifTrue:[^ #uint16 ].
- aType == #sword ifTrue:[^ #sint16 ].
- aType == #handle ifTrue:[^ #pointer ].
+ (aType == #dword or:[aType == #DWORD]) ifTrue:[^ #uint32 ].
+ (aType == #sdword or:[aType == #SDWORD]) ifTrue:[^ #sint32 ].
+ (aType == #word or:[aType == #WORD]) ifTrue:[^ #uint16 ].
+ (aType == #sword or:[aType == #SWORD]) ifTrue:[^ #sint16 ].
+ (aType == #dwordlong or:[aType == #DWORDLONG]) ifTrue:[^ #uint64 ].
+ (aType == #dword32 or:[aType == #DWORD32]) ifTrue:[^ #uint32 ].
+ (aType == #dword64 or:[aType == #DWORD64]) ifTrue:[^ #uint64 ].
+ (aType == #handle or:[aType == #HANDLE]) ifTrue:[^ #pointer ].
+ (aType == #hbitmap or:[aType == #HBITMAP]) ifTrue:[^ #pointer ].
+ (aType == #hdc or:[aType == #HDC]) ifTrue:[^ #pointer ].
+ (aType == #hfile or:[aType == #HFILE]) ifTrue:[^ #int ].
aType == #lpstr ifTrue:[^ #charPointer ].
- "/ aType == #hresult ifTrue:[^ #uint32 ]. -- keep this; it is translated later (in invoke)
aType == #boolean ifTrue:[^ #bool ].
"/ care for 64bit machines
aType == #ulongReturn ifTrue:[^ ExternalBytes sizeofPointer == 8 ifTrue:[#uint64] ifFalse:[#uint32]].
@@ -620,9 +631,9 @@
aType == #BOOL ifTrue:[^ #int ].
aType == #BOOLEAN ifTrue:[^ #uint8 ].
aType == #BYTE ifTrue:[^ #uint8 ].
- aType == #DWORD ifTrue:[^ #uint32 ].
- aType == #HANDLE ifTrue:[^ #pointer ].
- aType == #HRESULT ifTrue:[^ #hresult ].
+ (aType == #hresult or:[aType == #HRESULT]) ifTrue:[^ #hresult ].
+ (aType == #lparam or:[aType == #LPARAM]) ifTrue:[^ #pointer ].
+ (aType == #wparam or:[aType == #WPARAM]) ifTrue:[^ #pointer ].
aType == #LPWSTR ifTrue:[^ #wcharPointer].
aType == #BSTR ifTrue:[^ #wcharPointer].
@@ -631,26 +642,45 @@
aType == #SIZE_T ifTrue:[^ ExternalBytes sizeofPointer == 8 ifTrue:[#uint64] ifFalse:[#uint32]].
(aType isString or:[aType isSymbol]) ifFalse:[
- aType isArray ifTrue:[
- ^ aType collect:[:each | self ffiTypeSymbolForType:each]
- ].
-
- CType isNil ifTrue:[
- self error:'unknown type'.
- ].
- "/ assume it is a ctype
- ^ aType typeSymbol.
+ aType isArray ifTrue:[
+ ^ aType collect:[:each | self ffiTypeSymbolForType:each]
+ ].
+
+ CType isNil ifTrue:[
+ self error:'unknown type'.
+ ].
+ "/ assume it is a ctype
+ ^ aType typeSymbol.
].
(aType endsWith:'*') ifTrue:[
- ^ #pointer.
+ ^ #pointer.
].
(aType endsWith:'Pointer') ifTrue:[
- ^ #pointer.
+ ^ #pointer.
].
^ aType
"Modified: / 04-08-2017 / 10:36:37 / cg"
+ "Modified: / 30-04-2019 / 18:13:25 / Claus Gittinger"
+!
+
+mapType:aTypeSymbol toFFI:mappedType
+ "additional user defined type map:
+ eg. self mapType:#INT8 toFFI:#int8
+ allows use of INT8 in external function api declarations.
+ mappedType should be one of the ffi-supported ones:
+ sint8, sint16, sint32, sint64
+ uint8, uint16, uint32, uint64
+ long ulong int uint
+ bool float double void pointer handle"
+
+ TypeMap isNil ifTrue:[
+ TypeMap := Dictionary new.
+ ].
+ TypeMap at:aTypeSymbol put:mappedType
+
+ "Created: / 30-04-2019 / 18:15:06 / Claus Gittinger"
! !
!ExternalLibraryFunction methodsFor:'accessing'!