Port FFI to win32

diff --git a/Makefile b/Makefile
index 79ca2d024cb5b912d3808017403c7412c4a5915c..fa084ae0e59547896a38440b67966767a438080c 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -22,7 +22,8 @@ OBJS = native/arithmetic.o native/array.o native/bignum.o \
        native/unix/socket.o \
        native/unix/signal.o \
        native/unix/read.o \
-       native/unix/write.o
+       native/unix/write.o \
+       native/unix/ffi.o
 
 default:
        @echo "Run 'make' with one of the following parameters:"

diff --git a/factor.vcproj b/factor.vcproj
index b45205b0a810dac7309ebe6120e05b7298df698b..0f86356cea11004ff2b802f1e56c21d49a6d8698 100644 (file)
--- a/factor.vcproj
+++ b/factor.vcproj
@@ -19,7 +19,7 @@
                        <Tool
                                Name="VCCLCompilerTool"
                                Optimization="0"
-                               PreprocessorDefinitions="WIN32;_DEBUG;_CONSOLE"
+                               PreprocessorDefinitions="FFI;WIN32"
                                MinimalRebuild="TRUE"
                                BasicRuntimeChecks="3"
                                RuntimeLibrary="5"
@@ -70,7 +70,7 @@
                                GlobalOptimizations="TRUE"
                                InlineFunctionExpansion="1"
                                OmitFramePointers="TRUE"
-                               PreprocessorDefinitions="WIN32;NDEBUG;_CONSOLE"
+                               PreprocessorDefinitions="FFI;WIN32"
                                StringPooling="TRUE"
                                RuntimeLibrary="4"
                                EnableFunctionLevelLinking="TRUE"
@@ -204,6 +204,21 @@
                        <Filter
                                Name="win32"
                                Filter="">
+                               <File
+                                       RelativePath=".\native\win32\ffi.c">
+                                       <FileConfiguration
+                                               Name="Debug|Win32">
+                                               <Tool
+                                                       Name="VCCLCompilerTool"
+                                                       ObjectFile="$(IntDir)/$(InputName)2.obj"/>
+                                       </FileConfiguration>
+                                       <FileConfiguration
+                                               Name="Release|Win32">
+                                               <Tool
+                                                       Name="VCCLCompilerTool"
+                                                       ObjectFile="$(IntDir)/$(InputName)2.obj"/>
+                                       </FileConfiguration>
+                               </File>
                                <File
                                        RelativePath="native\win32\file.c">
                                </File>
@@ -235,6 +250,23 @@
                        <Filter
                                Name="unix"
                                Filter="">
+                               <File
+                                       RelativePath=".\native\unix\ffi.c">
+                                       <FileConfiguration
+                                               Name="Debug|Win32"
+                                               ExcludedFromBuild="TRUE">
+                                               <Tool
+                                                       Name="VCCLCompilerTool"
+                                                       ObjectFile="$(IntDir)/$(InputName)1.obj"/>
+                                       </FileConfiguration>
+                                       <FileConfiguration
+                                               Name="Release|Win32"
+                                               ExcludedFromBuild="TRUE">
+                                               <Tool
+                                                       Name="VCCLCompilerTool"
+                                                       ObjectFile="$(IntDir)/$(InputName)1.obj"/>
+                                       </FileConfiguration>
+                               </File>
                                <File
                                        RelativePath="native\unix\file.c">
                                        <FileConfiguration

diff --git a/native/bignum.h b/native/bignum.h
index 90ac355062db0180501bb09f994971491a1b42ed..f54ce1c6c3f8385adcf734fe1d6e920e5e7c7df2 100644 (file)
--- a/native/bignum.h
+++ b/native/bignum.h
@@ -11,7 +11,7 @@ INLINE F_ARRAY* untag_bignum(CELL tagged)
 F_FIXNUM to_integer(CELL x);
 void box_integer(F_FIXNUM integer);
 void box_cell(CELL cell);
-F_FIXNUM unbox_integer(void);
+DLLEXPORT F_FIXNUM unbox_integer(void);
 CELL unbox_cell(void);
 F_ARRAY* to_bignum(CELL tagged);
 void primitive_to_bignum(void);

diff --git a/native/factor.h b/native/factor.h
index f6308835cdff49d6db09ffafab6dc982c5cfff7f..ffe2776044e130151ed946d48be4fdc885e5c225 100644 (file)
--- a/native/factor.h
+++ b/native/factor.h
@@ -75,7 +75,7 @@ CELL cs;
        #include <stdbool.h>
 #endif
 
-#ifdef FFI
+#if defined(FFI) && !defined(WIN32)
 #include <dlfcn.h>
 #endif /* FFI */
 
@@ -122,9 +122,9 @@ typedef unsigned char BYTE;
 #include "float.h"
 #include "complex.h"
 #include "arithmetic.h"
+#include "string.h"
 #include "misc.h"
 #include "relocate.h"
-#include "string.h"
 #include "sbuf.h"
 #include "port.h"
 #include "io.h"

diff --git a/native/ffi.c b/native/ffi.c
index 628faea611c4f0eed0d6f7ca78f8bd891c15e9e2..aa97cdf0e67d29532aba56fa37c31d983e24c5e2 100644 (file)
--- a/native/ffi.c
+++ b/native/ffi.c
@@ -9,86 +9,6 @@ DLL* untag_dll(CELL tagged)
        return (DLL*)UNTAG(tagged);
 }
 
-void primitive_dlopen(void)
-{
-#ifdef FFI
-       char* path;
-       void* dllptr;
-       DLL* dll;
-       
-       maybe_garbage_collection();
-       
-       path = unbox_c_string();
-       dllptr = dlopen(path,RTLD_LAZY);
-
-       if(dllptr == NULL)
-       {
-               general_error(ERROR_FFI,tag_object(
-                       from_c_string(dlerror())));
-       }
-
-       dll = allot_object(DLL_TYPE,sizeof(DLL));
-       dll->dll = dllptr;
-       dpush(tag_object(dll));
-#else
-       general_error(ERROR_FFI_DISABLED,F);
-#endif
-}
-
-void primitive_dlsym(void)
-{
-#ifdef FFI
-       DLL* dll = untag_dll(dpop());
-       void* sym = dlsym(dll->dll,unbox_c_string());
-       if(sym == NULL)
-       {
-               general_error(ERROR_FFI,tag_object(
-                       from_c_string(dlerror())));
-       }
-       dpush(tag_cell((CELL)sym));
-#else
-       general_error(ERROR_FFI_DISABLED,F);
-#endif
-}
-
-void primitive_dlsym_self(void)
-{
-#if defined(FFI)
-       void* sym = dlsym(NULL,unbox_c_string());
-       if(sym == NULL)
-       {
-               general_error(ERROR_FFI,tag_object(
-                       from_c_string(dlerror())));
-       }
-       dpush(tag_cell((CELL)sym));
-#elif defined(WIN32)
-       void *sym = GetProcAddress(GetModuleHandle(NULL), unbox_c_string());
-       if(sym == NULL)
-       {
-               general_error(ERROR_FFI, tag_object(
-                       from_c_string("bad symbol")));
-       }
-       dpush(tag_cell((CELL)sym));
-#else
-       general_error(ERROR_FFI_DISABLED,F);
-#endif
-}
-
-void primitive_dlclose(void)
-{
-#ifdef FFI
-       DLL* dll = untag_dll(dpop());
-       if(dlclose(dll->dll) == -1)
-       {
-               general_error(ERROR_FFI,tag_object(
-                       from_c_string(dlerror())));
-       }
-       dll->dll = NULL;
-#else
-       general_error(ERROR_FFI_DISABLED,F);
-#endif
-}
-
 #ifdef FFI
 CELL unbox_alien(void)
 {

diff --git a/native/misc.c b/native/misc.c
index ed21986f06c930b6ca7714d969f4e0aea04cc16d..cc64f52ba74f348941a0218af789f8237e10ef53 100644 (file)
--- a/native/misc.c
+++ b/native/misc.c
@@ -57,3 +57,26 @@ void primitive_random_int(void)
        maybe_garbage_collection();
        dpush(tag_object(s48_long_to_bignum(rand())));
 }
+
+#ifdef WIN32
+F_STRING *last_error()
+{
+       char *buffer;
+       F_STRING *error;
+       DWORD dw = GetLastError();
+       
+       FormatMessage(
+               FORMAT_MESSAGE_ALLOCATE_BUFFER |
+               FORMAT_MESSAGE_FROM_SYSTEM,
+               NULL,
+               dw,
+               MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+               (LPTSTR) &buffer,
+               0, NULL);
+
+       error = from_c_string(buffer);
+       LocalFree(buffer);
+
+       return error;
+}
+#endif

diff --git a/native/misc.h b/native/misc.h
index a0035d013d44dd1d691fddd24936e52fdf4c68f7..af9ee2c461d87bd0438588d1a3a80ea5023919a2 100644 (file)
--- a/native/misc.h
+++ b/native/misc.h
@@ -5,3 +5,7 @@ int64_t current_millis(void);
 void primitive_millis(void);
 void primitive_init_random(void);
 void primitive_random_int(void);
+#ifdef WIN32
+F_STRING *last_error();
+#endif
+

diff --git a/native/port.c b/native/port.c
index 9297a67acef65b7cf1a035a55aa7c960b3b29acd..0c8d4813e259fe8a97f68d485903682e81109c37 100644 (file)
--- a/native/port.c
+++ b/native/port.c
@@ -67,24 +67,9 @@ void collect_port(F_PORT* port)
 #ifdef WIN32
 CELL make_io_error(const char* func)
 {
-       char *buffer;
        F_STRING *function = from_c_string(func);
-       F_STRING *error;
-       DWORD dw = GetLastError();
-       
-       FormatMessage(
-               FORMAT_MESSAGE_ALLOCATE_BUFFER |
-               FORMAT_MESSAGE_FROM_SYSTEM,
-               NULL,
-               dw,
-               MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
-               (LPTSTR) &buffer,
-               0, NULL);
 
-       error = from_c_string(buffer);
-       LocalFree(buffer);
-
-       return cons(tag_object(function),cons(tag_object(error),F));
+       return cons(tag_object(function),cons(tag_object(last_error()),F));
 }
 #else
 CELL make_io_error(const char* func)

diff --git a/native/unix/ffi.c b/native/unix/ffi.c
new file mode 100644 (file)
index 0000000..9915b8e
--- /dev/null
+++ b/native/unix/ffi.c
@@ -0,0 +1,73 @@
+#include "../factor.h"
+
+void primitive_dlopen(void)
+{
+#ifdef FFI
+       char* path;
+       void* dllptr;
+       DLL* dll;
+       
+       maybe_garbage_collection();
+       
+       path = unbox_c_string();
+       dllptr = dlopen(path,RTLD_LAZY);
+
+       if(dllptr == NULL)
+       {
+               general_error(ERROR_FFI,tag_object(
+                       from_c_string(dlerror())));
+       }
+
+       dll = allot_object(DLL_TYPE,sizeof(DLL));
+       dll->dll = dllptr;
+       dpush(tag_object(dll));
+#else
+       general_error(ERROR_FFI_DISABLED,F);
+#endif
+}
+
+void primitive_dlsym(void)
+{
+#ifdef FFI
+       DLL* dll = untag_dll(dpop());
+       void* sym = dlsym(dll->dll,unbox_c_string());
+       if(sym == NULL)
+       {
+               general_error(ERROR_FFI,tag_object(
+                       from_c_string(dlerror())));
+       }
+       dpush(tag_cell((CELL)sym));
+#else
+       general_error(ERROR_FFI_DISABLED,F);
+#endif
+}
+
+void primitive_dlsym_self(void)
+{
+#if defined(FFI)
+       void* sym = dlsym(NULL,unbox_c_string());
+       if(sym == NULL)
+       {
+               general_error(ERROR_FFI,tag_object(
+                       from_c_string(dlerror())));
+       }
+       dpush(tag_cell((CELL)sym));
+#else
+       general_error(ERROR_FFI_DISABLED,F);
+#endif
+}
+
+void primitive_dlclose(void)
+{
+#ifdef FFI
+       DLL* dll = untag_dll(dpop());
+       if(dlclose(dll->dll) == -1)
+       {
+               general_error(ERROR_FFI,tag_object(
+                       from_c_string(dlerror())));
+       }
+       dll->dll = NULL;
+#else
+       general_error(ERROR_FFI_DISABLED,F);
+#endif
+}

diff --git a/native/win32/ffi.c b/native/win32/ffi.c
new file mode 100644 (file)
index 0000000..3adf154
--- /dev/null
+++ b/native/win32/ffi.c
@@ -0,0 +1,66 @@
+#include "../factor.h"
+
+void primitive_dlopen (void)
+{
+#ifdef FFI
+       char *path;
+       HMODULE module;
+       DLL *dll;
+
+       maybe_garbage_collection();
+
+       path = unbox_c_string();
+       module = LoadLibrary(path);
+
+       if (!module)
+               general_error(ERROR_FFI, tag_object(last_error()));
+
+       dll = allot_object(DLL_TYPE, sizeof(DLL));
+       dll->dll = module;
+       dpush(tag_object(dll));
+#else
+       general_error(ERROR_FFI_DISABLED, F);
+#endif
+}
+
+void primitive_dlsym (void)
+{
+#ifdef FFI
+       DLL *dll = untag_dll(dpop());
+       void *sym = GetProcAddress((HMODULE)dll->dll, unbox_c_string());
+
+
+       if (!sym)
+               general_error(ERROR_FFI, tag_object(last_error()));
+
+       dpush(tag_cell((CELL)sym));
+#else
+       general_error(ERROR_FFI_DISABLED, F);
+#endif
+}
+
+void primitive_dlclose (void)
+{
+#ifdef FFI
+       DLL *dll = untag_dll(dpop());
+       FreeLibrary((HMODULE)dll->dll);
+       dll->dll = NULL;
+#else
+       general_error(ERROR_FFI_DISABLED, F);
+#endif
+}
+
+void primitive_dlsym_self (void)
+{
+#ifdef FFI
+       void *sym = GetProcAddress(GetModuleHandle(NULL), unbox_c_string());
+
+       if(sym == NULL)
+       {
+               general_error(ERROR_FFI, tag_object(last_error()));
+       }
+       dpush(tag_cell((CELL)sym));
+#else
+       general_error(ERROR_FFI_DISABLED, F);
+#endif
+}

diff --git a/native/win32/io.c b/native/win32/io.c
index 8ff58cb90de319731b0b29ebe53bbb7d5f5b3c0d..53e034bdabaca383b392cd9047511630b99e9de8 100644 (file)
--- a/native/win32/io.c
+++ b/native/win32/io.c
@@ -17,6 +17,7 @@ void primitive_add_copy_io_task (void)
 void primitive_close (void)
 {
        F_PORT *port = untag_port(dpop());
+
        CloseHandle((HANDLE)port->fd);
        port->closed = true;
 }