diff --git a/Makefile.win32 b/Makefile.win32 index ea7c4a8cd9..83723b15fc 100644 --- a/Makefile.win32 +++ b/Makefile.win32 @@ -6,28 +6,28 @@ DEFAULT_LIBS = -lm STRIP = strip -WIN32_OBJS = native\win32\ffi.o native\win32\file.o native\win32\io.o \ - native\win32\misc.o native\win32\read.o native\win32\write.o \ +WIN32_OBJS = native\win32\ffi.o native\win32\file.o \ + native\win32\misc.o \ native\win32\run.o -OBJS = $(WIN32_OBJS) 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 \ - native/float.o native/gc.o \ - native/image.o native/memory.o \ - native/misc.o native/primitives.o \ - native/ratio.o native/relocate.o \ - native/run.o \ - native/sbuf.o native/stack.o \ - native/string.o native/types.o native/vector.o \ - native/word.o native/compiler.o \ - native/alien.o native/dll.o \ - native/boolean.o \ - native/debug.o \ - native/hashtable.o \ - native/icache.o \ - native/io.o +OBJS = $(WIN32_OBJS) 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 \ + native\float.o native\gc.o \ + native\image.o native\memory.o \ + native\misc.o native\primitives.o \ + native\ratio.o native\relocate.o \ + native\run.o \ + native\sbuf.o native\stack.o \ + native\string.o native\types.o native\vector.o \ + native\word.o native\compiler.o \ + native\alien.o native\dll.o \ + native\boolean.o \ + native\debug.o \ + native\hashtable.o \ + native\icache.o \ + native\io.o default: @echo "Run 'make' with one of the following parameters:" @@ -55,3 +55,9 @@ clean: .c.o: $(CC) -c $(CFLAGS) -o $@ $< +.S.o: + $(CC) -c $(CFLAGS) -o $@ $< + +native\icache.o: native\icache.s + $(CC) -c $(CFLAGS) -o $@ native\icache.S + diff --git a/library/win32/win32-io-internals.factor b/library/win32/win32-io-internals.factor index b052dba64b..5c9b295259 100644 --- a/library/win32/win32-io-internals.factor +++ b/library/win32/win32-io-internals.factor @@ -142,7 +142,7 @@ END-STRUCT INVALID_HANDLE_VALUE NULL NULL 1 CreateIoCompletionPort completion-port set - << null-stream f >> stdio set +! << null-stream f >> stdio set [ 32 callbacks set diff --git a/library/win32/win32-server.factor b/library/win32/win32-server.factor index a699a6db21..39ca7411c5 100644 --- a/library/win32/win32-server.factor +++ b/library/win32/win32-server.factor @@ -29,7 +29,7 @@ USING: alien errors generic kernel kernel-internals lists math namespaces win32-io-internals io-internals ; TUPLE: win32-server this ; -TUPLE: win32-client-stream host ; +TUPLE: win32-client-stream host port ; SYMBOL: winsock SYMBOL: socket @@ -55,27 +55,28 @@ SYMBOL: socket AF_INET over set-sockaddr-in-family ; : bind-socket ( port socket -- ) - swap setup-sockaddr "sockaddr-in" size wsa-bind 0 = [ + swap setup-sockaddr "sockaddr-in" c-size wsa-bind 0 = [ handle-socket-error ] unless ; : listen-socket ( socket -- ) 20 wsa-listen 0 = [ handle-socket-error ] unless ; -: sockaddr>string ( sockaddr -- string ) - dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa - [ , ":" , unparse , ] make-string ; +: sockaddr> ( sockaddr -- port host ) + dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa ; -: extract-remote-host ( buffer -- host ) +: extract-remote-host ( buffer -- port host ) buffer-ptr 0 32 32 dup >r - GetAcceptExSockaddrs r> indirect-pointer-value sockaddr>string ; + GetAcceptExSockaddrs r> indirect-pointer-value sockaddr> ; C: win32-client-stream ( buf stream -- stream ) [ set-delegate extract-remote-host ] keep - [ set-win32-client-stream-host ] keep ; + [ set-win32-client-stream-host ] keep + [ set-win32-client-stream-port ] keep ; M: win32-client-stream client-stream-host win32-client-stream-host ; +M: win32-client-stream client-stream-port win32-client-stream-port ; C: win32-server ( port -- server ) swap [ @@ -87,7 +88,8 @@ C: win32-server ( port -- server ) M: win32-server stream-close ( server -- ) win32-server-this [ socket get CloseHandle drop ] bind ; -M: win32-server accept ( server -- client ) +IN: streams +: accept ( server -- client ) win32-server-this [ new-socket 64 [ diff --git a/library/win32/win32-stream.factor b/library/win32/win32-stream.factor index 3ecfcf757f..9140e7d431 100644 --- a/library/win32/win32-stream.factor +++ b/library/win32/win32-stream.factor @@ -46,7 +46,7 @@ SYMBOL: file-size 0 over set-overlapped-ext-internal-high fileptr get dup 0 ? over set-overlapped-ext-offset 0 over set-overlapped-ext-offset-high - 0 over set-overlapped-ext-event ; + NULL over set-overlapped-ext-event ; : update-file-pointer ( whence -- ) file-size get [ fileptr [ + ] change ] [ drop ] ifte ; @@ -87,7 +87,7 @@ M: string do-write ( str -- ) ReadFile [ handle-io-error ] unless stop ] callcc1 pending-error - dup in-buffer get >buffer update-file-pointer ; + dup in-buffer get n>buffer update-file-pointer ; : consume-input ( count -- str ) in-buffer get buffer-length 0 = [ fill-input ] when diff --git a/native/win32/ffi.c b/native/win32/ffi.c index c6a0a2a63e..848f7215f0 100644 --- a/native/win32/ffi.c +++ b/native/win32/ffi.c @@ -1,5 +1,9 @@ #include "../factor.h" +void init_ffi (void) +{ +} + void ffi_dlopen (DLL *dll) { HMODULE module; diff --git a/native/win32/file.c b/native/win32/file.c index c7f538ac26..2f392eb16d 100644 --- a/native/win32/file.c +++ b/native/win32/file.c @@ -1,50 +1,5 @@ #include "../factor.h" -void primitive_open_file(void) -{ - bool write = unbox_boolean(); - bool read = unbox_boolean(); - char *path; - DWORD mode = 0, create = 0; - HANDLE fp; - SECURITY_ATTRIBUTES sa; - - path = unbox_c_string(); - - mode |= write ? GENERIC_WRITE : 0; - mode |= read ? GENERIC_READ : 0; - - if (read && write) - create = OPEN_ALWAYS; - else if (read) - create = OPEN_EXISTING; - else if (write) - create = CREATE_ALWAYS; - - sa.nLength = sizeof(SECURITY_ATTRIBUTES); - sa.lpSecurityDescriptor = NULL; - sa.bInheritHandle = true; - - fp = CreateFile( - path, - mode, - FILE_SHARE_DELETE|FILE_SHARE_READ|FILE_SHARE_WRITE, - &sa, - create, - /* FILE_FLAG_OVERLAPPED TODO */0, - NULL); - - if (fp == INVALID_HANDLE_VALUE) - { - io_error(__FUNCTION__); - } - else - { - dpush(read ? tag_object(port(PORT_READ, (CELL)fp)) : F); - dpush(write ? tag_object(port(PORT_WRITE, (CELL)fp)) : F); - } -} - void primitive_stat(void) { F_STRING *path; diff --git a/native/win32/io.c b/native/win32/io.c deleted file mode 100644 index 53e034bdab..0000000000 --- a/native/win32/io.c +++ /dev/null @@ -1,43 +0,0 @@ -#include "../factor.h" - -HANDLE completion_port = INVALID_HANDLE_VALUE; -CELL callback_list = F; - -void init_io (void) -{ - 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))); -} - -void primitive_add_copy_io_task (void) -{ - io_error(__FUNCTION__); -} - -void primitive_close (void) -{ - F_PORT *port = untag_port(dpop()); - - CloseHandle((HANDLE)port->fd); - port->closed = true; -} - -void primitive_next_io_task (void) -{ - maybe_garbage_collection(); - - if (callback_list != F) - { - F_CONS *cons = untag_cons(callback_list); - CELL car = cons->car; - callback_list = cons->cdr; - dpush(car); - } - else - dpush(F); -} - -void collect_io_tasks (void) -{ - copy_object(&callback_list); -} \ No newline at end of file diff --git a/native/win32/read.c b/native/win32/read.c deleted file mode 100644 index e75e17fe06..0000000000 --- a/native/win32/read.c +++ /dev/null @@ -1,131 +0,0 @@ -#include "../factor.h" - -void primitive_add_read_count_io_task (void) -{ - callback_list = cons(dpop(), callback_list); - dpop(); dpop(); -} - -void primitive_add_read_line_io_task (void) -{ - dpop(); dpop(); -} - -void primitive_can_read_count (void) -{ - dpop(); dpop(); - box_boolean(true); -} - -void primitive_can_read_line (void) -{ - dpop(); - box_boolean(true); -} - -void primitive_read_count_8 (void) -{ - F_PORT *port; - F_FIXNUM len; - DWORD out_len; - char *buf; - F_SBUF *result; - unsigned int i; - - maybe_garbage_collection(); - - port = untag_port(dpop()); - len = to_fixnum(dpop()); - buf = malloc(len); - - if (!ReadFile((HANDLE)port->fd, buf, len, &out_len, NULL)) - io_error(__FUNCTION__); - - result = sbuf(out_len); - - for (i = 0; i < out_len; ++i) - set_sbuf_nth(result, i, buf[i] & 0xFF); - - free(buf); - dpush(tag_object(result)); -} - -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, buffer+1, BUF_SIZE, &read_len, NULL)) - io_error(__FUNCTION__); - - port->buf_pos += read_len; -} - -static void unfill_buffer(F_PORT *port, int 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); - - while (!got_line) - { - fill_buffer(port); - - for (i = 0; i < port->buf_pos; ++i) - { - BYTE ch = GETBUF(i); - - if (ch == '\r') - { - got_line = true; - if (i < port->buf_pos - 1 && GETBUF(i+1) == '\n') - ++i; - ++i; - break; - } - else if (ch == '\n') - { - got_line = true; - if (i < port->buf_pos - 1 && GETBUF(i+1) == '\r') - ++i; - ++i; - break; - } - - set_sbuf_nth(result, result->top, ch); - } - - if (i == 0) - got_line = true; - else - unfill_buffer(port, i); - } - - if (result->top || i) - dpush(tag_object(result)); - else - dpush(F); -} - -#undef GETBUF diff --git a/native/win32/write.c b/native/win32/write.c deleted file mode 100644 index e374e7e206..0000000000 --- a/native/win32/write.c +++ /dev/null @@ -1,55 +0,0 @@ -#include "../factor.h" - -void primitive_add_write_io_task (void) -{ - maybe_garbage_collection(); - - callback_list = cons(dpop(), callback_list); - dpop(); -} - -void primitive_can_write (void) -{ - dpop(); dpop(); - box_boolean(true); -} - -void write_char_8 (F_PORT *port, F_FIXNUM ch) -{ - DWORD ignore; - BYTE buf = (BYTE)ch; - WriteFile((HANDLE)port->fd, &buf, 1, &ignore, NULL); -} - -void write_string_8 (F_PORT *port, F_STRING *str) -{ - DWORD ignore; - WriteFile((HANDLE)port->fd, to_c_string_unchecked(str), - string_capacity(str), &ignore, NULL); -} - -void primitive_write_8 (void) -{ - F_PORT *port; - CELL text, type; - - maybe_garbage_collection(); - - port = untag_port(dpop()); - text = dpop(); - type = type_of(text); - - switch (type) - { - case FIXNUM_TYPE: - case BIGNUM_TYPE: - write_char_8(port, to_fixnum(text)); - break; - case STRING_TYPE: - write_string_8(port, untag_string(text)); - break; - default: - type_error(STRING_TYPE, text); - break; - } -}