inferior.factor is usable for real work

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 235c5561cdbba72a6dca97d9e01539f376702e39..270421b2008caae4ce4af845eb9b0a27cc8a8854 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,6 +1,4 @@
 - add a socket timeout\r
-- don't allow multiple reads on the same port\r
-  (and don't hang when this happends!)\r
 - >lower, >upper for strings\r
 - telnetd should use multitasking\r
 - accept multi-line input in listener\r
@@ -35,7 +33,6 @@
 + listener/plugin:\r
 \r
 - plugin should not exit jEdit on fatal errors\r
-- make inferior.factor nicer to use\r
 - auto insert USE:\r
 - balance needs USE:\r
 - fedit broken with listener\r

diff --git a/library/inferior.factor b/library/inferior.factor
index e9710f0c5886dd0d898a9f092b3a325c97c176a2..7f8f3b073c0ab61be2ba6950d3775fc9c69abf15 100644 (file)
--- a/library/inferior.factor
+++ b/library/inferior.factor
@@ -28,8 +28,10 @@
 IN: inferior
 USE: combinators
 USE: errors
+USE: interpreter
 USE: kernel
 USE: lists
+USE: logic
 USE: namespaces
 USE: parser
 USE: prettyprint
@@ -60,6 +62,9 @@ USE: styles
     dup str-length write-big-endian-32
     write ;
 
+: inferior-server-flush ( -- )
+    CHAR: f write flush ;
+
 : <inferior-server-stream> ( stream -- stream )
     <extend-stream> [
         ( -- str )
@@ -74,6 +79,8 @@ USE: styles
         [
             "\n" cat2 default-style inferior-server-write-attr
         ] "fprint" set
+        ( -- )
+        [ inferior-server-flush ] "fflush" set
     ] extend ;
 
 : inferior-client-read ( stream -- ? )
@@ -95,15 +102,13 @@ USE: styles
 : inferior-client-packet ( stream -- ? )
     #! Read from an inferior client socket and print attributed
     #! strings that were read to standard output.
-    read1 dup CHAR: r = [
-        drop inferior-client-read
-    ] [
-        dup CHAR: w = [
-            drop inferior-client-write
-        ] [
-            "Invalid packet type: " swap cat2 throw
-        ] ifte
-    ] ifte ;
+    read1 [
+        [ not       ] [ 2drop f ( EOF ) ]
+        [ CHAR: r = ] [ drop inferior-client-read ]
+        [ CHAR: w = ] [ drop inferior-client-write ]
+        [ CHAR: f = ] [ drop fflush t ]
+        [ drop t    ] [ "Invalid packet type: " swap cat2 throw ]
+    ] cond ;
 
 : inferior-client-loop ( stream -- )
     #! The stream is the stream to write to.
@@ -113,5 +118,22 @@ USE: styles
         drop
     ] ifte ;
 
+: inferior-server ( -- )
+    #! Execute this in the inferior Factor.
+    terpri
+    "inferior-ack" print flush
+    "stdio" get <inferior-server-stream> "stdio" set ;
+
+: inferior-read-ack ( -- )
+    read [
+        "inferior-ack" = [ inferior-read-ack ] unless
+    ] when* ;
+
 : inferior-client ( from -- )
-    "stdio" get swap [ inferior-client-loop ] with-stream ;
+    #! Execute this in the superior Factor, with a socket to
+    #! the inferior Factor as a parameter.
+    "stdio" get swap [
+        "USE: inferior inferior-server" print flush
+        inferior-read-ack
+        inferior-client-loop
+    ] with-stream ;

diff --git a/library/interpreter.factor b/library/interpreter.factor
index 38ec813ae1838e9d5daab5ee8072ff30513dd010..226fed735c04983ed2dea1cdf50014aaa8915dac 100644 (file)
--- a/library/interpreter.factor
+++ b/library/interpreter.factor
@@ -92,7 +92,7 @@ USE: vectors
     "quit-flag" on ;
 
 : eval-catch ( str -- )
-    [ eval ] [ default-error-handler ] catch ;
+    [ eval ] [ [ default-error-handler drop ] when* ] catch ;
 
 : interpret ( -- )
     print-prompt read dup [

diff --git a/library/platform/jvm/stream.factor b/library/platform/jvm/stream.factor
index e4241a1911cae161b4f5a2191018b736bad86bc4..c6f5ab3c664ccfbf3a7c86b6e0657c468306b956 100644 (file)
--- a/library/platform/jvm/stream.factor
+++ b/library/platform/jvm/stream.factor
@@ -55,7 +55,7 @@ USE: strings
     [ ] "java.io.EOFException" jnew ;
 
 : >char/eof ( ch -- ch )
-    dup -1 = [ <eof-exception> throw ] [ >char ] ifte ;
+    dup -1 = [ drop f ] [ >char ] ifte ;
 
 : <byte-stream>/fread1 ( -- string )
     "in" get [ ] "java.io.InputStream" "read" jinvoke

diff --git a/library/platform/native/debugger.factor b/library/platform/native/debugger.factor
index 00d1286e9fea103f1e0df87ed93347d02b86cdef..ee1ccdab1cdee71b9f6203f9300a94a74f34c2ef 100644 (file)
--- a/library/platform/native/debugger.factor
+++ b/library/platform/native/debugger.factor
@@ -43,9 +43,23 @@ USE: vectors
 : expired-port-error ( obj -- )
     "Expired port: " write . ;
 
+: io-task-twice-error ( obj -- )
+    "Attempting to perform two simultaneous I/O operations on "
+    write . ;
+
+: no-io-tasks-error ( obj -- )
+    "No I/O tasks" print ;
+
 : undefined-word-error ( obj -- )
     "Undefined word: " write . ;
 
+: incompatible-port-error ( obj -- )
+    "Unsuitable port for operation: " write . ;
+
+: io-error ( list -- )
+    "I/O error in kernel function " write
+    unswons write ": " write car print ;
+
 : type-check-error ( list -- )
     "Type check error" print
     uncons car dup "Object: " write .
@@ -58,10 +72,6 @@ USE: vectors
     uncons car "Maximum index: " write .
     "Requested index: " write . ;
 
-: io-error ( list -- )
-    "I/O error in kernel function " write
-    unswons write ": " write car print ;
-
 : numerical-comparison-error ( list -- )
     "Cannot compare " write unswons unparse write
     " with " write unparse print ;
@@ -72,28 +82,22 @@ USE: vectors
 : signal-error ( obj -- )
     "Operating system signal " write . ;
 
-: io-task-twice-error ( obj -- )
-    "Attempting to perform two simulatenous I/O operations on "
-    write . ;
-
-: no-io-tasks-error ( obj -- )
-    "No I/O tasks" print ;
-
 : profiling-disabled-error ( obj -- )
     drop "Recompile with the EXTRA_CALL_INFO flag." print ;
 
 : kernel-error. ( obj n -- str )
     {
         expired-port-error
+        io-task-twice-error
+        no-io-tasks-error
+        incompatible-port-error
+        io-error
         undefined-word-error
         type-check-error
         array-range-error
-        io-error
         numerical-comparison-error
         float-format-error
         signal-error
-        io-task-twice-error
-        no-io-tasks-error
         profiling-disabled-error
     } vector-nth execute ;
 

diff --git a/library/stream.factor b/library/stream.factor
index c19dea79d6e8150da42315da04901eb7aabc0074..b27255eee8ae0d77627be501f5ebfbde4d123c0d 100644 (file)
--- a/library/stream.factor
+++ b/library/stream.factor
@@ -26,6 +26,7 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 IN: streams
+USE: combinators
 USE: errors
 USE: kernel
 USE: namespaces
@@ -69,7 +70,11 @@ USE: strings
         ( -- string )
         [ "freadln not implemented." throw  ] "freadln" set
         ( -- string )
-        [ 1 namespace fread# 0 swap str-nth ] "fread1" set
+        [
+            1 namespace fread# dup f-or-"" [
+                0 swap str-nth
+            ] unless
+        ] "fread1" set
         ( count -- string )
         [ "fread# not implemented."  throw  ] "fread#" set
         ( string -- )

diff --git a/native/error.h b/native/error.h
index 610fe2f12631232e15aa3b25b4550c7968a182d0..07598157157482d35979b8c0dd7e69636d2f9924 100644 (file)
--- a/native/error.h
+++ b/native/error.h
@@ -1,14 +1,15 @@
 #define ERROR_PORT_EXPIRED (0<<3)
-#define ERROR_UNDEFINED_WORD (1<<3)
-#define ERROR_TYPE (2<<3)
-#define ERROR_RANGE (3<<3)
+#define ERROR_IO_TASK_TWICE (1<<3)
+#define ERROR_IO_TASK_NONE (2<<3)
+#define ERROR_INCOMPATIBLE_PORT (3<<3)
 #define ERROR_IO (4<<3)
-#define ERROR_INCOMPARABLE (5<<3)
-#define ERROR_FLOAT_FORMAT (6<<3)
-#define ERROR_SIGNAL (7<<3)
-#define ERROR_IO_TASK_TWICE (8<<3)
-#define ERROR_IO_TASK_NONE (9<<3)
-#define ERROR_PROFILING_DISABLED (10<<3)
+#define ERROR_UNDEFINED_WORD (5<<3)
+#define ERROR_TYPE (6<<3)
+#define ERROR_RANGE (7<<3)
+#define ERROR_INCOMPARABLE (8<<3)
+#define ERROR_FLOAT_FORMAT (9<<3)
+#define ERROR_SIGNAL (10<<3)
+#define ERROR_PROFILING_DISABLED (11<<3)
 
 void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);

diff --git a/native/read.c b/native/read.c
index 547148cca9706253fbb1fb0eb386631d99bb840a..2277dde10aa65ecf938bd007249bfb7c36d8879b 100644 (file)
--- a/native/read.c
+++ b/native/read.c
@@ -86,6 +86,9 @@ bool can_read_line(PORT* port)
 {
        pending_io_error(port);
 
+       if(port->type != PORT_READ && port->type != PORT_RECV)
+               general_error(ERROR_INCOMPATIBLE_PORT,port);
+
        if(port->line_ready)
                return true;
        else
@@ -180,6 +183,9 @@ bool can_read_count(PORT* port, FIXNUM count)
 {
        pending_io_error(port);
 
+       if(port->type != PORT_READ && port->type != PORT_RECV)
+               general_error(ERROR_INCOMPATIBLE_PORT,port);
+
        if(port->line != F && CAN_READ_COUNT(port,count))
                return true;
        else

diff --git a/native/write.c b/native/write.c
index 3ce8116e7b5d431164c565a53c6d59834fe4a131..6821e03f85764d72e7ad3f0a48d3a19ef08a969c 100644 (file)
--- a/native/write.c
+++ b/native/write.c
@@ -23,6 +23,9 @@ bool can_write(PORT* port, FIXNUM len)
 
        pending_io_error(port);
 
+       if(port->type != PORT_WRITE)
+               general_error(ERROR_INCOMPATIBLE_PORT,tag_object(port));
+
        switch(port->type)
        {
        case PORT_READ: