This is the mail archive of the guile@cygnus.com mailing list for the guile project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
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)))))