ExternalLibraryFunction.st
changeset 24097 fe2d568b25c9
parent 24078 13363abcd11f
child 24098 25db884de25a
--- 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'!