Win32 version ported to gcc, eliminate MSVC hacks, add gcc hacks

Makefile

@@ -4,7 +4,15 @@ DEFAULT_LIBS = -lm
 
 STRIP = strip
 
-OBJS = native/arithmetic.o native/array.o native/bignum.o \
+obj-$(UNIX) += native/unix/file.o native/unix/io.o native/unix/socket.o \
+	native/unix/signal.o native/unix/read.o native/unix/write.o \
+	native/unix/ffi.o native/unix/run.o
+
+obj-$(WIN32) += native/win32/ffi.o native/win32/file.o native/win32/io.o \
+	native/win32/misc.o native/win32/read.o native/win32/write.o \
+	native/win32/run.o
+
+obj-y += native/arithmetic.o native/array.o native/bignum.o \
 	native/s48_bignum.o \
 	native/complex.o native/cons.o native/error.o \
 	native/factor.o native/fixnum.o \
@@ -17,13 +25,6 @@ OBJS = native/arithmetic.o native/array.o native/bignum.o \
 	native/string.o native/types.o native/vector.o \
 	native/word.o native/compiler.o \
 	native/ffi.o native/boolean.o \
-	native/unix/file.o \
-	native/unix/io.o \
-	native/unix/socket.o \
-	native/unix/signal.o \
-	native/unix/read.o \
-	native/unix/write.o \
-	native/unix/ffi.o \
 	native/debug.o \
 	native/hashtable.o
 
@@ -35,6 +36,7 @@ default:
 	@echo "linux"
 	@echo "macosx"
 	@echo "solaris"
+	@echo "windows"
 	@echo ""
 	@echo "Also, you might want to set the SITE_CFLAGS environment"
 	@echo "variable to enable some CPU-specific optimizations; this"
@@ -45,34 +47,45 @@ default:
 bsd:
 	$(MAKE) f \
 		CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic -pthread" \
-		LIBS="$(DEFAULT_LIBS)"
+		LIBS="$(DEFAULT_LIBS)" \
+		UNIX=y
 
 bsd-nopthread:
 	$(MAKE) f \
 		CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic" \
-		LIBS="$(DEFAULT_LIBS)"
+		LIBS="$(DEFAULT_LIBS)" \
+		UNIX=y
 
 macosx:
 	$(MAKE) f \
 		CFLAGS="$(DEFAULT_CFLAGS) -DFFI" \
-		LIBS="$(DEFAULT_LIBS)"
+		LIBS="$(DEFAULT_LIBS)" \
+		UNIX=y
 
 linux:
 	$(MAKE) f \
 		CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic" \
-		LIBS="$(DEFAULT_LIBS) -ldl"
+		LIBS="$(DEFAULT_LIBS) -ldl" \
+		UNIX=y
 
 solaris:
 	$(MAKE) f \
 		CFLAGS="$(DEFAULT_CFLAGS)" \
-		LIBS="$(DEFAULT_LIBS) -lsocket -lnsl -lm"
+		LIBS="$(DEFAULT_LIBS) -lsocket -lnsl -lm" \
+		UNIX=y
 
-f: $(OBJS)
+windows:
-	$(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)
+	$(MAKE) f \
+		CFLAGS="$(DEFAULT_CFLAGS) -DFFI -DWIN32" \
+		LIBS="$(DEFAULT_LIBS)" \
+		WIN32=y
+
+f: $(obj-y)
+	$(CC) $(LIBS) $(CFLAGS) -o $@ $(obj-y)
 	$(STRIP) $@
 
 clean:
-	rm -f $(OBJS)
+	rm -f $(obj-y)
 
 .c.o:
 	$(CC) -c $(CFLAGS) -o $@ $<

library/dlists.factor

@@ -32,7 +32,7 @@ C: dlist-node
 
 : (dlist-each) ( quot dnode -- )
     [
-        [ dlist-node-data swap [ call ] keep ] keep 
+        [ dlist-node-data swap call ] 2keep 
         dlist-node-next (dlist-each)
     ] [
         drop

native/factor.c

@@ -45,7 +45,7 @@ int main(int argc, char** argv)
 
 	userenv[ARGS_ENV] = args;
 
-	run();
+	platform_run();
 
 	return 0;
 }

native/factor.h

@@ -31,6 +31,7 @@ DLLEXPORT CELL cs;
 #include <fcntl.h>
 #include <limits.h>
 #include <math.h>
+#include <stdbool.h>
 #include <setjmp.h>
 #include <signal.h>
 #include <stdio.h>
@@ -57,33 +58,11 @@ DLLEXPORT CELL cs;
 	#include <netdb.h>
 #endif
 
-#if defined(_MSC_VER)
-	#pragma warning(disable:4312)
-	#pragma warning(disable:4311)
-	typedef enum { false, true } _Bool;
-	typedef enum _Bool bool;
-	typedef unsigned char uint8_t;
-	typedef unsigned short uint16_t;
-	typedef unsigned int uint32_t;
-	typedef unsigned __int64 uint64_t;
-	typedef signed char int8_t;
-	typedef signed short int16_t;
-	typedef signed int int32_t;
-	typedef signed __int64 int64_t;
-	#define snprintf _snprintf
-#else
-	#include <stdbool.h>
-#endif
-
 #if defined(FFI) && !defined(WIN32)
 #include <dlfcn.h>
 #endif /* FFI */
 
-#if defined(_MSC_VER)
+#define INLINE inline static
-	#define INLINE static __inline
-#else
-	#define INLINE inline static
-#endif
 
 #define FIXNUM_MAX (LONG_MAX >> TAG_BITS)
 #define FIXNUM_MIN (LONG_MIN >> TAG_BITS)
@@ -101,7 +80,7 @@ DLLEXPORT CELL cs;
 typedef unsigned char BYTE;
 
 /* Memory areas */
-#define DEFAULT_ARENA (8 * 1024 * 1024)
+#define DEFAULT_ARENA (16 * 1024 * 1024)
 #define COMPILE_ZONE_SIZE (8 * 1024 * 1024)
 #define STACK_SIZE (2 * 1024 * 1024)
 

native/run.c

@@ -21,12 +21,9 @@ void run(void)
 	/* Error handling. */
 #ifdef WIN32
 	setjmp(toplevel);
-	__try
-	{
 #else
 	sigsetjmp(toplevel, 1);
 #endif
-
 	if(thrown_error != F)
 	{
 		if(thrown_keep_stacks)
@@ -61,15 +58,6 @@ void run(void)
 		else
 			dpush(next);
 	}
-
-#ifdef WIN32
-	}
-	__except (GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ?
-		EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH)
-	{
-		signal_error(SIGSEGV);
-	}
-#endif
 }
 
 /* XT of deferred words */

native/run.h

@@ -92,6 +92,7 @@ INLINE void call(CELL quot)
 void clear_environment(void);
 
 void run(void);
+void platform_run(void);
 void undefined(F_WORD* word);
 void docol(F_WORD* word);
 void dosym(F_WORD* word);

native/signal.h

@@ -5,4 +5,4 @@ void call_profiling_step(int signal, siginfo_t* siginfo, void* uap);
 void init_signals(void);
 #endif
 
-void primitive_call_profiling(void);
+void primitive_call_profiling(F_WORD *);

native/socket.h

@@ -1,9 +1,9 @@
 void init_sockaddr(struct sockaddr_in *name,
 	const char *hostname, uint16_t port);
 int make_client_socket(const char* hostname, uint16_t port);
-void primitive_client_socket(void);
+void primitive_client_socket(F_WORD *);
 int make_server_socket(uint16_t port);
-void primitive_server_socket(void);
+void primitive_server_socket(F_WORD *);
-void primitive_add_accept_io_task(void);
+void primitive_add_accept_io_task(F_WORD *);
 CELL accept_connection(F_PORT* p);
-void primitive_accept_fd(void);
+void primitive_accept_fd(F_WORD *);

native/unix/run.c

@@ -0,0 +1,7 @@
+#include "../factor.h"
+
+void platform_run()
+{
+	run();
+}
+

native/unix/signal.c

@@ -60,7 +60,7 @@ void init_signals(void)
 	sigaction(SIGQUIT,&dump_sigaction,NULL);
 }
 
-void primitive_call_profiling(void)
+void primitive_call_profiling(F_WORD *word)
 {
 	CELL d = dpop();
 	if(d == F)

native/unix/socket.c

@@ -42,7 +42,7 @@ int make_client_socket(const char* hostname, uint16_t port)
 	return sock;
 }
 
-void primitive_client_socket(void)
+void primitive_client_socket(F_WORD *word)
 {
 	uint16_t p = (uint16_t)to_fixnum(dpop());
 	char* host;
@@ -94,14 +94,14 @@ int make_server_socket(uint16_t port)
 	return sock;
 }
 
-void primitive_server_socket(void)
+void primitive_server_socket(F_WORD *word)
 {
 	uint16_t p = (uint16_t)to_fixnum(dpop());
 	maybe_garbage_collection();
 	dpush(tag_object(port(PORT_SPECIAL,make_server_socket(p))));
 }
 
-void primitive_add_accept_io_task(void)
+void primitive_add_accept_io_task(F_WORD *word)
 {
 	CELL callback, port;
 	maybe_garbage_collection();
@@ -133,7 +133,7 @@ CELL accept_connection(F_PORT* p)
 	return true;
 }
 
-void primitive_accept_fd(void)
+void primitive_accept_fd(F_WORD *word)
 {
 	F_PORT* p;
 	maybe_garbage_collection();

native/win32/misc.c

@@ -4,8 +4,8 @@
  * Various stubs for functions not currently implemented in the Windows port.
  */
 
-void init_signals(void)
+void init_signals()
-{
+{	
 }
 
 void primitive_accept_fd(F_WORD *word)
@@ -32,3 +32,4 @@ void primitive_call_profiling(F_WORD *word)
 {
 	undefined(word);
 }
+

native/win32/run.c

@@ -0,0 +1,30 @@
+#include "../factor.h"
+
+/* SEH support. Proceed with caution. */
+typedef long exception_handler_t(
+	void *rec, void *frame, void *context, void *dispatch);
+
+typedef struct exception_record {
+	struct exception_record *next_handler;
+	void *handler_func;
+} exception_record_t;
+
+void seh_call(void (*func)(), exception_handler_t *handler)
+{
+	exception_record_t record;
+	asm("mov %%fs:0, %0" : "=r" (record.next_handler));
+	asm("mov %0, %%fs:0" : : "r" (&record));
+	record.handler_func = handler;
+	func();
+	asm("mov %0, %%fs:0" : "=r" (record.next_handler));
+}
+
+static long exception_handler(void *rec, void *frame, void *ctx, void *dispatch)
+{
+	signal_error(SIGSEGV);
+}
+
+void platform_run ()
+{
+	seh_call(run, exception_handler);
+}