Windows FFI

Todd Fleming todd at flemingcnc.com
Tue Nov 2 23:03:59 PST 2004


Hello. I started toying with Slate yesterday and decided to try adding 
FFI support for Windows. I can now do the following:

[| l f |
  l: (ExternalLibrary newNamed: 'User32').
  f: (l lookup: 'MessageBoxA').
  f argumentsFormat:
  {
    ExternalMethod ArgumentFormat Int.
    ExternalMethod ArgumentFormat Bytes.
    ExternalMethod ArgumentFormat Bytes.
    ExternalMethod ArgumentFormat Int.
  }.
  f callFormat: ExternalMethod CallFormat Std.
  (f applyTo: {0 'Hello from Slate!\0' 'My Dialog\0' 0}).
] do.

Woohoo!

As is, the FFI works with __cdecl functions. I added the ability to call 
__stdcall ones. Here is how you set the calling convention:

   "For the Win32 API"
   f callFormat: ExternalMethod CallFormat Std.

   "For normal C functions; the default"
   f callFormat: ExternalMethod CallFormat C.

I attached the patch to this message. It also includes some (!untested!) 
fixes to windows/directory.c needed to compile. Warning: I added an 
empty readDirectory() because I was too lazy to write a real one.

The patch requires regenerating both the vm and the image.

Todd

-------------- next part --------------
? mobius/vm/platform/windows/Slate.sln
? mobius/vm/platform/windows/Slate.vcproj
Index: lib/extlib.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/lib/extlib.slate,v
retrieving revision 1.2
diff -u -r1.2 extlib.slate
--- lib/extlib.slate	2 Nov 2004 21:35:00 -0000	1.2
+++ lib/extlib.slate	3 Nov 2004 06:43:21 -0000
@@ -13,9 +13,15 @@
   #Bytes -> 4.
 } do: [| :assoc | ExternalMethod ArgumentFormat addImmutableSlot: assoc key valued: assoc value].
 
+ExternalMethod traits ensureNamespace: #CallFormat.
+{ #C -> 0.
+  #Std -> 1.
+} do: [| :assoc | ExternalMethod CallFormat addImmutableSlot: assoc key valued: assoc value].
+
 ExternalMethod addSlot: #library valued: Nil.
 ExternalMethod addSlot: #name valued: Nil.
 ExternalMethod addSlot: #argumentsFormat valued: {}.
+ExternalMethod addSlot: #callFormat valued: ExternalMethod CallFormat C.
 ExternalMethod addSlot: #resultFormat valued: ExternalMethod ArgumentFormat Void.
 
 d@(ExternalLibrary traits) newNamed: libName
@@ -63,5 +69,5 @@
 
 m@(ExternalMethod traits) applyTo: args
 [
-  m library primitiveApply: m handle accepting: m argumentsFormat returning: m resultFormat to: args
+  m library primitiveApply: m handle accepting: m argumentsFormat callFormat: m callFormat returning: m resultFormat to: args
 ].
Index: mobius/vm/ext/extprim.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/ext/extprim.slate,v
retrieving revision 1.2
diff -u -r1.2 extprim.slate
--- mobius/vm/ext/extprim.slate	2 Nov 2004 21:35:00 -0000	1.2
+++ mobius/vm/ext/extprim.slate	3 Nov 2004 06:43:21 -0000
@@ -23,9 +23,9 @@
     ifFalse: [interpreter pushFalse].
 ] `pidginPrimitive.
 
-p at ExternalLibraryTraits primitiveApply: ptr at ByteArrayTraits accepting: argsFormat returning: resultFormat to: args at ArrayTraits
+p at ExternalLibraryTraits primitiveApply: ptr at ByteArrayTraits accepting: argsFormat callFormat: callFormat returning: resultFormat to: args at ArrayTraits
 [
   interpreter stackPush:
-    ('applyExternalLibraryPrimitive((struct ByteArray *) ptr, (struct OopArray *) argsFormat, resultFormat, (struct OopArray *) args)'
+    ('applyExternalLibraryPrimitive((struct ByteArray *) ptr, (struct OopArray *) argsFormat, callFormat, resultFormat, (struct OopArray *) args)'
      directly!ObjectPointer).
 ] `pidginPrimitive.
Index: mobius/vm/platform/extprim.c
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/platform/extprim.c,v
retrieving revision 1.2
diff -u -r1.2 extprim.c
--- mobius/vm/platform/extprim.c	2 Nov 2004 21:35:00 -0000	1.2
+++ mobius/vm/platform/extprim.c	3 Nov 2004 06:43:22 -0000
@@ -7,7 +7,23 @@
 typedef unsigned (* ext_fn4_t) (unsigned, unsigned, unsigned, unsigned);
 typedef unsigned (* ext_fn5_t) (unsigned, unsigned, unsigned, unsigned, unsigned);
 
-ObjectPointer applyExternalLibraryPrimitive (struct ByteArray * fnHandle, struct OopArray * argsFormat, ObjectPointer resultFormat, struct OopArray * argsArr)
+#ifndef _WIN32
+#  define __stdcall
+#endif
+
+typedef unsigned (__stdcall * ext_std_fn0_t) (void);
+typedef unsigned (__stdcall * ext_std_fn1_t) (unsigned);
+typedef unsigned (__stdcall * ext_std_fn2_t) (unsigned, unsigned);
+typedef unsigned (__stdcall * ext_std_fn3_t) (unsigned, unsigned, unsigned);
+typedef unsigned (__stdcall * ext_std_fn4_t) (unsigned, unsigned, unsigned, unsigned);
+typedef unsigned (__stdcall * ext_std_fn5_t) (unsigned, unsigned, unsigned, unsigned, unsigned);
+
+ObjectPointer applyExternalLibraryPrimitive (
+	struct ByteArray * fnHandle, 
+	struct OopArray * argsFormat, 
+	ObjectPointer callFormat,
+	ObjectPointer resultFormat, 
+	struct OopArray * argsArr)
 {
   ObjectPointer * elements;
   ObjectPointer * format;
@@ -49,29 +65,60 @@
     }
   }
 
-  switch(argCount)
+  if(callFormat == CALL_FORMAT_C)
   {
-  case 0:
-    result = (* (ext_fn0_t) fn) ();
-    break;
-  case 1:
-    result = (* (ext_fn1_t) fn) (args [0]);
-    break;
-  case 2:
-    result = (* (ext_fn2_t) fn) (args [0], args [1]);
-    break;
-  case 3:
-    result = (* (ext_fn3_t) fn) (args [0], args [1], args [2]);
-    break;
-  case 4:
-    result = (* (ext_fn4_t) fn) (args [0], args [1], args [2], args [3]);
-    break;
-  case 5:
-    result = (* (ext_fn5_t) fn) (args [0], args [1], args [2], args [3], args [4]);
-    break;
-  default:
-    return CurrentMemory -> NilObject;
+    switch(argCount)
+    {
+    case 0:
+        result = (* (ext_fn0_t) fn) ();
+        break;
+    case 1:
+        result = (* (ext_fn1_t) fn) (args [0]);
+        break;
+    case 2:
+        result = (* (ext_fn2_t) fn) (args [0], args [1]);
+        break;
+    case 3:
+        result = (* (ext_fn3_t) fn) (args [0], args [1], args [2]);
+        break;
+    case 4:
+        result = (* (ext_fn4_t) fn) (args [0], args [1], args [2], args [3]);
+        break;
+    case 5:
+        result = (* (ext_fn5_t) fn) (args [0], args [1], args [2], args [3], args [4]);
+        break;
+    default:
+        return CurrentMemory -> NilObject;
+    }
   }
+  else if(callFormat == CALL_FORMAT_STD)
+  {
+    switch(argCount)
+    {
+    case 0:
+        result = (* (ext_std_fn0_t) fn) ();
+        break;
+    case 1:
+        result = (* (ext_std_fn1_t) fn) (args [0]);
+        break;
+    case 2:
+        result = (* (ext_std_fn2_t) fn) (args [0], args [1]);
+        break;
+    case 3:
+        result = (* (ext_std_fn3_t) fn) (args [0], args [1], args [2]);
+        break;
+    case 4:
+        result = (* (ext_std_fn4_t) fn) (args [0], args [1], args [2], args [3]);
+        break;
+    case 5:
+        result = (* (ext_std_fn5_t) fn) (args [0], args [1], args [2], args [3], args [4]);
+        break;
+    default:
+        return CurrentMemory -> NilObject;
+    }
+  }
+  else
+    return CurrentMemory -> NilObject;
   
   switch (resultFormat)
   {
Index: mobius/vm/platform/includes/extprim.h
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/platform/includes/extprim.h,v
retrieving revision 1.2
diff -u -r1.2 extprim.h
--- mobius/vm/platform/includes/extprim.h	2 Nov 2004 21:35:00 -0000	1.2
+++ mobius/vm/platform/includes/extprim.h	3 Nov 2004 06:43:22 -0000
@@ -17,6 +17,12 @@
   ARG_FORMAT_BYTES = (4 << 1) | 1
 };
 
+enum CallFormat
+{
+  CALL_FORMAT_C = (0 << 1) | 1,
+  CALL_FORMAT_STD = (1 << 1) | 1,
+};
+
 struct ByteArray;
 struct OopArray;
 
@@ -30,6 +36,7 @@
 					  struct ByteArray *ptr);
 extern ObjectPointer applyExternalLibraryPrimitive(struct ByteArray *ptr,
                                                   struct OopArray *argsFormat,
+                                                  ObjectPointer callFormat,
                                                   ObjectPointer resultFormat,
 						  struct OopArray *args);
 
Index: mobius/vm/platform/windows/directory.c
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/platform/windows/directory.c,v
retrieving revision 1.3
diff -u -r1.3 directory.c
--- mobius/vm/platform/windows/directory.c	26 Sep 2004 02:02:49 -0000	1.3
+++ mobius/vm/platform/windows/directory.c	3 Nov 2004 06:43:22 -0000
@@ -1,9 +1,11 @@
 #include <windows.h>
+#include <errno.h>
 #include "directory.h"
 #include "file.h"
-#include "vm.h"
+#include "slatevm.h"
 
 static HANDLE dirs [SLATE_FILES_MAXIMUM];
+#define BYTEARRAY_LEN(x)	(PSObject_payloadSize((struct Object *) (x)))
 
 void initDirectoryModule ()
 {
@@ -24,15 +26,17 @@
 	return -1;
 }
 
-void
+int
 closeDirectory (int dir)
 {
 	if (dirs [dir] != 0)
 	{
 		CloseHandle(dirs [dir]);
-
 		dirs [dir] = 0;
+		return 0;
 	}
+	else
+		return -EINVAL;
 }
 
 int
@@ -94,22 +98,9 @@
 	return -1;
 }
 
-struct ByteArray *
-getCurrentDirectory ()
+int getCurrentDirectory(struct ByteArray *wdBuffer) 
 {
-	struct ByteArray * result;
-	char pathString [SLATE_PATH_NAME_LENGTH];
-
-	DWORD pathLength = GetCurrentDirectory (sizeof(pathString), pathString);
-
-	if (pathLength < 0)
-		return Nil;
-
-	// TODO write a pidgin primitive for this
-	result = PSObjectHeap_newByteArray_sized_ (CurrentMemory, ByteArrayProto, pathLength);
-	//initializeByteArray (pathString, pathLength, result);
-
-	return result;
+	return GetCurrentDirectory(BYTEARRAY_LEN(wdBuffer), wdBuffer->elements);
 }
 
 int
@@ -122,4 +113,9 @@
 		return -1;
 
 	return SetCurrentDirectory (pathString);
+}
+
+int readDirectory(int dirHandle, struct ByteArray *entNameBuffer)
+{
+	return -1;
 }


More information about the Slate mailing list