Fixup win32 port

diff --git a/native/factor.c b/native/factor.c
index 66c5cd83c3fdff39a9d1411ca566331c9a97d180..f18c56b25998452862a07e67647c1c66a197142a 100644 (file)
--- a/native/factor.c
+++ b/native/factor.c
@@ -6,10 +6,7 @@ void init_factor(char* image)
        load_image(image);
        init_stacks();
        init_io();
-
-#ifdef WIN32
        init_signals();
-#endif
 
        init_compiler();
        init_errors();

diff --git a/native/factor.h b/native/factor.h
index c41d199937dda07b5eeebe8ede777fa476860f44..051e56a68643bfc22d4a6ea428cfcabdae7687a5 100644 (file)
--- a/native/factor.h
+++ b/native/factor.h
@@ -34,9 +34,13 @@ CELL cs;
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
+#include <time.h>
 
 #ifdef WIN32
        #include <windows.h>
+
+       /* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */
+       #define EPOCH_OFFSET 0x019db1ded53e8000LL
 #else
        #include <dirent.h>
        #include <sys/mman.h>
@@ -51,8 +55,6 @@ CELL cs;
        #include <netdb.h>
 #endif
 
-#include <time.h>
-
 #if defined(_MSC_VER)
        #pragma warning(disable:4312)
        #pragma warning(disable:4311)

diff --git a/native/io.h b/native/io.h
index 43a90899bf1f8be25fbd0c5c3925b00f8d4e38e5..0d8f0a521dbcc655e9e928f5985ba6aa270b9e46 100644 (file)
--- a/native/io.h
+++ b/native/io.h
@@ -19,6 +19,15 @@ typedef struct {
        CELL callbacks;
 } IO_TASK;
 
+void primitive_next_io_task(void);
+void primitive_close(void);
+void collect_io_tasks(void);
+void primitive_add_copy_io_task(void);
+void init_io(void);
+
+#ifdef WIN32
+extern CELL callback_list;
+#else
 fd_set read_fd_set;
 IO_TASK read_io_tasks[FD_SETSIZE];
 int read_fd_count;
@@ -30,7 +39,6 @@ int write_fd_count;
 fd_set except_fd_set;
 
 void init_io_tasks(fd_set* fd_set, IO_TASK* io_tasks);
-void init_io(void);
 IO_TASK* add_io_task(
        IO_TASK_TYPE type,
        CELL port,
@@ -45,7 +53,6 @@ void remove_io_task(
 void remove_io_tasks(F_PORT* port);
 bool perform_copy_from_io_task(F_PORT* port, F_PORT* other_port);
 bool perform_copy_to_io_task(F_PORT* port, F_PORT* other_port);
-void primitive_add_copy_io_task(void);
 CELL pop_io_task_callback(
        IO_TASK_TYPE type,
        F_PORT* port,
@@ -56,6 +63,5 @@ bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks,
 CELL perform_io_task(IO_TASK* io_task, IO_TASK* io_tasks, int* fd_count);
 CELL perform_io_tasks(fd_set* fdset, IO_TASK* io_tasks, int* fd_count);
 CELL next_io_task(void);
-void primitive_next_io_task(void);
-void primitive_close(void);
-void collect_io_tasks(void);
+
+#endif

diff --git a/native/misc.c b/native/misc.c
index e3d9822965ee92606cf81e3b6b4331fd5fd8cfbb..ed21986f06c930b6ca7714d969f4e0aea04cc16d 100644 (file)
--- a/native/misc.c
+++ b/native/misc.c
@@ -29,8 +29,8 @@ int64_t current_millis(void)
 {
        FILETIME t;
        GetSystemTimeAsFileTime(&t);
-       return ((int64_t)t.dwLowDateTime | (int64_t)t.dwHighDateTime<<32) / 100000
-               - 172456224000;
+       return (((int64_t)t.dwLowDateTime | (int64_t)t.dwHighDateTime<<32) - EPOCH_OFFSET) 
+               / 10000;
 }
 #else
 int64_t current_millis(void)

diff --git a/native/port.c b/native/port.c
index 7ead04f0f7d4fe98e336d038eeb5eed57f6cc889..9297a67acef65b7cf1a035a55aa7c960b3b29acd 100644 (file)
--- a/native/port.c
+++ b/native/port.c
@@ -31,8 +31,10 @@ F_PORT* port(PORT_MODE type, CELL fd)
        else
                port->buffer = tag_object(string(BUF_SIZE,'\0'));
 
+#ifndef WIN32
        if(fcntl(port->fd,F_SETFL,O_NONBLOCK,1) == -1)
                io_error(__FUNCTION__);
+#endif
 
        return port;
 }

diff --git a/native/run.c b/native/run.c
index 31b04df22c5bced028889d033e66cebee9b66cb7..5ba92e88fd19c323ed3510fdf4375afbc399a3e7 100644 (file)
--- a/native/run.c
+++ b/native/run.c
@@ -66,7 +66,7 @@ void run(void)
        __except (GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ?
                EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH)
        {
-               signal_error(SIGSEGV);
+               signal_error(SIGSEGV);
        }
 #endif
 }

diff --git a/native/run.h b/native/run.h
index e4cf581b9516d95c9cf314a8eaba733826d3ab31..3d44de60a4207e5f099621a586e2cbb31a0fc86e 100644 (file)
--- a/native/run.h
+++ b/native/run.h
@@ -13,10 +13,16 @@
 #define ARGS_ENV       10
 
 /* Profiling timer */
+#ifndef WIN32
 struct itimerval prof_timer;
+#endif
 
 /* Error handlers restore this */
+#ifdef WIN32
+jmp_buf toplevel;
+#else
 sigjmp_buf toplevel;
+#endif
 
 /* TAGGED currently executing quotation */
 CELL callframe;

diff --git a/native/signal.h b/native/signal.h
index 07570df8e768204281aab5d17a7820213ea48966..d659eb73b42b4646f3b1c78de978fa9fe3e3c101 100644 (file)
--- a/native/signal.h
+++ b/native/signal.h
@@ -1,4 +1,7 @@
+#ifndef WIN32
 void signal_handler(int signal, siginfo_t* siginfo, void* uap);
 void call_profiling_step(int signal, siginfo_t* siginfo, void* uap);
 void init_signals(void);
+#endif
+
 void primitive_call_profiling(void);

diff --git a/native/win32/file.c b/native/win32/file.c
index 13ee48d561b0a55c9af897c1b4c6f06dec23b96e..748a24e63311a8359dbcc5fc87dc47a0bff9ddef 100644 (file)
--- a/native/win32/file.c
+++ b/native/win32/file.c
@@ -40,7 +40,6 @@ void primitive_open_file(void)
        } 
        else 
        {
-               CreateIoCompletionPort(fp, completion_port, 0, 0);
                dpush(read ? tag_object(port(PORT_READ, (CELL)fp)) : F);
                dpush(write ? tag_object(port(PORT_WRITE, (CELL)fp)) : F);
        }
@@ -63,7 +62,8 @@ void primitive_stat(void)
                CELL dirp = tag_boolean(st.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
                CELL size = tag_object(s48_long_long_to_bignum(
                        (int64_t)st.nFileSizeLow | (int64_t)st.nFileSizeHigh << 32));
-               CELL mtime = tag_integer((int)(*(int64_t*)&st.ftLastWriteTime / 100000000 - 172456224));
+               CELL mtime = tag_integer((int)
+                       ((*(int64_t*)&st.ftLastWriteTime - EPOCH_OFFSET) / 10000000));
                dpush(
                        cons(dirp,
                        cons(tag_fixnum(0),

diff --git a/native/win32/io.c b/native/win32/io.c
index 487265356293b82b8c14fe8827e76effab0c73ca..950fcf98055893298717961a7f38037076787a4d 100644 (file)
--- a/native/win32/io.c
+++ b/native/win32/io.c
@@ -5,12 +5,6 @@ CELL callback_list = F;
 
 void init_io (void) 
 {
-       completion_port = CreateIoCompletionPort(
-               INVALID_HANDLE_VALUE, NULL, 0, 1);
-
-       if (completion_port == INVALID_HANDLE_VALUE)
-               io_error(__FUNCTION__);
-
        userenv[STDIN_ENV] = tag_object(port(PORT_READ, (CELL)GetStdHandle(STD_INPUT_HANDLE)));
        userenv[STDOUT_ENV] = tag_object(port(PORT_WRITE, (CELL)GetStdHandle(STD_OUTPUT_HANDLE)));
 }
@@ -22,7 +16,7 @@ void primitive_add_copy_io_task (void)
 
 void primitive_close (void)
 {
-       PORT *port = untag_port(dpop());
+       F_PORT *port = untag_port(dpop());
        CloseHandle((HANDLE)port->fd);
        port->closed = true;
 }
@@ -31,7 +25,7 @@ void primitive_next_io_task (void)
 {
        if (callback_list != F)
        {
-               CONS *cons = untag_cons(callback_list);
+               F_CONS *cons = untag_cons(callback_list);
                CELL car = cons->car;
                callback_list = cons->cdr;
                dpush(car);

diff --git a/native/win32/misc.c b/native/win32/misc.c
new file mode 100644 (file)
index 0000000..b778944
--- /dev/null
+++ b/native/win32/misc.c
@@ -0,0 +1,34 @@
+#include "../factor.h"
+
+/* 
+ * Various stubs for functions not currently implemented in the Windows port.
+ */
+
+void init_signals(void)
+{
+}
+
+void primitive_accept_fd(void)
+{
+       undefined();
+}
+
+void primitive_add_accept_io_task(void)
+{
+       undefined();
+}
+
+void primitive_server_socket(void)
+{
+       undefined();
+}
+
+void primitive_client_socket(void)
+{
+       undefined();
+}
+
+void primitive_call_profiling(void)
+{
+       undefined();
+}

diff --git a/native/win32/read.c b/native/win32/read.c
index 9f99fc65212433d9fd3c5aebc6af0ff07b452aa3..e75e17fe0694fb18f1dd6107799e973acda21467 100644 (file)
--- a/native/win32/read.c
+++ b/native/win32/read.c
@@ -33,7 +33,7 @@ void primitive_read_count_8 (void)
        unsigned int i;
 
        maybe_garbage_collection();
-
+       
        port = untag_port(dpop());
        len = to_fixnum(dpop());
        buf = malloc(len);
@@ -50,60 +50,70 @@ void primitive_read_count_8 (void)
        dpush(tag_object(result));
 }
 
-static void fill_buffer(PORT *port)
+static void fill_buffer(F_PORT *port)
 {
        DWORD read_len;
+       F_STRING *buffer = untag_string(port->buffer);
 
        if (port->buf_pos)
                return;
 
-       if (!ReadFile((HANDLE)port->fd, port->buf, BUF_SIZE, &read_len, NULL))
+       if (!ReadFile((HANDLE)port->fd, buffer+1, BUF_SIZE, &read_len, NULL))
                io_error(__FUNCTION__);
 
        port->buf_pos += read_len;
 }
 
-static void unfill_buffer(PORT *port, int len)
+static void unfill_buffer(F_PORT *port, int len)
 {
-       memmove(port->buf, port->buf+len, port->buf_pos - len);
+       F_STRING *buffer = untag_string(port->buffer);
+
+       memmove(buffer+1, ((char *)(buffer+1))+len, port->buf_pos - len);
        port->buf_pos -= len;
 }
 
+#define GETBUF(n) (bget((CELL)buffer + sizeof(F_STRING) + (n)))
+
 void primitive_read_line_8 (void)
 {
        F_PORT *port;
        F_SBUF *result;
+       F_STRING *buffer;
        int i;
        bool got_line = false;
 
        maybe_garbage_collection();
 
        port = untag_port(dpop());
+       buffer = untag_string(port->buffer);
+       result = sbuf(LINE_SIZE);
 
-       result = sbuf(0);
        while (!got_line)
        {
                fill_buffer(port);
+
                for (i = 0; i < port->buf_pos; ++i)
                {
-                       if (port->buf[i] == '\r') 
+                       BYTE ch = GETBUF(i);
+
+                       if (ch == '\r') 
                        {
                                got_line = true;
-                               if (i < port->buf_pos - 1 && port->buf[i+1] == '\n')
+                               if (i < port->buf_pos - 1 && GETBUF(i+1) == '\n')
                                        ++i;
                                ++i;
                                break;
                        }
-                       else if (port->buf[i] == '\n')
+                       else if (ch == '\n')
                        {
                                got_line = true;
-                               if (i < port->buf_pos - 1 && port->buf[i+1] == '\r')
+                               if (i < port->buf_pos - 1 && GETBUF(i+1) == '\r')
                                        ++i;
                                ++i;
                                break;
                        }
 
-                       set_sbuf_nth(result, result->top, port->buf[i]);
+                       set_sbuf_nth(result, result->top, ch);
                }
 
                if (i == 0)
@@ -117,3 +127,5 @@ void primitive_read_line_8 (void)
        else
                dpush(F);
 }
+
+#undef GETBUF