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

diff --git a/Makefile b/Makefile
index 76102d6865312c2bfa07ccceffe6a3bc6d9e088b..73c990e0063d93aa69d77249f2f5314f5b7d8a92 100644 (file)
--- a/Makefile
+++ b/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
+
+windows:
+       $(MAKE) f \
+               CFLAGS="$(DEFAULT_CFLAGS) -DFFI -DWIN32" \
+               LIBS="$(DEFAULT_LIBS)" \
+               WIN32=y
 
-f: $(OBJS)
-       $(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)
+f: $(obj-y)
+       $(CC) $(LIBS) $(CFLAGS) -o $@ $(obj-y)
        $(STRIP) $@
 
 clean:
-       rm -f $(OBJS)
+       rm -f $(obj-y)
 
 .c.o:
        $(CC) -c $(CFLAGS) -o $@ $<

diff --git a/library/dlists.factor b/library/dlists.factor
index b147b98811b109860d1c1473818d64549c387e24..71a8f4699179d97afe448ce4935aaeec410d5983 100644 (file)
--- a/library/dlists.factor
+++ b/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

diff --git a/native/factor.c b/native/factor.c
index e1aa5bb71e022bb58c23b751aeb92ebe0f16387b..57b88a9de3013a879b127aa9e14b0b9effb152e9 100644 (file)
--- a/native/factor.c
+++ b/native/factor.c
@@ -45,7 +45,7 @@ int main(int argc, char** argv)
 
        userenv[ARGS_ENV] = args;
 
-       run();
+       platform_run();
 
        return 0;
 }

diff --git a/native/factor.h b/native/factor.h
index d0749dc2be236fb119308bb64224cf8c5dbe07fe..c880678c6409398d3bc4ab4775213e3cd1082386 100644 (file)
--- a/native/factor.h
+++ b/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 static __inline
-#else
-       #define INLINE inline static
-#endif
+#define INLINE inline static
 
 #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)
 

diff --git a/native/run.c b/native/run.c
index f6524d90499c5081ac340cbffa6ab88129f991ff..c82e525c38e459aabaf034c0c94b1983eca94aab 100644 (file)
--- a/native/run.c
+++ b/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 */

diff --git a/native/run.h b/native/run.h
index f98220b664551fa1d41ddb1330be3587ea3ad927..7331bf5f68f06a199f1977d879302e462f6cd8f3 100644 (file)
--- a/native/run.h
+++ b/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);

diff --git a/native/signal.h b/native/signal.h
index 086698f9bafdbc6ad203403696d63681bb6a639b..9cbf178d3571985a38776dfc6214b72881b88c12 100644 (file)
--- a/native/signal.h
+++ b/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 *);

diff --git a/native/socket.h b/native/socket.h
index b2b75b98c1767d4221c9e61365a72b23605c1a29..da25f9fc54a6dfd5fb21ae7df2eff93b7e34edb4 100644 (file)
--- a/native/socket.h
+++ b/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_add_accept_io_task(void);
+void primitive_server_socket(F_WORD *);
+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 *);

diff --git a/native/unix/run.c b/native/unix/run.c
new file mode 100644 (file)
index 0000000..47b44c8
--- /dev/null
+++ b/native/unix/run.c
@@ -0,0 +1,7 @@
+#include "../factor.h"
+
+void platform_run()
+{
+       run();
+}
+

diff --git a/native/unix/signal.c b/native/unix/signal.c
index d65acfe7c1cf7956c9c9ebb7894d89f9009edc97..c9b1ba6654c842d3fa258fb75dea1c01cd41db81 100644 (file)
--- a/native/unix/signal.c
+++ b/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)

diff --git a/native/unix/socket.c b/native/unix/socket.c
index cf0d9e536f3c4cb54fd2ab7207bd0906f91b1d6a..0830ff28552f86dee8cfd7481abcd3becaa19243 100644 (file)
--- a/native/unix/socket.c
+++ b/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();

diff --git a/native/win32/misc.c b/native/win32/misc.c
index 51d3414d927238370db25ea4bab37803dac49565..4c85a32d87f00b1be2c6f16ca97d83520742688b 100644 (file)
--- a/native/win32/misc.c
+++ b/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);
 }
+

diff --git a/native/win32/run.c b/native/win32/run.c
new file mode 100644 (file)
index 0000000..9f8d7b4
--- /dev/null
+++ b/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);
+}