diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 3fe0bd549a..4ade0f7f1d 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -3,7 +3,6 @@ - image output - 32-bit and 64-bit "bignums" - floats -- i/o error handling - {...} vectors - parsing should be parsing - describe-word diff --git a/library/platform/native/cross-compiler.factor b/library/platform/native/cross-compiler.factor index a2511985d7..a6c3489aec 100644 --- a/library/platform/native/cross-compiler.factor +++ b/library/platform/native/cross-compiler.factor @@ -58,6 +58,7 @@ DEFER: accept-fd DEFER: read-line-fd-8 DEFER: write-fd-8 DEFER: flush-fd +DEFER: shutdown-fd IN: words DEFER: @@ -156,6 +157,7 @@ IN: cross-compiler read-line-fd-8 write-fd-8 flush-fd + shutdown-fd room ] [ swap succ tuck primitive, diff --git a/library/platform/native/errors.factor b/library/platform/native/errors.factor index e5590cab21..b7b408067b 100644 --- a/library/platform/native/errors.factor +++ b/library/platform/native/errors.factor @@ -62,6 +62,7 @@ USE: vectors "Underflow" "Bad primitive: " "Incompatible handle: " + "I/O error: " ] ?nth ; : ?kernel-error ( cons -- error# param ) diff --git a/library/platform/native/stream.factor b/library/platform/native/stream.factor index d889f5af64..f9353d8a36 100644 --- a/library/platform/native/stream.factor +++ b/library/platform/native/stream.factor @@ -86,9 +86,20 @@ USE: namespaces [ "socket" get close-fd ] "fclose" set ] extend ; +: ( fd -- stream ) + #! A slight variation on that calls shutdown(2) + #! when closed. + dup [ + ( -- ) + [ + "in" get [ dup shutdown-fd close-fd ] when* + ( out == in ) + ] "fclose" set + ] extend ; + : accept ( server -- client ) #! Accept a connection from a server socket. - [ "socket" get ] bind accept-fd dup ; + [ "socket" get ] bind accept-fd ; : init-stdio ( -- ) stdin stdout "stdio" set ; diff --git a/native/cons.c b/native/cons.c index 0617f82650..718b4e8af5 100644 --- a/native/cons.c +++ b/native/cons.c @@ -1,6 +1,6 @@ #include "factor.h" -CELL cons(CELL car, CELL cdr) +CONS* cons(CELL car, CELL cdr) { CONS* cons = (CONS*)allot(sizeof(CONS)); cons->car = car; diff --git a/native/cons.h b/native/cons.h index 39b7f408f5..587104592f 100644 --- a/native/cons.h +++ b/native/cons.h @@ -14,7 +14,7 @@ INLINE CELL tag_cons(CONS* cons) return RETAG(cons,CONS_TYPE); } -CELL cons(CELL car, CELL cdr); +CONS* cons(CELL car, CELL cdr); INLINE CELL car(CELL cons) { diff --git a/native/error.c b/native/error.c index c3ac2999bf..06f4f505bc 100644 --- a/native/error.c +++ b/native/error.c @@ -50,5 +50,15 @@ void range_error(CELL tagged, CELL index, CELL max) { CONS* c = cons(tagged,tag_cons(cons(tag_fixnum(index), tag_cons(cons(tag_fixnum(max),F))))); - general_error(ERROR_RANGE,c); + general_error(ERROR_RANGE,tag_cons(c)); +} + +void io_error(const char* func) +{ + STRING* function = from_c_string(func); + STRING* error = from_c_string(strerror(errno)); + + CONS* c = cons(tag_object(function),tag_cons( + cons(tag_object(error),F))); + general_error(ERROR_IO,tag_cons(c)); } diff --git a/native/error.h b/native/error.h index 41b4f578ef..74677341aa 100644 --- a/native/error.h +++ b/native/error.h @@ -5,6 +5,7 @@ #define ERROR_UNDERFLOW (4<<3) #define ERROR_BAD_PRIMITIVE (5<<3) #define ERROR_HANDLE_INCOMPAT (6<<3) +#define ERROR_IO (7<<3) void fatal_error(char* msg, CELL tagged); void critical_error(char* msg, CELL tagged); @@ -13,3 +14,4 @@ void throw_error(CELL object); void general_error(CELL error, CELL tagged); void type_error(CELL type, CELL tagged); void range_error(CELL tagged, CELL index, CELL max); +void io_error(const char* func); diff --git a/native/factor.h b/native/factor.h index 7f2dead237..161eec0674 100644 --- a/native/factor.h +++ b/native/factor.h @@ -12,6 +12,7 @@ #include #include #include +#include #include #define INLINE inline static diff --git a/native/fd.c b/native/fd.c index a190fcb2c7..c5c3c37996 100644 --- a/native/fd.c +++ b/native/fd.c @@ -29,6 +29,7 @@ void primitive_read_line_fd_8(void) HANDLE* h = untag_handle(HANDLE_FD,env.dt); int fd = h->object; + int amount; int i; int ch; @@ -45,7 +46,12 @@ void primitive_read_line_fd_8(void) { if(h->buf_pos >= h->buf_fill) { - if(fill_buffer(h,fd,buf) <= 0) + amount = fill_buffer(h,fd,buf); + + if(amount < 0) + io_error(__FUNCTION__); + + if(amount == 0) { if(line->top == 0) { @@ -82,7 +88,12 @@ void primitive_write_fd_8(void) int fd = h->object; STRING* str = untag_string(dpop()); char* c_str = to_c_string(str); - write(fd,c_str,str->capacity); + + int amount = write(fd,c_str,str->capacity); + + if(amount < 0) + io_error(__FUNCTION__); + env.dt = dpop(); } @@ -90,6 +101,20 @@ void primitive_flush_fd(void) { HANDLE* h = untag_handle(HANDLE_FD,env.dt); int fd = h->object; - fsync(fd); + + /* if(fsync(fd) < 0) + io_error(__FUNCTION__); */ + + env.dt = dpop(); +} + +void primitive_shutdown_fd(void) +{ + HANDLE* h = untag_handle(HANDLE_FD,env.dt); + int fd = h->object; + + if(shutdown(fd,SHUT_RDWR) < 0) + io_error(__FUNCTION__); + env.dt = dpop(); } diff --git a/native/fd.h b/native/fd.h index 7aedd3757c..46f74d4532 100644 --- a/native/fd.h +++ b/native/fd.h @@ -1,8 +1,10 @@ #define LINE_SIZE 80 #define BUF_SIZE 1024 +void init_io(void); void primitive_close_fd(void); int fill_buffer(HANDLE* h, int fd, STRING* buf); void primitive_read_line_fd_8(void); void primitive_write_fd_8(void); void primitive_flush_fd(void); +void primitive_shutdown_fd(void); diff --git a/native/file.c b/native/file.c index d39861f735..e0bbe21f5c 100644 --- a/native/file.c +++ b/native/file.c @@ -14,7 +14,12 @@ void primitive_open_file(void) mode = O_RDONLY; else if(write) mode = O_WRONLY | O_CREAT | O_TRUNC; + else + mode = 0; fd = open(path,mode); + if(fd < 0) + io_error(__FUNCTION__); + env.dt = handle(HANDLE_FD,fd); } diff --git a/native/primitives.c b/native/primitives.c index 71cc062722..47d11c0211 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -87,7 +87,8 @@ XT primitives[] = { primitive_read_line_fd_8, /* 83 */ primitive_write_fd_8, /* 84 */ primitive_flush_fd, /* 85 */ - primitive_room /* 86 */ + primitive_shutdown_fd, /* 86 */ + primitive_room /* 87 */ }; CELL primitive_to_xt(CELL primitive) @@ -95,7 +96,7 @@ CELL primitive_to_xt(CELL primitive) XT xt; if(primitive < 0 || primitive >= PRIMITIVE_COUNT) - general_error("Invalid primitive",tag_fixnum(primitive)); + general_error(ERROR_BAD_PRIMITIVE,tag_fixnum(primitive)); xt = primitives[primitive]; if((CELL)xt % 8 != 0) diff --git a/native/primitives.h b/native/primitives.h index 0fd10a40fa..bbcb2d59e9 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,5 +1,5 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 87 +#define PRIMITIVE_COUNT 88 CELL primitive_to_xt(CELL primitive); diff --git a/native/sbuf.c b/native/sbuf.c index 372d68df98..ae1cc20b43 100644 --- a/native/sbuf.c +++ b/native/sbuf.c @@ -30,7 +30,7 @@ void primitive_set_sbuf_length(void) FIXNUM length = untag_fixnum(dpop()); sbuf->top = length; if(length < 0) - range_error(env.dt,index,length); + range_error(env.dt,length,sbuf->top); else if(length > sbuf->string->capacity) sbuf->string = grow_string(sbuf->string,length,F); env.dt = dpop(); /* don't forget this! */ diff --git a/native/socket.c b/native/socket.c index b648edf5ed..912c45e21e 100644 --- a/native/socket.c +++ b/native/socket.c @@ -5,22 +5,34 @@ int make_server_socket(CHAR port) int sock; struct sockaddr_in name; + int reuseaddr = 1; + /* Create the socket */ sock = socket(PF_INET, SOCK_STREAM, 0); if(sock < 0) - return -1; + io_error(__FUNCTION__); + + /* Reuse port number */ + if(setsockopt(sock,SOL_SOCKET,SO_REUSEADDR,&reuseaddr,sizeof(int)) < 0) + io_error(__FUNCTION__); /* Give the socket a name */ name.sin_family = AF_INET; name.sin_port = htons(port); name.sin_addr.s_addr = htonl(INADDR_ANY); if(bind(sock,(struct sockaddr *)&name, sizeof(name)) < 0) - return -1; + { + close(sock); + io_error(__FUNCTION__); + } /* Start listening for connections */ if(listen(sock,1) < 0) - return -1; + { + close(sock); + io_error(__FUNCTION__); + } return sock; } @@ -38,7 +50,7 @@ int accept_connection(int sock) int new = accept(sock,(struct sockaddr *)&clientname,&size); if(new < 0) - return -1; + io_error(__FUNCTION__); printf("Connection from host %s, port %hd.\n", inet_ntoa(clientname.sin_addr), diff --git a/native/string.c b/native/string.c index c532aff9e9..592d286e55 100644 --- a/native/string.c +++ b/native/string.c @@ -51,7 +51,7 @@ STRING* grow_string(STRING* string, CELL capacity, CHAR fill) } /* untagged */ -STRING* from_c_string(char* c_string) +STRING* from_c_string(const char* c_string) { CELL length = strlen(c_string); STRING* s = allot_string(length); @@ -59,7 +59,7 @@ STRING* from_c_string(char* c_string) for(i = 0; i < length; i++) { - put(SREF(s,i),c_string); + put(SREF(s,i),*c_string); c_string++; } @@ -101,7 +101,7 @@ void primitive_string_nth(void) CELL index = untag_fixnum(dpop()); if(index < 0 || index >= string->capacity) - range_error(string,index,string->capacity); + range_error(tag_object(string),index,string->capacity); env.dt = tag_fixnum(string_nth(string,index)); } @@ -160,7 +160,7 @@ void primitive_string_hashcode(void) INLINE CELL index_of_ch(CELL index, STRING* string, CELL ch) { if(index < 0) - range_error(string,index,string->capacity); + range_error(tag_object(string),index,string->capacity); while(index < string->capacity) { @@ -201,8 +201,11 @@ INLINE STRING* substring(CELL start, CELL end, STRING* string) { STRING* result; - if(start < 0 || end < start) - range_error(string,index,string->capacity); + if(start < 0) + range_error(tag_object(string),start,string->capacity); + + if(end < start) + range_error(tag_object(string),end,string->capacity); result = allot_string(end - start); memcpy(result + 1, diff --git a/native/string.h b/native/string.h index 15d55aafa9..916e47fcb4 100644 --- a/native/string.h +++ b/native/string.h @@ -17,7 +17,7 @@ STRING* string(CELL capacity, CELL fill); void hash_string(STRING* str); STRING* grow_string(STRING* string, CELL capacity, CHAR fill); char* to_c_string(STRING* s); -STRING* from_c_string(char* c_string); +STRING* from_c_string(const char* c_string); #define SREF(string,index) ((CELL)string + sizeof(STRING) + index * CHARS) diff --git a/native/vector.c b/native/vector.c index 1a0e501303..358ba0a93c 100644 --- a/native/vector.c +++ b/native/vector.c @@ -30,7 +30,7 @@ void primitive_set_vector_length(void) FIXNUM length = untag_fixnum(dpop()); vector->top = length; if(length < 0) - range_error(vector,index,length); + range_error(tag_object(vector),length,vector->top); else if(length > vector->array->capacity) vector->array = grow_array(vector->array,length,F); env.dt = dpop(); /* don't forget this! */ @@ -42,7 +42,7 @@ void primitive_vector_nth(void) CELL index = untag_fixnum(dpop()); if(index < 0 || index >= vector->top) - range_error(vector,index,vector->top); + range_error(tag_object(vector),index,vector->top); env.dt = array_nth(vector->array,index); } @@ -64,7 +64,7 @@ void primitive_set_vector_nth(void) check_non_empty(value); if(index < 0) - range_error(vector,index,vector->top); + range_error(tag_object(vector),index,vector->top); else if(index >= vector->top) vector_ensure_capacity(vector,index);