Fixup win32 port

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

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)

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);
+#endif
-void collect_io_tasks(void);

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
+	return (((int64_t)t.dwLowDateTime | (int64_t)t.dwHighDateTime<<32) - EPOCH_OFFSET) 
-		- 172456224000;
+		/ 10000;
 }
 #else
 int64_t current_millis(void)

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

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
 }

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;

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

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

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

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();
+}

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