file responder works with native factor

diff --git a/Makefile b/Makefile
index fe493bd94535fc443ee6c8edf9b0a6dcdbae68fc..eefe7806aae8419ef4a452b364a35e1567f3488f 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 CC = gcc
-CFLAGS = -g -Os -mpentiumpro -Wall -fomit-frame-pointer
+CFLAGS = -g -Os -mpentiumpro -Wall
 LIBS = -lm
 STRIP = strip
 

diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index 895f06d55aa6f6d53519268813e6b226d9d7f6d6..2313aff55fe61b4075f5c10e9f4aadb8eb729a54 100644 (file)
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -62,7 +62,7 @@ DEFER: port?
 DEFER: open-file
 DEFER: client-socket
 DEFER: server-socket
-DEFER: close-fd
+DEFER: close-port
 DEFER: add-accept-io-task
 DEFER: accept-fd
 DEFER: can-read-line?
@@ -74,6 +74,7 @@ DEFER: read-count-fd-8
 DEFER: can-write?
 DEFER: add-write-io-task
 DEFER: write-fd-8
+DEFER: add-copy-io-task
 DEFER: next-io-task
 
 IN: math
@@ -222,7 +223,7 @@ IN: cross-compiler
         exit*
         client-socket
         server-socket
-        close-fd
+        close-port
         add-accept-io-task
         accept-fd
         can-read-line?
@@ -234,6 +235,7 @@ IN: cross-compiler
         can-write?
         add-write-io-task
         write-fd-8
+        add-copy-io-task
         next-io-task
         room
         os-env

diff --git a/library/files.factor b/library/files.factor
index d5026d5917c748389c9daa580fa235deeb5e5ce0..73f7f607fbdab47d95746fd7968a6a9ea84e2d60 100644 (file)
--- a/library/files.factor
+++ b/library/files.factor
@@ -45,19 +45,20 @@ USE: strings
     file-extension mime-types assoc [ "text/plain" ] unless* ;
 
 [
-    [ "html"   | "text/html"                ]
-    [ "txt"    | "text/plain"               ]
-                                           
-    [ "gif"    | "image/gif"                ]
-    [ "png"    | "image/png"                ]
-    [ "jpg"    | "image/jpeg"               ]
-    [ "jpeg"   | "image/jpeg"               ]
-               
-    [ "jar"    | "application/octet-stream" ]
-    [ "zip"    | "application/octet-stream" ]
-    [ "tgz"    | "application/octet-stream" ]
-    [ "tar.gz" | "application/octet-stream" ]
-    [ "gz"     | "application/octet-stream" ]
-      
-    [ "factor" | "application/x-factor"     ]
+    [ "html"   | "text/html"                        ]
+    [ "txt"    | "text/plain"                       ]
+                                                    
+    [ "gif"    | "image/gif"                        ]
+    [ "png"    | "image/png"                        ]
+    [ "jpg"    | "image/jpeg"                       ]
+    [ "jpeg"   | "image/jpeg"                       ]
+                                                    
+    [ "jar"    | "application/octet-stream"         ]
+    [ "zip"    | "application/octet-stream"         ]
+    [ "tgz"    | "application/octet-stream"         ]
+    [ "tar.gz" | "application/octet-stream"         ]
+    [ "gz"     | "application/octet-stream"         ]
+                                                    
+    [ "factor" | "application/x-factor"             ]
+    [ "factsp" | "application/x-factor-server-page" ]
 ] set-mime-types

diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor
index 983dc74b07dec7cc9d6ec3b054680ffe149b8da9..10ff88b2f4f4896a00d25acc433452ca868da516 100644 (file)
--- a/library/httpd/default-responders.factor
+++ b/library/httpd/default-responders.factor
@@ -53,12 +53,12 @@ USE: wiki-responder
             "quit" "responder" set
             [ quit-responder ] "get" set
         ] extend "quit" set
-!
-!        <responder> [
-!            "file" "responder" set
-!            [ file-responder ] "get" set
-!        ] extend "file" set
-!
+ 
+         <responder> [
+             "file" "responder" set
+             [ file-responder ] "get" set
+         ] extend "file" set
+ 
 !        <responder> [
 !            "wiki" "responder" set
 !            [ wiki-get-responder ] "get" set

diff --git a/library/httpd/file-responder.factor b/library/httpd/file-responder.factor
index 261139be3f8c0242295b3219a352d25d0fec07b8..55fa916320d3edc7437576577f442ed07579fc79 100644 (file)
--- a/library/httpd/file-responder.factor
+++ b/library/httpd/file-responder.factor
@@ -1,4 +1,4 @@
-! :folding=indent:collapseFolds=0:
+! :folding=indent:collapseFolds=1:
 
 ! $Id$
 !
@@ -27,82 +27,45 @@
 
 IN: file-responder
 USE: combinators
-USE: html
+USE: errors
 USE: kernel
-USE: lists
 USE: files
+USE: httpd
+USE: httpd-responder
 USE: namespaces
 USE: parser
-USE: regexp
 USE: stack
 USE: stdio
 USE: streams
 USE: strings
 
-USE: httpd
-USE: httpd-responder
-
-!!! Serving files.
-: file-header ( filename -- header )
-    "200 Document follows" swap mime-type response ;
-
-: serve-file ( filename -- )
-    dup file-header print <filebr> "stdio" get fcopy ;
-
-!!! Serving directories.
-: file>html ( filename -- ... )
-    "<li><a href=\"" swap
-    ! dup directory? [ "/" cat2 ] when
-    chars>entities
-    "\">" over "</a></li>" ;
-
-: directory>html ( directory -- html )
-    directory [ file>html ] map cat ;
+: parse-object-name ( filename -- argument filename )
+    dup [ "?" split1 swap ] [ "/" ] ifte
+    "doc-root" get swap cat2 ;
 
-: list-directory ( directory -- )
-    serving-html
-    [
-        "<html><head><title>" swap
-        "</title></head><body><h1>" over
-        "</h1><ul>" over
-        directory>html
-        "</ul></body></html>"
-    ] cons expand cat write ;
+: serve-script ( argument filename -- )
+    [ swap "argument" set run-file ] with-scope ;
 
-: serve-directory ( directory -- )
-    dup "/index.html" cat2 dup exists? [
-        nip serve-file
-    ] [
-        drop list-directory
-    ] ifte ;
+: file-header ( mime-type -- header )
+    "200 Document follows" swap response ;
 
-!!! Serving objects.
-: serve-static ( filename -- )
-    dup directory? [
-        serve-directory
-    ] [
-        serve-file
-    ] ifte ;
+: copy-and-close ( from -- )
+    [ dupd "stdio" get fcopy ] [ >r fclose r> rethrow ] catch ;
 
-: serve-script ( argument filename -- )
-    [ swap "argument" set run-file ] with-scope ;
+: serve-static ( argument filename mime-type -- )
+    file-header print <filebr> "stdio" get fcopy drop ;
 
-: parse-object-name ( filename -- argument filename )
-    dup [
-        dup "(.*?)\\?(.*)" groups dup [ nip call ] when swap
+: serve-file ( argument filename -- )
+    dup mime-type dup "application/x-factor-server-page" = [
+        drop serve-script
     ] [
-        drop f "/"
+        serve-static
     ] ifte ;
 
 : file-responder ( filename -- )
     "doc-root" get [
-        parse-object-name "doc-root" get swap cat2
-        dup exists? [
-            dup file-extension "lhtml" = [
-                serve-script
-            ] [
-                nip serve-static
-            ] ifte
+        parse-object-name dup exists? [
+            serve-file
         ] [
             2drop "404 not found" httpd-error
         ] ifte

diff --git a/library/platform/jvm/stream.factor b/library/platform/jvm/stream.factor
index 5f2821a589311fecb14abf0aea16f1b7917b7d0b..98a3b32e03f54875bd7c42f0af9d2fec2b8c95f6 100644 (file)
--- a/library/platform/jvm/stream.factor
+++ b/library/platform/jvm/stream.factor
@@ -37,7 +37,8 @@ USE: stack
 USE: strings
 
 : fcopy ( from to -- )
-    ! Copy the contents of the byte-stream 'from' to the byte-stream 'to'.
+    #! Copy the contents of the byte-stream 'from' to the
+    #! byte-stream 'to'.
     [ [ "in" get ] bind ] dip
     [ "out" get ] bind
     [ "java.io.InputStream" "java.io.OutputStream" ]

diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor
index 89984a5b3e6f177c80acca4e5b4771538057aa4e..df0f8f8435ebb675a2821e46fa46f3307ffce356 100644 (file)
--- a/library/platform/native/boot-stage2.factor
+++ b/library/platform/native/boot-stage2.factor
@@ -117,6 +117,7 @@ USE: stdio
     "/library/httpd/http-common.factor"
     "/library/httpd/responder.factor"
     "/library/httpd/httpd.factor"
+    "/library/httpd/file-responder.factor"
     "/library/httpd/inspect-responder.factor"
     "/library/httpd/test-responder.factor"
     "/library/httpd/quit-responder.factor"

diff --git a/library/platform/native/io-internals.factor b/library/platform/native/io-internals.factor
index bfc7ea49877298e284fc980e2d2c4e8e2eed8250..ffd6a26c5634cdf2640b1c55713273d15fc0fd1e 100644 (file)
--- a/library/platform/native/io-internals.factor
+++ b/library/platform/native/io-internals.factor
@@ -36,30 +36,29 @@ USE: threads
 
 : stdin 0 getenv ;
 : stdout 1 getenv ;
-: stderr 2 getenv ;
 
-: flush-fd ( port -- )
-    [ swap add-write-io-task (yield) ] callcc0 drop ;
+: blocking-flush ( port -- )
+    [ add-write-io-task (yield) ] callcc0 drop ;
 
 : wait-to-write ( len port -- )
-    tuck can-write? [ drop ] [ flush-fd ] ifte ;
+    tuck can-write? [ drop ] [ blocking-flush ] ifte ;
 
 : blocking-write ( str port -- )
     over
     dup string? [ str-length ] [ drop 1 ] ifte
     over wait-to-write write-fd-8 ;
 
-: fill-fd ( port -- )
-    [ swap add-read-line-io-task (yield) ] callcc0 drop ;
+: blocking-fill ( port -- )
+    [ add-read-line-io-task (yield) ] callcc0 drop ;
 
 : wait-to-read-line ( port -- )
-    dup can-read-line? [ drop ] [ fill-fd ] ifte ;
+    dup can-read-line? [ drop ] [ blocking-fill ] ifte ;
 
 : blocking-read-line ( port -- line )
     dup wait-to-read-line read-line-fd-8 dup [ sbuf>str ] when ;
 
 : fill-fd# ( count port -- )
-    [ -rot add-read-count-io-task (yield) ] callcc0 2drop ;
+    [ add-read-count-io-task (yield) ] callcc0 2drop ;
 
 : wait-to-read# ( count port -- )
     2dup can-read-count? [ 2drop ] [ fill-fd# ] ifte ;
@@ -68,7 +67,10 @@ USE: threads
     2dup wait-to-read# read-count-fd-8 dup [ sbuf>str ] when ;
 
 : wait-to-accept ( socket -- )
-    [ swap add-accept-io-task (yield) ] callcc0 drop ;
+    [ add-accept-io-task (yield) ] callcc0 drop ;
 
 : blocking-accept ( socket -- host port in out )
     dup wait-to-accept accept-fd ;
+
+: blocking-copy ( in out -- )
+    [ add-copy-io-task (yield) ] callcc0 ;

diff --git a/library/platform/native/network.factor b/library/platform/native/network.factor
index 414c0a20f5e96334beaec3513ed0ae1cb6cbd627..59975e50bb1079732017c256d2c10e5048f4d570 100644 (file)
--- a/library/platform/native/network.factor
+++ b/library/platform/native/network.factor
@@ -46,7 +46,7 @@ USE: unparser
         "socket" set
 
         ( -- )
-        [ "socket" get close-fd ] "fclose" set
+        [ "socket" get close-port ] "fclose" set
     ] extend ;
 
 : <client-stream> ( host port in out -- stream )

diff --git a/library/platform/native/stream.factor b/library/platform/native/stream.factor
index 7286ac4a4f088ea2c4a867443ea8aa1d4a566e87..074f0fd15f49ea631ad7ffc0fed6972258e86d90 100644 (file)
--- a/library/platform/native/stream.factor
+++ b/library/platform/native/stream.factor
@@ -56,12 +56,12 @@ USE: namespaces
         ] "fread#" set
         
         ( -- )
-        [ "out" get [ flush-fd ] when* ] "fflush" set
+        [ "out" get [ blocking-flush ] when* ] "fflush" set
         
         ( -- )
         [
-            "out" get [ dup flush-fd close-fd ] when*
-            "in" get [ close-fd ] when*
+            "out" get [ dup blocking-flush close-port ] when*
+            "in" get [ close-port ] when*
         ] "fclose" set
     ] extend ;
 
@@ -83,3 +83,8 @@ USE: namespaces
 : exists? ( file -- ? )
     #! This is terrible.
     [ <filebr> fclose t ] [ nip not ] catch ;
+
+: fcopy ( from to -- )
+    #! Copy the contents of the fd-stream 'from' to the
+    #! fd-stream 'to'.
+    "out" swap get* >r "in" swap get* r> blocking-copy ;

diff --git a/library/platform/native/threads.factor b/library/platform/native/threads.factor
index 3822b73cae64859235520513643f9af1c179a09b..23b8ef35b97e3394cb3c7c97356ceeef7586a260 100644 (file)
--- a/library/platform/native/threads.factor
+++ b/library/platform/native/threads.factor
@@ -57,15 +57,15 @@ USE: stack
     #! If there is a quotation in the run queue, call it,
     #! otherwise wait for I/O. The currently executing
     #! continuation is suspended. Use yield instead.
-    next-thread dup [
+    next-thread [
         call
     ] [
-        drop next-io-task dup [
+        next-io-task [
             call
         ] [
-            drop (yield)
-        ] ifte
-    ] ifte ;
+            (yield)
+        ] ifte*
+    ] ifte* ;
 
 : yield ( -- )
     #! Add the current continuation to the run queue, and yield

diff --git a/library/test/httpd/httpd.factor b/library/test/httpd/httpd.factor
index 26ffc33a073594d8b507a4a118d86f7bf4ac0ffa..64d12c377606894a4968cefe8e0a04e9e2e49e6a 100644 (file)
--- a/library/test/httpd/httpd.factor
+++ b/library/test/httpd/httpd.factor
@@ -1,4 +1,5 @@
 IN: scratchpad
+USE: file-responder
 USE: httpd
 USE: httpd-responder
 USE: logging
@@ -66,3 +67,24 @@ USE: url-encoding
 [ [ [ "Foo" | "Bar" ] ] ] [ "Foo=Bar" post-request>alist ] unit-test
 [ [ [ "Foo" | "Bar" ] [ "Baz" | "Quux" ] ] ]
 [ "Foo=Bar&Baz=Quux" post-request>alist ] unit-test
+
+[ f "/foo/hello.html" ] [
+    [
+        "/foo/" "doc-root" set
+        "hello.html" parse-object-name
+    ] with-scope
+] unit-test
+
+[ "some-arg" "/foo/hello.html" ] [
+    [
+        "/foo/" "doc-root" set
+        "hello.html?some-arg" parse-object-name
+    ] with-scope
+] unit-test
+
+[ f "/foo/" ] [
+    [
+        "/foo" "doc-root" set
+        f parse-object-name
+    ] with-scope
+] unit-test

diff --git a/native/float.c b/native/float.c
index de096fe32f531303650ad2547cb8436d57456072..d7ac05ba5aac2e76f7e506c622a17f59f7142a4a 100644 (file)
--- a/native/float.c
+++ b/native/float.c
@@ -45,7 +45,7 @@ void primitive_str_to_float(void)
 void primitive_float_to_str(void)
 {
        char tmp[33];
-       snprintf(&tmp,32,"%.16g",to_float(dpeek())->n);
+       snprintf(tmp,32,"%.16g",to_float(dpeek())->n);
        tmp[32] = '\0';
        drepl(tag_object(from_c_string(tmp)));
 }

diff --git a/native/gc.c b/native/gc.c
index ac2f96c2bbac6ecea7d87ed68087f4d15a736632..6ff2f934133caa75cf17f0fc274810f705fb49ca 100644 (file)
--- a/native/gc.c
+++ b/native/gc.c
@@ -2,7 +2,7 @@
 
 /* Stop-and-copy garbage collection using Cheney's algorithm. */
 
-/* #define GC_DEBUG /* */
+/* #define GC_DEBUG */
 
 INLINE void gc_debug(char* msg, CELL x) {
 #ifdef GC_DEBUG

diff --git a/native/io.c b/native/io.c
index 1a57219365bfe39ee5c5e08a378b7f428c6da049..af153e3c83e99bc2467b1eeccd54377dd7d5400e 100644 (file)
--- a/native/io.c
+++ b/native/io.c
@@ -28,18 +28,20 @@ void init_io(void)
 
 IO_TASK* add_io_task(
        IO_TASK_TYPE type,
-       PORT* port,
+       CELL port,
+       CELL other_port,
        CELL callback,
        IO_TASK* io_tasks,
        int* fd_count)
 {
-       int fd = port->fd;
+       int fd = untag_port(port)->fd;
 
        if(io_tasks[fd].callbacks != F && type != IO_TASK_WRITE)
-               general_error(ERROR_IO_TASK_TWICE,tag_object(port));
+               general_error(ERROR_IO_TASK_TWICE,port);
 
        io_tasks[fd].type = type;
-       io_tasks[fd].port = tag_object(port);
+       io_tasks[fd].port = port;
+       io_tasks[fd].other_port = other_port;
        io_tasks[fd].callbacks = tag_cons(cons(callback,
                io_tasks[fd].callbacks));
 
@@ -49,14 +51,6 @@ IO_TASK* add_io_task(
        return &io_tasks[fd];
 }
 
-void primitive_add_accept_io_task(void)
-{
-       PORT* port = untag_port(dpop());
-       CELL callback = dpop();
-       add_io_task(IO_TASK_ACCEPT,port,callback,
-               read_io_tasks,&read_fd_count);
-}
-
 void remove_io_task(
        IO_TASK_TYPE type,
        PORT* port,
@@ -66,6 +60,7 @@ void remove_io_task(
        int fd = port->fd;
 
        io_tasks[fd].port = F;
+       io_tasks[fd].other_port = F;
        io_tasks[fd].callbacks = F;
 
        if(fd == *fd_count - 1)
@@ -80,6 +75,55 @@ void remove_io_tasks(PORT* port)
                write_io_tasks,&write_fd_count);
 }
 
+bool perform_copy_from_io_task(PORT* port, PORT* other_port)
+{
+       if(port->buf_fill == 0)
+       {
+               if(read_step(port))
+               {
+                       /* EOF? */
+                       if(port->buf_fill == 0)
+                               return true;
+               }
+               else
+                       return false;
+       }
+
+       if(can_write(other_port,port->buf_fill))
+       {
+               write_string_raw(other_port,
+                       (char*)(port->buffer + 1),
+                       port->buf_fill);
+               port->buf_pos = port->buf_fill = 0;
+       }
+
+       return false;
+}
+
+bool perform_copy_to_io_task(PORT* port, PORT* other_port)
+{
+       bool success = perform_write_io_task(port);
+       /* only return 'true' if the COPY_FROM task is done also. */
+       if(read_io_tasks[other_port->fd].port == F)
+               return success;
+       else
+               return false;
+}
+
+void primitive_add_copy_io_task(void)
+{
+       CELL callback = dpop();
+       CELL to = dpop();
+       CELL from = dpop();
+       /* callback for COPY_FROM is F since we only care about
+       when BOTH tasks are done, and this is taken care of by
+       COPY_TO. */
+       add_io_task(IO_TASK_COPY_FROM,from,to,F,
+               read_io_tasks,&read_fd_count);
+       add_io_task(IO_TASK_COPY_TO,to,from,callback,
+               write_io_tasks,&write_fd_count);
+}
+
 bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks)
 {
        bool retval = false;
@@ -134,6 +178,14 @@ CELL perform_io_task(IO_TASK* io_task, IO_TASK* io_tasks, int* fd_count)
        case IO_TASK_ACCEPT:
                success = accept_connection(port);
                break;
+       case IO_TASK_COPY_FROM:
+               success = perform_copy_from_io_task(port,
+                       untag_port(io_task->other_port));
+               break;
+       case IO_TASK_COPY_TO:
+               success = perform_copy_to_io_task(port,
+                       untag_port(io_task->other_port));
+               break;
        default:
                critical_error("Bad I/O task",io_task->type);
                success = false;

diff --git a/native/io.h b/native/io.h
index 31a792131de69a58d6ee319c9ab02e2e6e6090e4..caea9e16d52fae76f70a3ab97cf0a0798c0a15cb 100644 (file)
--- a/native/io.h
+++ b/native/io.h
@@ -4,12 +4,16 @@ typedef enum {
        IO_TASK_READ_LINE,
        IO_TASK_READ_COUNT,
        IO_TASK_WRITE,
-       IO_TASK_ACCEPT
+       IO_TASK_ACCEPT,
+       IO_TASK_COPY_FROM,
+       IO_TASK_COPY_TO
 } IO_TASK_TYPE;
 
 typedef struct {
        IO_TASK_TYPE type;
        CELL port;
+       /* Used for COPY_FROM and COPY_TO only */
+       CELL other_port;
        /* TAGGED list of callbacks, or F */
        /* Multiple callbacks per port are only permitted for IO_TASK_WRITE. */
        CELL callbacks;
@@ -29,17 +33,20 @@ void init_io_tasks(fd_set* fd_set, IO_TASK* io_tasks);
 void init_io(void);
 IO_TASK* add_io_task(
        IO_TASK_TYPE type,
-       PORT* port,
+       CELL port,
+       CELL other_port,
        CELL callback,
        IO_TASK* io_tasks,
        int* fd_count);
-void primitive_add_accept_io_task(void);
 void remove_io_task(
        IO_TASK_TYPE type,
        PORT* port,
        IO_TASK* io_tasks,
        int* fd_count);
 void remove_io_tasks(PORT* port);
+bool perform_copy_from_io_task(PORT* port, PORT* other_port);
+bool perform_copy_to_io_task(PORT* port, PORT* other_port);
+void primitive_add_copy_io_task(void);
 CELL pop_io_task_callback(
        IO_TASK_TYPE type,
        PORT* port,

diff --git a/native/primitives.c b/native/primitives.c
index f2fadc14bcd97b162047b73b230821d5d4cd541e..27d558e6e40a2fa82429a017e1f922e83b0af9bc 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -129,6 +129,7 @@ XT primitives[] = {
        primitive_can_write,
        primitive_add_write_io_task,
        primitive_write_8,
+       primitive_add_copy_io_task,
        primitive_next_io_task,
        primitive_room,
        primitive_os_env,

diff --git a/native/primitives.h b/native/primitives.h
index baeaa8997b58e4a658321a683cdcb3ee06ba0162..9990a9d11ebe2ee9c1cf058d020ac954e1329d3b 100644 (file)
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 140
+#define PRIMITIVE_COUNT 141
 
 CELL primitive_to_xt(CELL primitive);

diff --git a/native/read.c b/native/read.c
index b4f89fae15978eea2ed90c22697bdab3bdf05d14..5430798896e4e1717ccb77f491034a7e526ccc5c 100644 (file)
--- a/native/read.c
+++ b/native/read.c
@@ -107,12 +107,12 @@ void primitive_can_read_line(void)
 
 void primitive_add_read_line_io_task(void)
 {
-       PORT* port = untag_port(dpop());
        CELL callback = dpop();
-       add_io_task(IO_TASK_READ_LINE,port,callback,
+       CELL port = dpop();
+       add_io_task(IO_TASK_READ_LINE,port,F,callback,
                read_io_tasks,&read_fd_count);
 
-       init_line_buffer(port,LINE_SIZE);
+       init_line_buffer(untag_port(port),LINE_SIZE);
 }
 
 bool perform_read_line_io_task(PORT* port)
@@ -206,10 +206,11 @@ void primitive_can_read_count(void)
 
 void primitive_add_read_count_io_task(void)
 {
+       CELL callback = dpop();
        PORT* port = untag_port(dpop());
        FIXNUM count = to_fixnum(dpop());
-       CELL callback = dpop();
-       add_io_task(IO_TASK_READ_COUNT,port,callback,
+       add_io_task(IO_TASK_READ_COUNT,
+               tag_object(port),F,callback,
                read_io_tasks,&read_fd_count);
 
        port->count = count;

diff --git a/native/socket.c b/native/socket.c
index a055eeaf7fecb5760a06ddbb5cac81211b3b5796..f1ca82e91498396d09c9fdfeeb9a930ff4016933 100644 (file)
--- a/native/socket.c
+++ b/native/socket.c
@@ -94,6 +94,14 @@ void primitive_server_socket(void)
        dpush(tag_object(port(PORT_SPECIAL,make_server_socket(p))));
 }
 
+void primitive_add_accept_io_task(void)
+{
+       CELL callback = dpop();
+       CELL port = dpop();
+       add_io_task(IO_TASK_ACCEPT,port,F,callback,
+               read_io_tasks,&read_fd_count);
+}
+
 CELL accept_connection(PORT* p)
 {
        struct sockaddr_in clientname;

diff --git a/native/socket.h b/native/socket.h
index 33122d26c8dfa47ca3f3b61ea208ed34f8ec6027..3123c8ae5b0d2551f6b0f6f21f1e22bba5ae2336 100644 (file)
--- a/native/socket.h
+++ b/native/socket.h
@@ -4,5 +4,6 @@ int make_client_socket(const char* hostname, uint16_t port);
 void primitive_client_socket(void);
 int make_server_socket(uint16_t port);
 void primitive_server_socket(void);
+void primitive_add_accept_io_task(void);
 CELL accept_connection(PORT* p);
 void primitive_accept_fd(void);

diff --git a/native/write.c b/native/write.c
index 6821e03f85764d72e7ad3f0a48d3a19ef08a969c..655abc8fc087f23148dd73f0240725676edec08b 100644 (file)
--- a/native/write.c
+++ b/native/write.c
@@ -56,9 +56,9 @@ void primitive_can_write(void)
 
 void primitive_add_write_io_task(void)
 {
-       PORT* port = untag_port(dpop());
        CELL callback = dpop();
-       add_io_task(IO_TASK_WRITE,port,callback,
+       CELL port = dpop();
+       add_io_task(IO_TASK_WRITE,port,F,callback,
                write_io_tasks,&write_fd_count);
 }
 
@@ -89,21 +89,26 @@ void write_char_8(PORT* port, FIXNUM ch)
        port->buf_fill++;
 }
 
+/* Caller must ensure buffer is of the right size. */
+void write_string_raw(PORT* port, char* str, CELL len)
+{
+       /* Append string to buffer */
+       memcpy((void*)((CELL)port->buffer + sizeof(STRING)
+               + port->buf_fill),str,len);
+
+       port->buf_fill += len;
+}
+
 void write_string_8(PORT* port, STRING* str)
 {
        char* c_str;
-
+       
        /* Note this ensures the buffer is large enough to fit the string */
        if(!can_write(port,str->capacity))
                io_error(__FUNCTION__);
 
        c_str = to_c_string(str);
-
-       /* Append string to buffer */
-       memcpy((void*)((CELL)port->buffer + sizeof(STRING)
-               + port->buf_fill),c_str,str->capacity);
-
-       port->buf_fill += str->capacity;
+       write_string_raw(port,c_str,str->capacity);
 }
 
 void primitive_write_8(void)
@@ -112,6 +117,7 @@ void primitive_write_8(void)
 
        CELL text = dpop();
        CELL type = type_of(text);
+       STRING* str;
 
        pending_io_error(port);
 
@@ -122,7 +128,8 @@ void primitive_write_8(void)
                write_char_8(port,to_fixnum(text));
                break;
        case STRING_TYPE:
-               write_string_8(port,untag_string(text));
+               str = untag_string(text);
+               write_string_8(port,str);
                break;
        default:
                type_error(STRING_TYPE,text);

diff --git a/native/write.h b/native/write.h
index 0efacb086ab207e4d41ae999e64f72d3c90127f6..f11ddea0ef08b86634f5119f7106413d4c87af42 100644 (file)
--- a/native/write.h
+++ b/native/write.h
@@ -4,5 +4,6 @@ void primitive_can_write(void);
 void primitive_add_write_io_task(void);
 bool perform_write_io_task(PORT* port);
 void write_char_8(PORT* port, FIXNUM ch);
+void write_string_raw(PORT* port, char* str, CELL len);
 void write_string_8(PORT* port, STRING* str);
 void primitive_write_8(void);