given the recent enthusiasm for read-line problems,

[Gary Houston <ghouston@ghouston.easynet.co.uk>]

I was interested to see if Guile could handle communication with
a modem, but:

1/ reading from a non-blocking port blocks anyway, when thread support
is included.

(define p (open "/dev/ttyS2" (logior O_NONBLOCK O_RDWR)))
(read-char p)

in C this would fail with EAGAIN "resource temporarily unavailable".

this patch avoids the blocking by adding more cruft:

--- genio.c     Sun Oct 18 18:13:15 1998
+++ genio.c.hacked      Sun Oct 18 10:26:18 1998
@@ -44,6 +44,7 @@
 #include "chars.h"
 #ifdef GUILE_ISELECT
 #include "filesys.h"
+#include <fcntl.h>
 #endif
 
 #include "genio.h"
@@ -121,16 +122,24 @@
 #ifdef GUILE_ISELECT
       if (SCM_FPORTP (port) && !scm_input_waiting_p ((FILE *) f, "scm_getc"))
        {
+         int flags;
          int n;
          SELECT_TYPE readfds;
          int fd = fileno ((FILE *) f);
-         do
+
+         flags = fcntl (fd, F_GETFL);
+         if (flags == -1)
+           scm_syserror ("scm_getc");
+         if (!(flags & O_NONBLOCK))
            {
-             FD_ZERO (&readfds);
-             FD_SET (fd, &readfds);
-             n = scm_internal_select (fd + 1, &readfds, NULL, NULL, NULL);
+             do
+               {
+                 FD_ZERO (&readfds);
+                 FD_SET (fd, &readfds);
+                 n = scm_internal_select (fd + 1, &readfds, NULL, NULL, NULL);
+               }
+             while (n == -1 && errno == EINTR);
            }
-         while (n == -1 && errno == EINTR);
        }
 #endif
       SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (port));


with that patch applied:

2/ read-char returns EOF if there's nothing available to be read.
R[45]RS doesn't say anything about non-blocking ports,
but EOF isn't reasonable.  this patch makes it throw an exception:

--- fports.c    Sun Oct 18 18:13:15 1998
+++ fports.c.hacked     Sun Oct 18 18:17:12 1998
@@ -401,7 +401,12 @@
   if (feof (s))
     return EOF;
   else
-    return fgetc (s);
+    {
+      int result = fgetc (s);
+      if (result == EOF && ferror (s))
+       scm_syserror ("read-char");
+      return result;
+    }
 }
 

read-line has the same problem, plus:

3/ read-line doesn't work on ports where ftell fails.  Guile
is likely to abort in scm_do_read_line in this case, since the number
of characters read appears to be 0.

guile> (define p (open "/dev/ttyS2" (logior O_NONBLOCK O_RDWR)))
guile> (display "at\r\n" p)
guile> (read-line p)

solution: the best i can think of is to use character-by-character input
if ftell fails.  the following patch just throws an error, to avoid aborting.

--- fports.c    Sun Oct 18 18:13:15 1998
+++ fports.c.hacked     Sun Oct 18 18:17:12 1998
@@ -459,13 +464,20 @@
         between an embedded null and the string-terminating null. */
 
       pos = ftell (f);
+       if (pos == -1)
+         scm_syserror ("%read-line");
       if (fgets (p, chunk_size, f) == NULL) {
+       if (ferror (f))
+         scm_syserror ("%read-line");
        if (*len)
          return buf;
        free (buf);
        return NULL;
       }
-      numread = ftell (f) - pos;
+      numread = ftell (f);
+      if (numread == -1)
+       scm_syserror ("%read-line");
+      numread -= pos;
       *len += numread;
 
       if (numread < chunk_size - 1 || buf[limit-2] == '\n')

Here's a complete test program, which transmits characters between the
current-input-port and the modem until an empty line is read.  it
doesn't use read-line.

(define p (open "/dev/ttyS2" (logior O_NONBLOCK O_RDWR)))
(setvbuf p _IONBF)
(define flags (fcntl p F_GETFL))
(fcntl p F_SETFL (logand flags (lognot O_NONBLOCK)))
(let loop ((line-start #t))
  (let ((ready (select (list (current-input-port) p) () ())))
    (cond ((eq? (caar ready) (current-input-port))
	   (let ((ch (read-char)))
	     (cond ((char=? ch #\newline)
		    (if line-start
			(throw 'abort "done")
			(begin
			  (display "\r\n" p)
			  (loop #t))))
		   (else
		    (display ch p)
		    (loop #f)))))
	  (else
	   (display (read-char p))
	   (loop line-start)))))