Clean up some of Dan's code after merge

core/bootstrap/primitives.factor

@@ -623,6 +623,7 @@ builtins get num-tags get tail f union-class define-class
     { "fopen" "io.streams.c" }
     { "fgetc" "io.streams.c" }
     { "fread" "io.streams.c" }
+    { "fputc" "io.streams.c" }
     { "fwrite" "io.streams.c" }
     { "fflush" "io.streams.c" }
     { "fclose" "io.streams.c" }

core/inference/known-words/known-words.factor

@@ -538,6 +538,8 @@ set-primitive-effect
 
 \ fwrite { string alien } { } <effect> set-primitive-effect
 
+\ fputc { object alien } { } <effect> set-primitive-effect
+
 \ fread { integer string } { object } <effect> set-primitive-effect
 
 \ fflush { alien } { } <effect> set-primitive-effect

core/io/io-tests.factor

@@ -1,5 +1,6 @@
 USING: arrays io io.files kernel math parser strings system
-tools.test words namespaces io.encodings.ascii io.encodings.binary ;
+tools.test words namespaces io.encodings.latin1
+io.encodings.binary ;
 IN: io.tests
 
 [ f ] [
@@ -8,7 +9,7 @@ IN: io.tests
 ] unit-test
 
 : <resource-reader> ( resource -- stream )
-    resource-path binary <file-reader> ;
+    resource-path latin1 <file-reader> ;
 
 [
     "This is a line.\rThis is another line.\r"
@@ -31,10 +32,10 @@ IN: io.tests
 
 ! [ ] [ "123" write 9000 CHAR: x <string> write flush ] unit-test
 
-[ "" ] [
+[
     "/core/io/test/binary.txt" <resource-reader>
     [ 0.2 read ] with-stream
-] unit-test
+] must-fail
 
 [
     {

core/io/streams/c/c-tests.factor

@@ -1,4 +1,5 @@
-USING: tools.test io.files io io.streams.c io.encodings.ascii ;
+USING: tools.test io.files io io.streams.c
+io.encodings.ascii strings ;
 IN: io.streams.c.tests
 
 [ "hello world" ] [
@@ -7,4 +8,5 @@ IN: io.streams.c.tests
     ] with-file-writer
 
     "test.txt" temp-file "rb" fopen <c-reader> contents
+    >string
 ] unit-test

core/io/streams/c/c.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private namespaces io io.encodings
-strings sequences math generic threads.private classes
+sequences math generic threads.private classes io.backend
-io.backend io.streams.duplex io.files continuations
+io.streams.duplex io.files continuations byte-arrays ;
-io.encodings.utf8 ;
 IN: io.streams.c
 
 TUPLE: c-writer handle ;
@@ -11,10 +10,10 @@ TUPLE: c-writer handle ;
 C: <c-writer> c-writer
 
 M: c-writer stream-write1
-    >r 1string r> stream-write ;
+    c-writer-handle fputc ;
 
 M: c-writer stream-write
-    >r >string r> c-writer-handle fwrite ;
+    c-writer-handle fwrite ;
 
 M: c-writer stream-flush
     c-writer-handle fflush ;
@@ -27,7 +26,7 @@ TUPLE: c-reader handle ;
 C: <c-reader> c-reader
 
 M: c-reader stream-read
-    >r >fixnum r> c-reader-handle fread ;
+    c-reader-handle fread ;
 
 M: c-reader stream-read-partial
     stream-read ;
@@ -43,7 +42,7 @@ M: c-reader stream-read1
     ] if ;
 
 M: c-reader stream-read-until
-    [ swap read-until-loop ] "" make swap
+    [ swap read-until-loop ] B{ } make swap
     over empty? over not and [ 2drop f f ] when ;
 
 M: c-reader dispose
@@ -76,4 +75,6 @@ M: object (file-appender)
     #! print stuff from contexts where the I/O system would
     #! otherwise not work (tools.deploy.shaker, the I/O
     #! multiplexer thread).
-    "\r\n" append stdout-handle fwrite stdout-handle fflush ;
+    "\r\n" append >byte-array
+    stdout-handle fwrite
+    stdout-handle fflush ;

extra/http/server/server.factor

@@ -4,7 +4,7 @@ USING: assocs kernel namespaces io io.timeouts strings splitting
 threads http sequences prettyprint io.server logging calendar
 new-slots html.elements accessors math.parser combinators.lib
 vocabs.loader debugger html continuations random combinators
-destructors ;
+destructors io.encodings.latin1 ;
 IN: http.server
 
 GENERIC: call-responder ( request path responder -- response )
@@ -165,7 +165,7 @@ LOG: httpd-hit NOTICE
 
 : httpd ( port -- )
     internet-server "http.server"
-    binary [ handle-client ] with-server ;
+    latin1 [ handle-client ] with-server ;
 
 : httpd-main ( -- ) 8888 httpd ;
 

extra/io/nonblocking/nonblocking.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.nonblocking
 USING: math kernel io sequences io.buffers io.timeouts generic
-sbufs system io.streams.duplex io.encodings
+byte-vectors system io.streams.duplex io.encodings
 io.backend continuations debugger classes byte-arrays namespaces
 splitting dlists assocs io.encodings.binary ;
 
@@ -71,7 +71,7 @@ GENERIC: (wait-to-read) ( port -- )
 M: input-port stream-read1
     dup wait-to-read1 [ buffer-pop ] unless-eof ;
 
-: read-step ( count port -- string/f )
+: read-step ( count port -- byte-array/f )
     [ wait-to-read ] 2keep
     [ dupd buffer> ] unless-eof nip ;
 
@@ -90,10 +90,10 @@ M: input-port stream-read
     >r 0 max >fixnum r>
     2dup read-step dup [
         pick over length > [
-            pick <sbuf>
+            pick <byte-vector>
             [ push-all ] keep
             [ read-loop ] keep
-            "" like
+            B{ } like
         ] [
             2nip
         ] if
@@ -101,7 +101,7 @@ M: input-port stream-read
         2nip
     ] if ;
 
-: read-until-step ( separators port -- string/f separator/f )
+: read-until-step ( separators port -- byte-array/f separator/f )
     dup wait-to-read1
     dup port-eof? [
         f swap set-port-eof? drop f f
@@ -109,7 +109,7 @@ M: input-port stream-read
         buffer-until
     ] if ;
 
-: read-until-loop ( seps port sbuf -- separator/f )
+: read-until-loop ( seps port byte-vector -- separator/f )
     2over read-until-step over [
         >r over push-all r> dup [
             >r 3drop r>
@@ -120,18 +120,20 @@ M: input-port stream-read
         >r 2drop 2drop r>
     ] if ;
 
-M: input-port stream-read-until ( seps port -- str/f sep/f )
+M: input-port stream-read-until ( seps port -- byte-array/f sep/f )
     2dup read-until-step dup [
         >r 2nip r>
     ] [
         over [
-            drop >sbuf [ read-until-loop ] keep "" like swap
+            drop >byte-vector
+            [ read-until-loop ] keep
+            B{ } like swap
         ] [
             >r 2nip r>
         ] if
     ] if ;
 
-M: input-port stream-read-partial ( max stream -- string/f )
+M: input-port stream-read-partial ( max stream -- byte-array/f )
     >r 0 max >fixnum r> read-step ;
 
 : can-write? ( len writer -- ? )
@@ -169,7 +171,7 @@ M: port dispose
     [ dup port-type >r closed over set-port-type r> close-port ]
     if ;
 
-TUPLE: server-port addr client encoding ;
+TUPLE: server-port addr client client-addr encoding ;
 
 : <server-port> ( handle addr encoding -- server )
     rot f server-port <port>

extra/io/sockets/sockets.factor

@@ -33,17 +33,19 @@ M: array client* [ (client) 2array ] attempt-all first2 ;
 M: object client* (client) ;
 
 : <client> ( addrspec encoding -- stream )
-    over client* rot <encoder-duplex> <client-stream> ;
+    >r client* r> <encoder-duplex> ;
 
 HOOK: (server) io-backend ( addrspec -- handle )
 
 : <server> ( addrspec encoding -- server )
     >r [ (server) ] keep r> <server-port> ;
 
-HOOK: (accept) io-backend ( server -- stream-in stream-out )
+HOOK: (accept) io-backend ( server -- addrspec handle )
 
 : accept ( server -- client )
-    [ (accept) ] keep server-port-encoding <encoder-duplex> ;
+    [ (accept) dup <reader&writer> ] keep
+    server-port-encoding <encoder-duplex>
+    <client-stream> ;
 
 HOOK: <datagram> io-backend ( addrspec -- datagram )
 

extra/io/unix/sockets/sockets.factor

@@ -42,7 +42,7 @@ M: connect-task do-io-task
 : wait-to-connect ( port -- )
     [ <connect-task> add-io-task ] with-port-continuation drop ;
 
-M: unix-io (client) ( addrspec -- stream )
+M: unix-io (client) ( addrspec -- client-in client-out )
     dup make-sockaddr/size >r >r
     protocol-family SOCK_STREAM socket-fd
     dup r> r> connect
@@ -71,10 +71,10 @@ TUPLE: accept-task ;
     dup <c-object> [ swap heap-size <int> accept ] keep ; inline
 
 : do-accept ( port fd sockaddr -- )
-    rot [
+    rot
-        server-port-addr parse-sockaddr
+    [ server-port-addr parse-sockaddr ] keep
-        swap dup <reader&writer> <duplex-stream> <client-stream>
+    [ set-server-port-client-addr ] keep
-    ] keep set-server-port-client ;
+    set-server-port-client ;
 
 M: accept-task do-io-task
     io-task-port dup accept-sockaddr
@@ -95,13 +95,13 @@ M: unix-io (server) ( addrspec -- handle )
     SOCK_STREAM server-fd
     dup 10 listen zero? [ dup close (io-error) ] unless ;
 
-M: unix-io (accept) ( server -- client-in client-out )
+M: unix-io (accept) ( server -- addrspec handle )
     #! Wait for a client connection.
     dup check-server-port
     dup wait-to-accept
     dup pending-error
-    server-port-client
+    dup server-port-client-addr
-    { duplex-stream-in duplex-stream-out } get-slots ;
+    swap server-port-client ;
 
 ! Datagram sockets - UDP and Unix domain
 M: unix-io <datagram>

extra/io/windows/nt/sockets/sockets.factor

@@ -45,13 +45,12 @@ TUPLE: ConnectEx-args port
     "stdcall" alien-indirect drop
     winsock-error-string [ throw ] when* ;
 
-: connect-continuation ( ConnectEx -- )
+: connect-continuation ( ConnectEx port -- )
-    dup ConnectEx-args-lpOverlapped*
+    >r ConnectEx-args-lpOverlapped* r>
-    swap ConnectEx-args-port duplex-stream-in
+    2dup save-callback
-    [ save-callback ] 2keep
     get-overlapped-result drop ;
 
-M: windows-nt-io (client) ( addrspec -- duplex-stream )
+M: windows-nt-io (client) ( addrspec -- client-in client-out )
     [
         \ ConnectEx-args construct-empty
         over make-sockaddr/size pick init-connect
@@ -61,14 +60,8 @@ M: windows-nt-io (client) ( addrspec -- duplex-stream )
         dup ConnectEx-args-s* INADDR_ANY roll bind-socket
         dup (ConnectEx)
 
-        dup ConnectEx-args-s* <win32-socket>
+        dup ConnectEx-args-s* <win32-socket> dup <reader&writer>
-        dup <reader&writer> <duplex-stream>
+        >r [ connect-continuation ] keep [ pending-error ] keep r>
-        over set-ConnectEx-args-port
-
-        dup connect-continuation
-        ConnectEx-args-port
-        [ duplex-stream-in pending-error ] keep
-        [ duplex-stream-out pending-error ] keep
     ] with-destructors ;
 
 TUPLE: AcceptEx-args port
@@ -118,17 +111,15 @@ TUPLE: AcceptEx-args port
         ] keep *void*
     ] keep AcceptEx-args-port server-port-addr parse-sockaddr ;
 
-: accept-continuation ( AcceptEx -- client )
+: accept-continuation ( AcceptEx -- addrspec client )
     [ make-accept-continuation ] keep
     [ check-accept-error ] keep
     [ extract-remote-host ] keep
     ! addrspec AcceptEx
-    [
+    [ AcceptEx-args-sAcceptSocket* add-completion ] keep
-        AcceptEx-args-sAcceptSocket* add-completion
-    ] keep
     AcceptEx-args-sAcceptSocket* <win32-socket> ;
 
-M: windows-nt-io (accept) ( server -- client-in client-out )
+M: windows-nt-io (accept) ( server -- addrspec handle )
     [
         [
             dup check-server-port
@@ -137,8 +128,6 @@ M: windows-nt-io (accept) ( server -- client-in client-out )
             [ ((accept)) ] keep
             [ accept-continuation ] keep
             AcceptEx-args-port pending-error
-            dup duplex-stream-in pending-error
-            dup duplex-stream-out pending-error
         ] with-timeout
     ] with-destructors ;
 

vm/io.c

@@ -102,21 +102,46 @@ DEFINE_PRIMITIVE(fread)
 		}
 		else
 		{
-			dpush(tag_object(memory_to_char_string(
+			if(c != size)
-				(char *)(buf + 1),c)));
+			{
+				REGISTER_UNTAGGED(buf);
+				F_BYTE_ARRAY *new_buf = allot_byte_array(c);
+				UNREGISTER_UNTAGGED(buf);
+				memcpy(new_buf + 1, buf + 1,c);
+				buf = new_buf;
+			}
+			dpush(tag_object(buf));
 			break;
 		}
 	}
 }
 
+DEFINE_PRIMITIVE(fputc)
+{
+	FILE *file = unbox_alien();
+	F_FIXNUM ch = to_fixnum(dpop());
+
+	for(;;)
+	{
+		if(fputc(ch,file) == EOF)
+		{
+			io_error();
+
+			/* Still here? EINTR */
+		}
+		else
+			break;
+	}
+}
+
 DEFINE_PRIMITIVE(fwrite)
 {
-	FILE* file = unbox_alien();
+	FILE *file = unbox_alien();
-	F_STRING* text = untag_string(dpop());
+	F_BYTE_ARRAY *text = untag_byte_array(dpop());
-	F_FIXNUM length = untag_fixnum_fast(text->length);
+	F_FIXNUM length = array_capacity(text);
-	char* string = to_char_string(text,false);
+	char *string = (char *)(text + 1);
 
-	if(string_capacity(text) == 0)
+	if(length == 0)
 		return;
 
 	for(;;)

vm/io.h

@@ -3,11 +3,12 @@ void io_error(void);
 int err_no(void);
 
 DECLARE_PRIMITIVE(fopen);
+DECLARE_PRIMITIVE(fgetc);
+DECLARE_PRIMITIVE(fread);
+DECLARE_PRIMITIVE(fputc);
 DECLARE_PRIMITIVE(fwrite);
 DECLARE_PRIMITIVE(fflush);
 DECLARE_PRIMITIVE(fclose);
-DECLARE_PRIMITIVE(fgetc);
-DECLARE_PRIMITIVE(fread);
 
 /* Platform specific primitives */
 DECLARE_PRIMITIVE(open_file);

vm/primitives.c

@@ -162,6 +162,7 @@ void *primitives[] = {
 	primitive_fopen,
 	primitive_fgetc,
 	primitive_fread,
+	primitive_fputc,
 	primitive_fwrite,
 	primitive_fflush,
 	primitive_fclose,