X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/3cb988bd0081001f12a698fccadcff962791efd8..cda139a7912f2a2d3ca9bab52bf16d41ce4d643f:/libguile/ioext.c diff --git a/libguile/ioext.c b/libguile/ioext.c index 5e1f79a50..bcf0cd500 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -117,13 +117,13 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end) { int k; - c = scm_gen_getc (port); + c = scm_getc (port); for (k = 0; k < num_delims; k++) { if (cdelims[k] == c) { if (SCM_FALSEP (gobble)) - scm_gen_ungetc (c, port); + scm_ungetc (c, port); return scm_cons (SCM_MAKICHR (c), scm_long2num (j - cstart)); @@ -138,6 +138,14 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end) return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart)); } +/* + * %read-line uses a port's fgets method for fast line i/o. It + * truncates any terminating newline from its input, and returns + * a cons of the string read and its terminating character. Doing + * so makes it easy to implement the hairy `read-line' options + * efficiently in Scheme. + */ + SCM_PROC (s_read_line, "%read-line", 0, 1, 0, scm_read_line); SCM @@ -145,6 +153,8 @@ scm_read_line (port) SCM port; { char *s; + int slen; + SCM line, term; if (SCM_UNBNDP (port)) port = scm_cur_inp; @@ -154,8 +164,27 @@ scm_read_line (port) port, SCM_ARG1, s_read_line); } - s = scm_gen_read_line (port); - return (s == NULL ? SCM_EOF_VAL : scm_makfrom0str (s)); + s = scm_do_read_line (port, &slen); + + if (s == NULL) + term = line = SCM_EOF_VAL; + else + { + if (s[slen-1] == '\n') + { + term = SCM_MAKICHR ('\n'); + line = scm_makfromstr (s, slen-1, 0); + } + else + { + /* Fix: we should check for eof on the port before assuming this. */ + term = SCM_EOF_VAL; + line = scm_makfromstr (s, slen, 0); + } + free (s); + } + + return scm_cons (line, term); } SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line); @@ -172,16 +201,28 @@ scm_write_line (obj, port) SCM_PROC (s_ftell, "ftell", 1, 0, 0, scm_ftell); SCM -scm_ftell (port) - SCM port; +scm_ftell (object) + SCM object; { long pos; - SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_ftell); - SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port))); + + object = SCM_COERCE_OUTPORT (object); + + SCM_DEFER_INTS; + if (SCM_NIMP (object) && SCM_OPFPORTP (object)) + { + SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (object))); + if (pos > 0 && SCM_CRDYP (object)) + pos--; + } + else + { + SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_ftell); + SCM_SYSCALL (pos = lseek (SCM_INUM (object), 0, SEEK_CUR)); + } if (pos < 0) scm_syserror (s_ftell); - if (pos > 0 && SCM_CRDYP (port)) - pos--; + SCM_ALLOW_INTS; return scm_long2num (pos); } @@ -190,29 +231,35 @@ scm_ftell (port) SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek); SCM -scm_fseek (port, offset, whence) - SCM port; +scm_fseek (object, offset, whence) + SCM object; SCM offset; SCM whence; { int rv; long loff; - SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fseek); + object = SCM_COERCE_OUTPORT (object); + loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek); - SCM_ASSERT (SCM_INUMP (whence) && (SCM_INUM (whence) < 3) && (SCM_INUM (whence) >= 0), - whence, SCM_ARG3, s_fseek); - - SCM_CLRDY (port); /* Clear ungetted char */ - /* Values of whence are interned in scm_init_ioext. */ - rv = fseek ((FILE *)SCM_STREAM (port), loff, SCM_INUM (whence)); - if (rv != 0) + SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek); + SCM_DEFER_INTS; + if (SCM_NIMP (object) && SCM_OPFPORTP (object)) + { + SCM_CLRDY (object); /* Clear ungetted char */ + rv = fseek ((FILE *)SCM_STREAM (object), loff, SCM_INUM (whence)); + } + else + { + SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fseek); + rv = lseek (SCM_INUM (object), loff, SCM_INUM (whence)); + } + if (rv < 0) scm_syserror (s_fseek); + SCM_ALLOW_INTS; return SCM_UNSPECIFIED; } - - SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen); SCM @@ -229,6 +276,7 @@ scm_freopen (filename, modes, port) SCM_COERCE_SUBSTR (filename); SCM_COERCE_SUBSTR (modes); + port = SCM_COERCE_OUTPORT (port); SCM_DEFER_INTS; SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_freopen); SCM_SYSCALL (f = freopen (SCM_ROCHARS (filename), SCM_ROCHARS (modes), @@ -262,6 +310,9 @@ scm_redirect_port (old, new) { int ans, oldfd, newfd; + old = SCM_COERCE_OUTPORT (old); + new = SCM_COERCE_OUTPORT (new); + SCM_DEFER_INTS; SCM_ASSERT (SCM_NIMP (old) && SCM_OPPORTP (old), old, SCM_ARG1, s_redirect_port); SCM_ASSERT (SCM_NIMP (new) && SCM_OPPORTP (new), new, SCM_ARG2, s_redirect_port); @@ -278,59 +329,45 @@ scm_redirect_port (old, new) return SCM_UNSPECIFIED; } -SCM_PROC (s_primitive_dup, "primitive-dup", 1, 0, 0, scm_primitive_dup); +SCM_PROC (s_dup_to_fdes, "dup->fdes", 1, 1, 0, scm_dup_to_fdes); SCM -scm_primitive_dup (SCM fd_or_port) -{ - int fd, newfd; - - SCM_DEFER_INTS; - if (SCM_INUMP (fd_or_port)) - fd = SCM_INUM (fd_or_port); - else - { - SCM_ASSERT (SCM_NIMP (fd_or_port) && SCM_OPPORTP (fd_or_port), - fd_or_port, SCM_ARG1, s_primitive_dup); - fd = fileno ((FILE *)SCM_STREAM (fd_or_port)); - if (fd == -1) - scm_syserror (s_primitive_dup); - } - SCM_SYSCALL (newfd = dup (fd)); - if (newfd == -1) - scm_syserror (s_primitive_dup); - SCM_ALLOW_INTS; - return SCM_MAKINUM (newfd); -} - -SCM_PROC (s_primitive_dup2, "primitive-dup2", 2, 0, 0, scm_primitive_dup2); -SCM -scm_primitive_dup2 (SCM fd_or_port, SCM fd) +scm_dup_to_fdes (SCM fd_or_port, SCM fd) { int oldfd, newfd, rv; + fd_or_port = SCM_COERCE_OUTPORT (fd_or_port); + SCM_DEFER_INTS; if (SCM_INUMP (fd_or_port)) oldfd = SCM_INUM (fd_or_port); else { SCM_ASSERT (SCM_NIMP (fd_or_port) && SCM_OPPORTP (fd_or_port), - fd_or_port, SCM_ARG1, s_primitive_dup2); + fd_or_port, SCM_ARG1, s_dup_to_fdes); oldfd = fileno ((FILE *)SCM_STREAM (fd_or_port)); if (oldfd == -1) - scm_syserror (s_primitive_dup2); + scm_syserror (s_dup_to_fdes); } - - SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_primitive_dup2); - newfd = SCM_INUM (fd); - if (oldfd == newfd) + + if (SCM_UNBNDP (fd)) { - SCM_ALLOW_INTS; - return fd; + SCM_SYSCALL (newfd = dup (oldfd)); + if (newfd == -1) + scm_syserror (s_dup_to_fdes); + fd = SCM_MAKINUM (newfd); + } + else + { + SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_dup_to_fdes); + newfd = SCM_INUM (fd); + if (oldfd != newfd) + { + scm_evict_ports (newfd); /* see scsh manual. */ + SCM_SYSCALL (rv = dup2 (oldfd, newfd)); + if (rv == -1) + scm_syserror (s_dup_to_fdes); + } } - scm_evict_ports (newfd); /* see scsh manual. */ - SCM_SYSCALL (rv = dup2 (oldfd, newfd)); - if (rv == -1) - scm_syserror (s_primitive_dup2); SCM_ALLOW_INTS; return fd; } @@ -342,6 +379,9 @@ scm_fileno (port) SCM port; { int fd; + + port = SCM_COERCE_OUTPORT (port); + SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fileno); fd = fileno ((FILE *)SCM_STREAM (port)); if (fd == -1) @@ -356,6 +396,9 @@ scm_isatty_p (port) SCM port; { int rv; + + port = SCM_COERCE_OUTPORT (port); + SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_isatty); rv = fileno ((FILE *)SCM_STREAM (port)); if (rv == -1) @@ -415,6 +458,8 @@ scm_primitive_move_to_fdes (port, fd) int new_fd; int rv; + port = SCM_COERCE_OUTPORT (port); + SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_primitive_move_to_fdes); SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_primitive_move_to_fdes); SCM_DEFER_INTS; @@ -436,23 +481,6 @@ scm_primitive_move_to_fdes (port, fd) return SCM_BOOL_T; } -#ifdef FD_SETTER -#define SET_FILE_FD_FIELD(F,D) ((F)->FD_SETTER = (D)) -#endif - -void -scm_setfileno (fs, fd) - FILE *fs; - int fd; -{ -#ifdef SET_FILE_FD_FIELD - SET_FILE_FD_FIELD(fs, fd); -#else - scm_misc_error ("scm_setfileno", "Not fully implemented on this platform", - SCM_EOL); -#endif -} - /* Return a list of ports using a given file descriptor. */ SCM_PROC(s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports);