diff --git a/NEWS b/NEWS index d266a8274..dee775f67 100644 --- a/NEWS +++ b/NEWS @@ -90,6 +90,23 @@ at the top of the script. must be set to non-zero in any random access port. In recent Guile releases it was only set for bidirectional random-access ports. +** Port internals: the seek ptob procedure is now responsible for +resetting the buffers if required. The change was made so that in the +special case of reading the current position (i.e., seek p 0 SEEK_CUR) +the fport and strport ptobs can avoid resetting the buffers, +in particular to avoid discarding unread chars. An existing port +type can be fixed by adding something like the following to the +beginning of the ptob seek procedure: + + if (pt->rw_active == SCM_PORT_READ) + scm_end_input (object); + else if (pt->rw_active == SCM_PORT_WRITE) + ptob->flush (object); + +although to actually avoid resetting the buffers and discard unread +chars requires further hacking that depends on the characteristics +of the ptob. + Changes since Guile 1.3.2: diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2e0ff6946..2d0316f03 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,22 @@ +1999-10-24 Gary Houston + + * Move the responsibility for resetting port buffers from the + caller of the ptob seek procedure to the implementation. This + gives more control in general to the ptob seek: in particular the + change of 1999-10-20 can be made to work without breaking seek on + string ports. There's a comment in NEWS about upgrading port + types. + + * ports.c (scm_seek): don't reset the port buffers here. + + * fports.c (fport_seek): reset the buffers, except for the + 0 SEEK_CUR case. + + * strports.c (st_end_input): (bug fix): decrement pt->read_pos by + offset. check that it's not less than read_buf. + (st_seek): reset the buffers first, unless it's the 0 SEEK_CUR + case and currently reading. + 1999-10-20 Gary Houston * ports.c (scm_seek): Add a special case for SEEK_CUR, offset 0, diff --git a/libguile/fports.c b/libguile/fports.c index 0c0c3c565..4a22639d7 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -455,11 +455,52 @@ fport_fill_input (SCM port) static off_t fport_seek (SCM port, off_t offset, int whence) { + scm_port *pt = SCM_PTAB_ENTRY (port); struct scm_fport *fp = SCM_FSTREAM (port); - off_t result = lseek (fp->fdes, offset, whence); + off_t rv; + off_t result; - if (result == -1) + if (pt->rw_active == SCM_PORT_WRITE) + { + if (offset != 0 || whence != SEEK_CUR) + { + fport_flush (port); + result = rv = lseek (fp->fdes, offset, whence); + } + else + { + /* read current position without disturbing the buffer. */ + rv = lseek (fp->fdes, offset, whence); + result = rv + (pt->write_pos - pt->write_buf); + } + } + else if (pt->rw_active == SCM_PORT_READ) + { + if (offset != 0 || whence != SEEK_CUR) + { + /* could expand to avoid a second seek. */ + scm_end_input (port); + result = rv = lseek (fp->fdes, offset, whence); + } + else + { + /* read current position without disturbing the buffer + (particularly the unread-char buffer). */ + rv = lseek (fp->fdes, offset, whence); + result = rv - (pt->read_end - pt->read_pos); + + if (pt->read_buf == pt->putback_buf) + result -= pt->saved_read_end - pt->saved_read_pos; + } + } + else /* SCM_PORT_NEITHER */ + { + result = rv = lseek (fp->fdes, offset, whence); + } + + if (rv == -1) scm_syserror ("fport_seek"); + return result; } diff --git a/libguile/ports.c b/libguile/ports.c index 6a162a26e..542d56ee6 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -957,40 +957,13 @@ scm_seek (SCM object, SCM offset, SCM whence) scm_out_of_range (s_seek, whence); if (SCM_NIMP (object) && SCM_OPPORTP (object)) { - scm_port *pt = SCM_PTAB_ENTRY (object); scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object); if (!ptob->seek) scm_misc_error (s_seek, "port is not seekable", scm_cons (object, SCM_EOL)); else - { - /* there's no need to worry about what happens to the buffers - if the port isn't random-access: seek will fail anyway. */ - if (off == 0 && how == SEEK_CUR) - { - /* special case to avoid discarding put-back chars when - reading current position. */ - rv = ptob->seek (object, off, how); - if (pt->rw_active == SCM_PORT_READ) - { - rv -= pt->read_end - pt->read_pos; - if (pt->read_buf == pt->putback_buf) - rv -= pt->saved_read_end - pt->saved_read_pos; - } - else if (pt->rw_active == SCM_PORT_WRITE) - rv += pt->write_pos - pt->write_buf; - } - else - { - if (pt->rw_active == SCM_PORT_READ) - scm_end_input (object); - else if (pt->rw_active == SCM_PORT_WRITE) - ptob->flush (object); - - rv = ptob->seek (object, off, how); - } - } + rv = ptob->seek (object, off, how); } else /* file descriptor?. */ { diff --git a/libguile/strports.c b/libguile/strports.c index 5dfa518c5..d76a6009c 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -149,8 +149,12 @@ static void st_end_input (SCM port, int offset) { scm_port *pt = SCM_PTAB_ENTRY (port); + const unsigned char *pos = pt->read_pos - offset; - pt->write_pos = (unsigned char *) pt->read_pos; + if (pos < pt->read_buf) + scm_misc_error ("st_end_input", "negative position", SCM_EOL); + + pt->write_pos = (unsigned char *) pt->read_pos = pos; pt->rw_active = SCM_PORT_NEITHER; } @@ -160,43 +164,68 @@ st_seek (SCM port, off_t offset, int whence) scm_port *pt = SCM_PTAB_ENTRY (port); off_t target; - /* we can assume at this point that pt->write_pos == pt->read_pos. */ - switch (whence) + if (pt->rw_active == SCM_PORT_READ && offset == 0 && whence == SEEK_CUR) + /* special case to avoid disturbing the unread-char buffer. */ { - case SEEK_CUR: - target = pt->read_pos - pt->read_buf + offset; - break; - case SEEK_END: - target = pt->read_end - pt->read_buf + offset; - break; - default: /* SEEK_SET */ - target = offset; - break; - } - if (target < 0) - scm_misc_error ("st_seek", "negative offset", SCM_EOL); - if (target >= pt->write_buf_size) - { - if (!(SCM_CAR (port) & SCM_WRTNG)) + if (pt->read_buf == pt->putback_buf) { - if (target > pt->write_buf_size) - { - scm_misc_error ("st_seek", "seek past end of read-only strport", - SCM_EOL); - } + target = pt->saved_read_pos - pt->saved_read_buf + - (pt->read_end - pt->read_pos); } else { - st_resize_port (pt, target + (target == pt->write_buf_size - ? SCM_WRITE_BLOCK - : 0)); + target = pt->read_pos - pt->read_buf; } } - pt->read_pos = pt->write_pos = pt->read_buf + target; - if (pt->read_pos > pt->read_end) + else + /* all other cases. */ { - pt->read_end = (unsigned char *) pt->read_pos; - pt->read_buf_size = pt->read_end - pt->read_buf; + if (pt->rw_active == SCM_PORT_WRITE) + st_flush (port); + + if (pt->rw_active == SCM_PORT_READ) + scm_end_input (port); + + switch (whence) + { + case SEEK_CUR: + target = pt->read_pos - pt->read_buf + offset; + break; + case SEEK_END: + target = pt->read_end - pt->read_buf + offset; + break; + default: /* SEEK_SET */ + target = offset; + break; + } + + if (target < 0) + scm_misc_error ("st_seek", "negative offset", SCM_EOL); + + if (target >= pt->write_buf_size) + { + if (!(SCM_CAR (port) & SCM_WRTNG)) + { + if (target > pt->write_buf_size) + { + scm_misc_error ("st_seek", + "seek past end of read-only strport", + SCM_EOL); + } + } + else + { + st_resize_port (pt, target + (target == pt->write_buf_size + ? SCM_WRITE_BLOCK + : 0)); + } + } + pt->read_pos = pt->write_pos = pt->read_buf + target; + if (pt->read_pos > pt->read_end) + { + pt->read_end = (unsigned char *) pt->read_pos; + pt->read_buf_size = pt->read_end - pt->read_buf; + } } return target; }