diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 04bb63a40a..97005462cf 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,8 +1,10 @@ + native: +- file i/o using fds +- handle expiry over image load/save +- i/o error handling - {...} vectors - parsing should be parsing -- telnetd: listening on a socket - describe-word - clone-sbuf - contains ==> contains? diff --git a/library/logging.factor b/library/logging.factor index 08707e91f9..c9112f576d 100644 --- a/library/logging.factor +++ b/library/logging.factor @@ -32,6 +32,7 @@ USE: combinators USE: stack USE: streams USE: strings +USE: unparser : log ( msg -- ) "log" get dup [ tuck fprint fflush ] [ 2drop ] ifte ; @@ -42,7 +43,7 @@ USE: strings : log-client ( -- ) "client" get [ "Accepted connection from " swap - [ "socket" get ] bind cat2 log + [ "socket" get unparse ] bind cat2 log ] when* ; : with-logging ( quot -- ) diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor index 63d6b282b2..8864aeb9f6 100644 --- a/library/platform/native/boot.factor +++ b/library/platform/native/boot.factor @@ -68,6 +68,7 @@ primitives, "/library/stream.factor" "/library/strings.factor" "/library/styles.factor" + "/library/telnetd.factor" "/library/vectors.factor" "/library/vector-combinators.factor" "/library/vocabularies.factor" diff --git a/library/platform/native/cross-compiler.factor b/library/platform/native/cross-compiler.factor index cce1da1de7..90fd4cf169 100644 --- a/library/platform/native/cross-compiler.factor +++ b/library/platform/native/cross-compiler.factor @@ -54,9 +54,13 @@ DEFER: open-file DEFER: read-line-8 DEFER: write-8 DEFER: close +DEFER: flush DEFER: server-socket DEFER: close-fd DEFER: accept-fd +DEFER: read-line-fd-8 +DEFER: write-fd-8 +DEFER: flush-fd IN: words DEFER: @@ -144,6 +148,7 @@ IN: cross-compiler read-line-8 write-8 close + flush garbage-collection save-image datastack @@ -155,6 +160,9 @@ IN: cross-compiler server-socket close-fd accept-fd + read-line-fd-8 + write-fd-8 + flush-fd ] [ swap succ tuck primitive, ] each drop ; diff --git a/library/platform/native/io-internals.factor b/library/platform/native/io-internals.factor index f9c779c7a9..45483ba85d 100644 --- a/library/platform/native/io-internals.factor +++ b/library/platform/native/io-internals.factor @@ -27,9 +27,9 @@ IN: io-internals USE: kernel +USE: namespaces +USE: combinators : stdin 0 getenv ; : stdout 1 getenv ; : stderr 2 getenv ; - -! The remaining words in this vocabulary are primitives. diff --git a/library/platform/native/stream.factor b/library/platform/native/stream.factor index 1181c316af..c78d4d2f64 100644 --- a/library/platform/native/stream.factor +++ b/library/platform/native/stream.factor @@ -30,6 +30,7 @@ USE: combinators USE: io-internals USE: kernel USE: stack +USE: strings USE: namespaces : ( in out -- stream ) @@ -39,10 +40,17 @@ USE: namespaces "out" set "in" set - ( string -- ) + ( str -- ) [ "out" get write-8 ] "fwrite" set - ( -- string ) - [ "in" get read-line-8 ] "freadln" set + + ( -- str ) + [ "in" get read-line-8 sbuf>str ] "freadln" set + + ( -- ) + [ + "out" get [ flush ] when* + ] "fflush" set + ( -- ) [ "in" get [ close ] when* @@ -66,6 +74,17 @@ USE: namespaces "out" set "in" set + ( str -- ) + [ "out" get write-fd-8 ] "fwrite" set + + ( -- str ) + [ "in" get read-line-fd-8 sbuf>str ] "freadln" set + + ( -- ) + [ + "out" get [ flush-fd ] when* + ] "fflush" set + ( -- ) [ "in" get [ close-fd ] when* @@ -89,4 +108,4 @@ USE: namespaces [ "socket" get ] bind accept-fd dup ; : init-stdio ( -- ) - stdin stdout "stdio" set ; + stdin stdout "stdio" set ; diff --git a/native/factor.h b/native/factor.h index a2a0d1ad4c..eab4b0a2a9 100644 --- a/native/factor.h +++ b/native/factor.h @@ -22,6 +22,10 @@ #define CHAR unsigned short #define CHARS sizeof(CHAR) +/* must always be 8 bits */ +#define BYTE unsigned char +#define BYTES 1 + /* Memory heap size */ #define DEFAULT_ARENA (4 * 1024 * 1024) #define STACK_SIZE 1024 @@ -31,6 +35,7 @@ #include "gc.h" #include "types.h" #include "array.h" +#include "fd.h" #include "fixnum.h" #include "cons.h" #include "word.h" diff --git a/native/fd.c b/native/fd.c new file mode 100644 index 0000000000..75c4e12427 --- /dev/null +++ b/native/fd.c @@ -0,0 +1,62 @@ +#include "factor.h" + +void primitive_close_fd(void) +{ + HANDLE* h = untag_handle(HANDLE_FD,env.dt); + close(h->object); + env.dt = dpop(); +} + +void primitive_read_line_fd_8(void) +{ + HANDLE* h = untag_handle(HANDLE_FD,env.dt); + int fd = h->object; + + /* finished line, unicode */ + SBUF* line = sbuf(LINE_SIZE); + + /* read ascii from fd */ + STRING* buf = string(LINE_SIZE / 2,'\0'); + + int amount; + int i; + int ch; + + for(;;) + { + amount = read(fd,buf + 1,buf->capacity * 2); + if(amount <= 0) /* error or EOF */ + goto end; + else + { + for(i = 0; i < amount; i++) + { + ch = bget((CELL)buf + sizeof(STRING) + i); + if(ch == '\n') + goto end; + else + set_sbuf_nth(line,line->top,ch); + } + } + } + +end: env.dt = tag_object(line); +} + +void primitive_write_fd_8(void) +{ + HANDLE* h = untag_handle(HANDLE_FD,env.dt); + int fd = h->object; + STRING* str = untag_string(dpop()); + char* c_str = to_c_string(str); + write(fd,c_str,str->capacity); + env.dt = dpop(); +} + +void primitive_flush_fd(void) +{ + HANDLE* h = untag_handle(HANDLE_FD,env.dt); + int fd = h->object; + fsync(fd); + env.dt = dpop(); +} diff --git a/native/fd.h b/native/fd.h new file mode 100644 index 0000000000..b6b3ec0a05 --- /dev/null +++ b/native/fd.h @@ -0,0 +1,6 @@ +#define LINE_SIZE 80 + +void primitive_close_fd(void); +void primitive_read_line_fd_8(void); +void primitive_write_fd_8(void); +void primitive_flush_fd(void); diff --git a/native/handle.c b/native/handle.c index 3479ddaeae..6c2ba94d2e 100644 --- a/native/handle.c +++ b/native/handle.c @@ -6,7 +6,7 @@ HANDLE* untag_handle(CELL type, CELL tagged) type_check(HANDLE_TYPE,tagged); h = (HANDLE*)UNTAG(tagged); /* after image load & save, handles are no longer valid */ - if(h->object == 0) + if(h->object == -1) general_error(ERROR_HANDLE_EXPIRED,tagged); if(h->type != type) general_error(ERROR_HANDLE_INCOMPAT,tagged); diff --git a/native/io.c b/native/io.c index 8eb3eee1d3..4bdf12b799 100644 --- a/native/io.c +++ b/native/io.c @@ -2,13 +2,11 @@ void init_io(void) { - env.user[STDIN_ENV] = handle(HANDLE_C_STREAM,stdin); - env.user[STDOUT_ENV] = handle(HANDLE_C_STREAM,stdout); - env.user[STDERR_ENV] = handle(HANDLE_C_STREAM,stderr); + env.user[STDIN_ENV] = handle(HANDLE_FD,0); + env.user[STDOUT_ENV] = handle(HANDLE_FD,1); + env.user[STDERR_ENV] = handle(HANDLE_FD,2); } -#define LINE_SIZE 80 - void primitive_open_file(void) { char* mode = to_c_string(untag_string(env.dt)); @@ -47,7 +45,7 @@ void primitive_read_line_8(void) set_sbuf_nth(b,b->top,ch); } - env.dt = tag_object(sbuf_to_string(b)); + env.dt = tag_object(b); } /* write a string. */ @@ -71,3 +69,10 @@ void primitive_close(void) fclose((FILE*)h->object); env.dt = dpop(); } + +void primitive_flush(void) +{ + HANDLE* h = untag_handle(HANDLE_C_STREAM,env.dt); + fflush((FILE*)h->object); + env.dt = dpop(); +} diff --git a/native/io.h b/native/io.h index a2396c2f22..ee43b750bd 100644 --- a/native/io.h +++ b/native/io.h @@ -3,3 +3,4 @@ void primitive_open_file(void); void primitive_read_line_8(void); void primitive_write_8(void); void primitive_close(void); +void primitive_flush(void); diff --git a/native/memory.h b/native/memory.h index 78b93c5061..79e6994d9d 100644 --- a/native/memory.h +++ b/native/memory.h @@ -39,4 +39,14 @@ INLINE void cput(CELL where, CHAR what) *((CHAR*)where) = what; } +INLINE BYTE bget(CELL where) +{ + return *((BYTE*)where); +} + +INLINE void bput(CELL where, BYTE what) +{ + *((BYTE*)where) = what; +} + bool in_zone(ZONE* z, CELL pointer); diff --git a/native/primitives.c b/native/primitives.c index 5c833ee3b3..bd351c8351 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -76,17 +76,21 @@ XT primitives[] = { primitive_read_line_8, /* 72 */ primitive_write_8, /* 73 */ primitive_close, /* 74 */ - primitive_gc, /* 75 */ - primitive_save_image, /* 76 */ - primitive_datastack, /* 77 */ - primitive_callstack, /* 78 */ - primitive_set_datastack, /* 79 */ - primitive_set_callstack, /* 80 */ - primitive_handlep, /* 81 */ - primitive_exit, /* 82 */ - primitive_server_socket, /* 83 */ - primitive_close_fd, /* 84 */ - primitive_accept_fd /* 85 */ + primitive_flush, /* 75 */ + primitive_gc, /* 76 */ + primitive_save_image, /* 77 */ + primitive_datastack, /* 78 */ + primitive_callstack, /* 79 */ + primitive_set_datastack, /* 80 */ + primitive_set_callstack, /* 81 */ + primitive_handlep, /* 82 */ + primitive_exit, /* 83 */ + primitive_server_socket, /* 84 */ + primitive_close_fd, /* 85 */ + primitive_accept_fd, /* 86 */ + primitive_read_line_fd_8, /* 87 */ + primitive_write_fd_8, /* 88 */ + primitive_flush_fd /* 89 */ }; CELL primitive_to_xt(CELL primitive) diff --git a/native/primitives.h b/native/primitives.h index 215717c8f9..3d76ad2d0e 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,5 +1,5 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 86 +#define PRIMITIVE_COUNT 90 CELL primitive_to_xt(CELL primitive); diff --git a/native/socket.c b/native/socket.c index c7e919e9a6..b648edf5ed 100644 --- a/native/socket.c +++ b/native/socket.c @@ -31,13 +31,6 @@ void primitive_server_socket(void) env.dt = handle(HANDLE_FD,make_server_socket(port)); } -void primitive_close_fd(void) -{ - HANDLE* h = untag_handle(HANDLE_FD,env.dt); - close(h->object); - env.dt = dpop(); -} - int accept_connection(int sock) { struct sockaddr_in clientname; diff --git a/native/socket.h b/native/socket.h index cf6c889731..7f79085a8c 100644 --- a/native/socket.h +++ b/native/socket.h @@ -1,4 +1,4 @@ int make_server_socket(CHAR port); void primitive_server_socket(void); -void primitive_close_fd(void); +int accept_connection(int sock); void primitive_accept_fd(void);