Port FFI to win32

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:"

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

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);

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"

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)
 {

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

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
+

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);
+	return cons(tag_object(function),cons(tag_object(last_error()),F));
-	LocalFree(buffer);
-
-	return cons(tag_object(function),cons(tag_object(error),F));
 }
 #else
 CELL make_io_error(const char* func)

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
+}

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
+}

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;
 }