inferior.factor is usable for real work

TODO.FACTOR.txt

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

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 = [
+    read1 [
-        drop inferior-client-read
+        [ not       ] [ 2drop f ( EOF ) ]
-    ] [
+        [ CHAR: r = ] [ drop inferior-client-read ]
-        dup CHAR: w = [
+        [ CHAR: w = ] [ drop inferior-client-write ]
-            drop inferior-client-write
+        [ CHAR: f = ] [ drop fflush t ]
-        ] [
+        [ drop t    ] [ "Invalid packet type: " swap cat2 throw ]
-            "Invalid packet type: " swap cat2 throw
+    ] cond ;
-        ] ifte
-    ] ifte ;
 
 : 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 ;

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 [

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

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 ;
 

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

native/error.h

@@ -1,14 +1,15 @@
 #define ERROR_PORT_EXPIRED (0<<3)
-#define ERROR_UNDEFINED_WORD (1<<3)
+#define ERROR_IO_TASK_TWICE (1<<3)
-#define ERROR_TYPE (2<<3)
+#define ERROR_IO_TASK_NONE (2<<3)
-#define ERROR_RANGE (3<<3)
+#define ERROR_INCOMPATIBLE_PORT (3<<3)
 #define ERROR_IO (4<<3)
-#define ERROR_INCOMPARABLE (5<<3)
+#define ERROR_UNDEFINED_WORD (5<<3)
-#define ERROR_FLOAT_FORMAT (6<<3)
+#define ERROR_TYPE (6<<3)
-#define ERROR_SIGNAL (7<<3)
+#define ERROR_RANGE (7<<3)
-#define ERROR_IO_TASK_TWICE (8<<3)
+#define ERROR_INCOMPARABLE (8<<3)
-#define ERROR_IO_TASK_NONE (9<<3)
+#define ERROR_FLOAT_FORMAT (9<<3)
-#define ERROR_PROFILING_DISABLED (10<<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);

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

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: