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