preliminary native support for network sockets

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?

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

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"

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: <word>
@@ -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 ;

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.

library/platform/native/stream.factor

@@ -30,6 +30,7 @@ USE: combinators
 USE: io-internals
 USE: kernel
 USE: stack
+USE: strings
 USE: namespaces
 
 : <c-stream> ( 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 <fd-stream> ;
 
 : init-stdio ( -- )
-    stdin stdout <c-stream> "stdio" set ;
+    stdin stdout <fd-stream> "stdio" set ;

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"

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

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

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

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

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

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

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)

native/primitives.h

@@ -1,5 +1,5 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 86
+#define PRIMITIVE_COUNT 90
 
 CELL primitive_to_xt(CELL primitive);
 

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;

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