quit-responder fix, pointless and misguided type number rearrangement

diff --git a/Makefile b/Makefile
index e610263b2fc4e37edfe645f4abdab08b366e48b3..74edaaed171c670a02be19cf7702c40dd10f6183 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-CC = gcc
+CC = gcc34
 DEFAULT_CFLAGS = -Wall -export-dynamic -g $(SITE_CFLAGS)
 DEFAULT_LIBS = -lm
 

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index f102556402a1dc725e2a518390fe29300b778afb..63140a0205743c519851d2b742c071f4d93dc679 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,9 +1,6 @@
-FFI:\r
-\r
 - add a socket timeout\r
 - fix error postoning -- not all errors thrown by i/o code are\r
   postponed\r
-- quit responder breaks with multithreading\r
 \r
 + compiler/ffi:\r
 \r
@@ -39,7 +36,6 @@ FFI:
 \r
 + listener/plugin:\r
 \r
-- clean up listener's action popups\r
 - accept multi-line input in listener\r
 - don't show listener on certain commands\r
 - NPE in ErrorHighlight\r

diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor
index 4db94ea50990fcdef1b39a02867d4d74a78329e1..42c75fc2ba0e49c2b48754bb4c5676d6319a80b1 100644 (file)
--- a/library/httpd/httpd.factor
+++ b/library/httpd/httpd.factor
@@ -96,33 +96,16 @@ USE: url-encoding
     ] catch ;
 
 : httpd-connection ( socket -- )
-    #! We're single-threaded in Java Factor, and
-    #! multi-threaded in CFactor.
-    java? [
-        httpd-client
-    ] [
-        [
-            httpd-client
-        ] in-thread drop
-    ] ifte ;
+    "http-server" get accept [ httpd-client ] in-thread drop ;
 
-: quit-flag ( -- ? )
-    global [ "httpd-quit" get ] bind ;
-
-: clear-quit-flag ( -- )
-    global [ "httpd-quit" off ] bind ;
-
-: httpd-loop ( server -- server )
-    quit-flag [
-        dup dup accept httpd-connection
-        httpd-loop
-    ] unless ;
+: httpd-loop ( -- )
+    [ httpd-connection ] forever ;
 
 : (httpd) ( port -- )
-    <server> [
+    <server> "http-server" set [
         httpd-loop
     ] [
-        swap fclose clear-quit-flag rethrow
+        "http-server" get fclose rethrow
     ] catch ;
 
 : httpd ( port -- )

diff --git a/library/httpd/quit-responder.factor b/library/httpd/quit-responder.factor
index cb77914d981c638d0a77f2890113d0ddee1d2a9a..36d6ae03f6331884951414bb47bd5c68a2722e0a 100644 (file)
--- a/library/httpd/quit-responder.factor
+++ b/library/httpd/quit-responder.factor
@@ -27,12 +27,12 @@
 
 IN: quit-responder
 USE: combinators
-USE: namespaces
-USE: stdio
-USE: stack
-
 USE: httpd
 USE: httpd-responder
+USE: namespaces
+USE: stack
+USE: stdio
+USE: streams
 
 : quit-prohibited ( -- )
     "404 quit prohibited" httpd-error ;
@@ -43,5 +43,5 @@ USE: httpd-responder
     "quit-prohibited" get [
         quit-prohibited
     ] [
-        global [ t "httpd-quit" set ] bind
+        "http-server" get fclose
     ] ifte ;

diff --git a/library/image.factor b/library/image.factor
index 9f91b866b48cdbb2dcc9deb392dae9c38f40beb7..beaa71c3545c993fcba4cc6ac8a558365914b914 100644 (file)
--- a/library/image.factor
+++ b/library/image.factor
@@ -94,12 +94,10 @@ USE: words
 : f-type      6 ;
 : t-type      7 ;
 : array-type  8 ;
-: vector-type 9 ;
-: string-type 10 ;
-: sbuf-type   11 ;
-: handle-type 12 ;
-: bignum-type 13 ;
-: float-type  14 ;
+: bignum-type 9 ;
+: float-type  10 ;
+: vector-type 11 ;
+: string-type 12 ;
 
 : immediate ( x tag -- tagged ) swap tag-bits shift bitor ;
 : >header ( id -- tagged ) header-tag immediate ;

diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor
index 1761250818e3a9d5b373828c7f356e516ed46e26..aa73c4ca949dafd1bdbbf18a57fb9e4f7e19f44e 100644 (file)
--- a/library/platform/native/boot-stage2.factor
+++ b/library/platform/native/boot-stage2.factor
@@ -80,7 +80,7 @@ USE: stdio
 
     "/library/format.factor"
     "/library/platform/native/unparser.factor"
-    "/library/styles.factor"
+    "/library/presentation.factor"
     "/library/vocabulary-style.factor"
     "/library/prettyprint.factor"
     "/library/platform/native/debugger.factor"

diff --git a/library/platform/native/debugger.factor b/library/platform/native/debugger.factor
index e4f778cf1eef134662096a4f4f0b66e72cb944bd..4812bf14caac0c6a74e63a1207a1d8d4f528cc0f 100644 (file)
--- a/library/platform/native/debugger.factor
+++ b/library/platform/native/debugger.factor
@@ -106,6 +106,9 @@ USE: words
 : callstack-overflow-error ( obj -- )
     drop "Callstack overflow" print ;
 
+: port-closed-error ( obj -- )
+    "Port closed: " write . ;
+
 : kernel-error. ( obj n -- str )
     {
         expired-error
@@ -127,6 +130,7 @@ USE: words
         datastack-overflow-error
         callstack-underflow-error
         callstack-overflow-error
+        port-closed-error
     } vector-nth execute ;
 
 : kernel-error? ( obj -- ? )

diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor
index 04ea348da69bdf2ec10d23ef6f632d99fa53d6cc..4d16f46db8aab3b91bba617a60b6d1e0ae9697ef 100644 (file)
--- a/library/platform/native/kernel.factor
+++ b/library/platform/native/kernel.factor
@@ -59,23 +59,23 @@ USE: vectors
 : hashcode ( obj -- hash )
     #! If two objects are =, they must have equal hashcodes.
     {
-        nop
-        word-hashcode
-        cons-hashcode
-        default-hashcode
-        >fixnum
-        >fixnum
-        default-hashcode
-        default-hashcode
-        default-hashcode
-        vector-hashcode
-        str-hashcode
-        sbuf-hashcode
-        default-hashcode
-        >fixnum
-        >fixnum
-        default-hashcode
-        default-hashcode
+        nop                ! 0
+        word-hashcode      ! 1
+        cons-hashcode      ! 2
+        default-hashcode   ! 3
+        >fixnum            ! 4
+        >fixnum            ! 5
+        default-hashcode   ! 6
+        default-hashcode   ! 7
+        default-hashcode   ! 8
+        >fixnum            ! 9 
+        >fixnum            ! 10
+        vector-hashcode    ! 11
+        str-hashcode       ! 12
+        sbuf-hashcode      ! 13
+        default-hashcode   ! 14
+        default-hashcode   ! 15
+        default-hashcode   ! 16
     } generic ;
 
 IN: math DEFER: number= ( defined later... )
@@ -83,24 +83,24 @@ IN: kernel
 : = ( obj obj -- ? )
     #! Push t if a is isomorphic to b.
     {
-        number=
-        eq?
-        cons=
-        eq?
-        number=
-        number=
-        eq?
-        eq?
-        eq?
-        vector=
-        str=
-        sbuf=
-        eq?
-        number=
-        number=
-        eq?
-        eq?
-    } generic ;
+        number= ! 0
+        eq?     ! 1
+        cons=   ! 2
+        eq?     ! 3
+        number= ! 4
+        number= ! 5
+        eq?     ! 6
+        eq?     ! 7
+        eq?     ! 8
+        number= ! 9 
+        number= ! 10
+        vector= ! 11
+        str=    ! 12
+        sbuf=   ! 13
+        eq?     ! 14
+        eq?     ! 15 
+        eq?     ! 16
+    } generic ; 
 
 : 2= ( a b c d -- ? )
     #! Test if a = c, b = d.

diff --git a/library/platform/native/math.factor b/library/platform/native/math.factor
index b53c8e56e036a78eafc9dee3242f6f02961323bb..a39639c694fb70467cc6263466b5c174802abc14 100644 (file)
--- a/library/platform/native/math.factor
+++ b/library/platform/native/math.factor
@@ -97,12 +97,12 @@ USE: words
         (not-=)
         (not-=)
         (not-=)
+        bignum=
+        float=
         (not-=)
         (not-=)
         (not-=)
         (not-=)
-        bignum=
-        float=
         (not-=)
         (not-=)
     } 2generic ;
@@ -118,12 +118,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum+
+        float+
         no-method
         no-method
         no-method
         no-method
-        bignum+
-        float+
         no-method
         no-method
     } 2generic ;
@@ -139,12 +139,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum-
+        float-
         no-method
         no-method
         no-method
         no-method
-        bignum-
-        float-
         no-method
         no-method
     } 2generic ;
@@ -160,12 +160,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum*
+        float*
         no-method
         no-method
         no-method
         no-method
-        bignum*
-        float*
         no-method
         no-method
     } 2generic ;
@@ -181,12 +181,12 @@ USE: words
         no-method
         no-method
         no-method
+        ratio
+        float/f
         no-method
         no-method
         no-method
         no-method
-        ratio
-        float/f
         no-method
         no-method
     } 2generic ;
@@ -202,11 +202,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum/i
         no-method
         no-method
         no-method
         no-method
-        bignum/i
         no-method
         no-method
         no-method
@@ -223,12 +223,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum/f
+        float/f
         no-method
         no-method
         no-method
         no-method
-        bignum/f
-        float/f
         no-method
         no-method
     } 2generic ;
@@ -244,11 +244,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum-mod
         no-method
         no-method
         no-method
         no-method
-        bignum-mod
         no-method
         no-method
         no-method
@@ -265,11 +265,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum/mod
         no-method
         no-method
         no-method
         no-method
-        bignum/mod
         no-method
         no-method
         no-method
@@ -286,11 +286,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum-bitand
         no-method
         no-method
         no-method
         no-method
-        bignum-bitand
         no-method
         no-method
         no-method
@@ -307,11 +307,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum-bitor
         no-method
         no-method
         no-method
         no-method
-        bignum-bitor
         no-method
         no-method
         no-method
@@ -328,11 +328,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum-bitxor
         no-method
         no-method
         no-method
         no-method
-        bignum-bitxor
         no-method
         no-method
         no-method
@@ -349,11 +349,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum-bitnot
         no-method
         no-method
         no-method
         no-method
-        bignum-bitnot
         no-method
         no-method
         no-method
@@ -370,11 +370,11 @@ USE: words
         no-method
         no-method
         no-method
+        bignum-shift
         no-method
         no-method
         no-method
         no-method
-        bignum-shift
         no-method
         no-method
         no-method
@@ -391,12 +391,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum<
+        float<
         no-method
         no-method
         no-method
         no-method
-        bignum<
-        float<
         no-method
         no-method
     } 2generic ;
@@ -412,12 +412,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum<=
+        float<=
         no-method
         no-method
         no-method
         no-method
-        bignum<=
-        float<=
         no-method
         no-method
     } 2generic ;
@@ -433,12 +433,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum>
+        float>
         no-method
         no-method
         no-method
         no-method
-        bignum>
-        float>
         no-method
         no-method
     } 2generic ;
@@ -454,12 +454,12 @@ USE: words
         no-method
         no-method
         no-method
+        bignum>=
+        float>=
         no-method
         no-method
         no-method
         no-method
-        bignum>=
-        float>=
         no-method
         no-method
     } 2generic ;

diff --git a/library/platform/native/parse-syntax.factor b/library/platform/native/parse-syntax.factor
index b828507d84905876dc0073c6872c35b116f57fd1..9351a32196c0d403c470375496d45bd8a1797921 100644 (file)
--- a/library/platform/native/parse-syntax.factor
+++ b/library/platform/native/parse-syntax.factor
@@ -181,6 +181,7 @@ IN: syntax
 : #{
     #! Read #{ real imaginary #}
     scan str>number scan str>number rect> "}" expect parsed ;
+    parsing
 
 ! Comments
 : ( ")" until parsed-stack-effect ; parsing

diff --git a/library/platform/native/primitives.factor b/library/platform/native/primitives.factor
index 2a8d12c213e1feadde23f347798b8e5bd3bac149..858f743893235adadbd695cf812afca98cc47c34 100644 (file)
--- a/library/platform/native/primitives.factor
+++ b/library/platform/native/primitives.factor
@@ -180,7 +180,7 @@ USE: words
     [ client-socket          | " host port -- in out " ]
     [ server-socket          | " port -- server " ]
     [ close-port             | " port -- " ]
-    [ add-accept-io-task     | " callback server -- " ]
+    [ add-accept-io-task     | " server callback -- " ]
     [ accept-fd              | " server -- host port in out " ]
     [ can-read-line?         | " port -- ? " ]
     [ add-read-line-io-task  | " port callback -- " ]

diff --git a/library/platform/native/types.factor b/library/platform/native/types.factor
index daf245bb31b4f6a7ff391f1fd309a5e9da4dbdd6..0a7e681799902e098da61d5818f1bfb82aacaadd 100644 (file)
--- a/library/platform/native/types.factor
+++ b/library/platform/native/types.factor
@@ -32,12 +32,12 @@ IN: words        : word?    ( obj -- ? ) type 1  eq? ;
 IN: lists        : cons?    ( obj -- ? ) type 2  eq? ;
 IN: math         : ratio?   ( obj -- ? ) type 4  eq? ;
 IN: math         : complex? ( obj -- ? ) type 5  eq? ;
-IN: vectors      : vector?  ( obj -- ? ) type 9  eq? ;
-IN: strings      : string?  ( obj -- ? ) type 10 eq? ;
-IN: strings      : sbuf?    ( obj -- ? ) type 11 eq? ;
-IN: io-internals : port?    ( obj -- ? ) type 12 eq? ;
-IN: math         : bignum?  ( obj -- ? ) type 13 eq? ;
-IN: math         : float?   ( obj -- ? ) type 14 eq? ;
+IN: math         : bignum?  ( obj -- ? ) type 9  eq? ;
+IN: math         : float?   ( obj -- ? ) type 10 eq? ;
+IN: vectors      : vector?  ( obj -- ? ) type 11 eq? ;
+IN: strings      : string?  ( obj -- ? ) type 12 eq? ;
+IN: strings      : sbuf?    ( obj -- ? ) type 13 eq? ;
+IN: io-internals : port?    ( obj -- ? ) type 14 eq? ;
 IN: alien        : dll?     ( obj -- ? ) type 15 eq? ;
 IN: alien        : alien?   ( obj -- ? ) type 16 eq? ;
 
@@ -54,12 +54,12 @@ IN: kernel
         [ 6 | "f" ]
         [ 7 | "t" ]
         [ 8 | "array" ]
-        [ 9 | "vector" ]
-        [ 10 | "string" ]
-        [ 11 | "sbuf" ]
-        [ 12 | "port" ]
-        [ 13 | "bignum" ]
-        [ 14 | "float" ]
+        [ 9 | "bignum" ]
+        [ 10 | "float" ]
+        [ 11 | "vector" ]
+        [ 12 | "string" ]
+        [ 13 | "sbuf" ]
+        [ 14 | "port" ]
         [ 15 | "dll" ]
         [ 16 | "alien" ]
         ! These values are only used by the kernel for error

diff --git a/library/platform/native/unparser.factor b/library/platform/native/unparser.factor
index b64e58447863e8e7027900d4acacce7986b4d636..8c724811131318767257828308e514ef9e2a8279 100644 (file)
--- a/library/platform/native/unparser.factor
+++ b/library/platform/native/unparser.factor
@@ -133,12 +133,12 @@ DEFER: unparse
         unparse-f
         unparse-t
         unparse-unknown
+        >dec
+        unparse-float
         unparse-unknown
         unparse-str
         unparse-unknown
         unparse-unknown
-        >dec
-        unparse-float
         unparse-unknown
         unparse-unknown
     } generic ;

diff --git a/library/presentation.factor b/library/presentation.factor
index 9b174a1840730c8e82c39abf78633cac82239179..15c9f8ea63d188a321fb3666de3c1e73c2aad206 100644 (file)
--- a/library/presentation.factor
+++ b/library/presentation.factor
@@ -46,8 +46,7 @@ USE: unparser
 
 : (style) ( name -- style ) "styles" get get* ;
 : default-style ( -- style ) "default" (style) ;
-: style ( name -- style )
-    (style) [ default-style ] unless* ;
+: style ( name -- style ) (style) [ default-style ] unless* ;
 : set-style ( style name -- ) "styles" get set* ;
 
 <namespace> "styles" set

diff --git a/library/vocabulary-style.factor b/library/vocabulary-style.factor
index e974a05c9c5f48e098308edfb0ff83f15b609b21..b8578cbd7dc07077240257c3d08ede7a26048f00 100644 (file)
--- a/library/vocabulary-style.factor
+++ b/library/vocabulary-style.factor
@@ -25,13 +25,13 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-IN: words
+IN: presentation
 USE: combinators
 USE: lists
 USE: kernel
 USE: namespaces
 USE: stack
-USE: presentation
+USE: words
 
 : vocab-style ( vocab -- style )
     #! Each vocab has a style object specifying how words are

diff --git a/native/arithmetic.c b/native/arithmetic.c
index 4bf226947eb94d4cb2851a529596342041e1241a..66d497131c7c98527241621e8068434939df3ad2 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -4,6 +4,7 @@ CELL arithmetic_type(CELL obj1, CELL obj2)
 {
        CELL type1 = type_of(obj1);
        CELL type2 = type_of(obj2);
+
        CELL type;
 
        switch(type1)

diff --git a/native/error.c b/native/error.c
index 08aab5bbaa29b19223f14be8299a742b64e4a0a5..84932d7b7c23ccd483618b428601bdb43d0e1592 100644 (file)
--- a/native/error.c
+++ b/native/error.c
@@ -31,7 +31,7 @@ void primitive_throw(void)
 void general_error(CELL error, CELL tagged)
 {
        CELL c = cons(error,cons(tagged,F));
-       if(userenv[BREAK_ENV] == 0)
+       if(userenv[BREAK_ENV] == F)
        {
                /* Crash at startup */
                fprintf(stderr,"Error thrown before BREAK_ENV set\n");

diff --git a/native/error.h b/native/error.h
index c5cad745713b658e19bbea8032b705cab57e37ce..2b6dda1b5ac6a899fb146c2d02c0c4e8fa6ab07d 100644 (file)
--- a/native/error.h
+++ b/native/error.h
@@ -17,6 +17,7 @@
 #define ERROR_DATASTACK_OVERFLOW (16<<3)
 #define ERROR_CALLSTACK_UNDERFLOW (17<<3)
 #define ERROR_CALLSTACK_OVERFLOW (18<<3)
+#define ERROR_CLOSED (19<<3)
 
 void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);

diff --git a/native/io.c b/native/io.c
index 716c89515789d6d24d14013263715b0ae4012367..ad94011bb353447bb7679b00bb2ee8bf8f64eddc 100644 (file)
--- a/native/io.c
+++ b/native/io.c
@@ -52,7 +52,6 @@ IO_TASK* add_io_task(
 }
 
 void remove_io_task(
-       IO_TASK_TYPE type,
        PORT* port,
        IO_TASK* io_tasks,
        int* fd_count)
@@ -67,14 +66,6 @@ void remove_io_task(
                *fd_count = *fd_count - 1;
 }
 
-void remove_io_tasks(PORT* port)
-{
-       remove_io_task(IO_TASK_READ_LINE,port,
-               read_io_tasks,&read_fd_count);
-       remove_io_task(IO_TASK_WRITE,port,
-               write_io_tasks,&write_fd_count);
-}
-
 bool perform_copy_from_io_task(PORT* port, PORT* other_port)
 {
        if(port->buf_fill == 0)
@@ -124,7 +115,9 @@ void primitive_add_copy_io_task(void)
                write_io_tasks,&write_fd_count);
 }
 
-bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks)
+/* We set closed to true if there are closed fd's in the set. */
+bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks,
+       bool* closed)
 {
        bool retval = false;
        int i;
@@ -135,6 +128,8 @@ bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks)
        {
                if(typep(PORT_TYPE,io_tasks[i].port))
                {
+                       if(untag_port(io_tasks[i].port)->closed)
+                               *closed = true;
                        retval = true;
                        FD_SET(i,fdset);
                }
@@ -153,7 +148,7 @@ CELL pop_io_task_callback(
        CONS* callbacks = untag_cons(io_tasks[fd].callbacks);
        CELL callback = callbacks->car;
        if(callbacks->cdr == F)
-               remove_io_task(type,port,io_tasks,fd_count);
+               remove_io_task(port,io_tasks,fd_count);
        else
                io_tasks[fd].callbacks = callbacks->cdr;
        return callback;
@@ -208,13 +203,26 @@ CELL perform_io_tasks(fd_set* fdset, IO_TASK* io_tasks, int* fd_count)
 
        for(i = 0; i < *fd_count; i++)
        {
+               IO_TASK io_task = io_tasks[i];
+
+               if(typep(PORT_TYPE,io_task.port))
+               {
+                       PORT* port = untag_port(io_task.port);
+                       if(port->closed)
+                       {
+                               return pop_io_task_callback(
+                                       io_task.type,port,
+                                       io_tasks,fd_count);
+                       }
+               }
+
                if(FD_ISSET(i,fdset))
                {
-                       if(io_tasks[i].port == F)
+                       if(io_task.port == F)
                                critical_error("select() returned fd for non-existent task",i);
                        else
                        {
-                               callback = perform_io_task(&io_tasks[i],
+                               callback = perform_io_task(&io_task,
                                        io_tasks,fd_count);
                                if(callback != F)
                                        return callback;
@@ -230,26 +238,34 @@ CELL next_io_task(void)
 {
        CELL callback;
 
+       bool closed = false;
+
        bool reading = set_up_fd_set(&read_fd_set,
-               read_fd_count,read_io_tasks);
+               read_fd_count,read_io_tasks,&closed);
 
        bool writing = set_up_fd_set(&write_fd_set,
-               write_fd_count,write_io_tasks);
+               write_fd_count,write_io_tasks,&closed);
 
-       if(!reading && !writing)
+       if(!reading && !writing && !closed)
                general_error(ERROR_IO_TASK_NONE,F);
 
-       set_up_fd_set(&except_fd_set,
-               read_fd_count,read_io_tasks);
+       set_up_fd_set(&except_fd_set,read_fd_count,read_io_tasks,&closed);
+
+       if(!closed)
+       {
+               select(read_fd_count > write_fd_count
+                       ? read_fd_count : write_fd_count,
+                       &read_fd_set,&write_fd_set,&except_fd_set,NULL);
+       }
+
+       callback = perform_io_tasks(&read_fd_set,
+               read_io_tasks,&read_fd_count);
 
-       select(read_fd_count > write_fd_count ? read_fd_count : write_fd_count,
-               &read_fd_set,&write_fd_set,&except_fd_set,NULL);
-       
-       callback = perform_io_tasks(&read_fd_set,read_io_tasks,&read_fd_count);
        if(callback != F)
                return callback;
 
-       return perform_io_tasks(&write_fd_set,write_io_tasks,&write_fd_count);
+       return perform_io_tasks(&write_fd_set,
+               write_io_tasks,&write_fd_count);
 }
 
 void primitive_next_io_task(void)
@@ -262,6 +278,7 @@ void primitive_close(void)
        /* This does not flush. */
        PORT* port = untag_port(dpop());
        close(port->fd);
+       port->closed = true;
 }
 
 void collect_io_tasks(void)

diff --git a/native/io.h b/native/io.h
index caea9e16d52fae76f70a3ab97cf0a0798c0a15cb..db87b6a9ab004d6da479ecd6e7201cccd5fda165 100644 (file)
--- a/native/io.h
+++ b/native/io.h
@@ -39,7 +39,6 @@ IO_TASK* add_io_task(
        IO_TASK* io_tasks,
        int* fd_count);
 void remove_io_task(
-       IO_TASK_TYPE type,
        PORT* port,
        IO_TASK* io_tasks,
        int* fd_count);
@@ -52,7 +51,8 @@ CELL pop_io_task_callback(
        PORT* port,
        IO_TASK* io_tasks,
        int* fd_count);
-bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks);
+bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks,
+       bool* closed);
 CELL perform_io_task(IO_TASK* io_task, IO_TASK* io_tasks, int* fd_count);
 CELL perform_io_tasks(fd_set* fdset, IO_TASK* io_tasks, int* fd_count);
 CELL next_io_task(void);

diff --git a/native/port.c b/native/port.c
index 5d4eb18916f29a16f02ac5c53398dfef050dd3c6..c19c09af3ac2eafeafe88c88d905e729762e311d 100644 (file)
--- a/native/port.c
+++ b/native/port.c
@@ -8,6 +8,8 @@ PORT* untag_port(CELL tagged)
        /* after image load & save, ports are no longer valid */
        if(p->fd == -1)
                general_error(ERROR_EXPIRED,tagged);
+       /* if(p->closed)
+               general_error(ERROR_CLOSED,tagged); */
        return p;
 }
 
@@ -15,6 +17,7 @@ PORT* port(PORT_MODE type, CELL fd)
 {
        PORT* port = allot_object(PORT_TYPE,sizeof(PORT));
        port->type = type;
+       port->closed = false;
        port->fd = fd;
        port->buffer = NULL;
        port->line = F;
@@ -91,6 +94,8 @@ void pending_io_error(PORT* port)
                port->io_error = F;
                general_error(ERROR_IO,io_error);
        }
+       else if(port->closed)
+               general_error(ERROR_CLOSED,tag_object(port));
 }
 
 void primitive_pending_io_error(void)

diff --git a/native/port.h b/native/port.h
index 4bcbd3aaea55a8128f90d132d0e27a873560f079..f60cd6c133001f5852f057d7b2f524c8e7c21bb6 100644 (file)
--- a/native/port.h
+++ b/native/port.h
@@ -1,11 +1,16 @@
 #define BUF_SIZE (8 * 1024)
 
-typedef enum { PORT_READ, PORT_RECV, PORT_WRITE, PORT_SPECIAL } PORT_MODE;
+typedef enum {
+       PORT_READ,
+       PORT_RECV,
+       PORT_WRITE,
+       PORT_SPECIAL
+} PORT_MODE;
 
 typedef struct {
        CELL header;
-       /* one of PORT_READ, PORT_RECV, PORT_WRITE or PORT_SPECIAL */
        PORT_MODE type;
+       bool closed;
        FIXNUM fd;
        STRING* buffer;
 

diff --git a/native/run.c b/native/run.c
index b0dd9ab66ad342ad8cbac49377cfcc5c055570ed..93e2a07b0e29ae54355f14fe53d6fbf824d15258 100644 (file)
--- a/native/run.c
+++ b/native/run.c
@@ -16,7 +16,7 @@ void run(void)
 
        /* Error handling. */
        sigsetjmp(toplevel, 1);
-       
+
        for(;;)
        {
                if(callframe == F)

diff --git a/native/run.h b/native/run.h
index c0a455d380d2f55576678538f89aa3f0839a4c6b..9e658ac5f9ec96b4ff42b823e771f87fb2cd0eb6 100644 (file)
--- a/native/run.h
+++ b/native/run.h
@@ -25,13 +25,23 @@ CELL callframe;
 CELL ds_bot;
 
 /* raw pointer to datastack top */
+/* #define X86_STACK */
+
+#ifdef X86_STACK
+register CELL ds asm("%esi");
+#else
 CELL ds;
+#endif
 
 /* raw pointer to callstack bottom */
 CELL cs_bot;
 
 /* raw pointer to callstack top */
+#ifdef X86_STACK
+register CELL cs asm("edi");
+#else
 CELL cs;
+#endif
 
 /* raw pointer to currently executing word */
 WORD* executing;

diff --git a/native/socket.c b/native/socket.c
index 5b5b59bd6c1124762e8e6b04c51620966177096c..061f9a9ecf62ef3b45c93f8677c6e6bb46a2c360 100644 (file)
--- a/native/socket.c
+++ b/native/socket.c
@@ -143,6 +143,7 @@ void primitive_accept_fd(void)
        PORT* p;
        maybe_garbage_collection();
        p = untag_port(dpop());
+       pending_io_error(p);
        dpush(p->client_host);
        dpush(p->client_port);
        dpush(tag_object(port(PORT_RECV,p->client_socket)));

diff --git a/native/types.h b/native/types.h
index c13d01e0c9c84b53ba43f6282ac0856684c88a59..00a00d3bc358a813ceb5f0874e8cdbd36c8a842e 100644 (file)
--- a/native/types.h
+++ b/native/types.h
@@ -25,12 +25,12 @@
 CELL T;
 
 #define ARRAY_TYPE 8
-#define VECTOR_TYPE 9
-#define STRING_TYPE 10
-#define SBUF_TYPE 11
-#define PORT_TYPE 12
-#define BIGNUM_TYPE 13
-#define FLOAT_TYPE 14
+#define BIGNUM_TYPE 9
+#define FLOAT_TYPE 10
+#define VECTOR_TYPE 11
+#define STRING_TYPE 12
+#define SBUF_TYPE 13
+#define PORT_TYPE 14
 #define DLL_TYPE 15
 #define ALIEN_TYPE 16