* 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.

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:
 

libguile/ChangeLog

@@ -1,3 +1,22 @@
+1999-10-24  Gary Houston  <ghouston@freewire.co.uk>
+
+	* 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  <ghouston@freewire.co.uk>
 
 	* ports.c (scm_seek): Add a special case for SEEK_CUR, offset 0,

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;
 }
 

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
-	{
+	rv = ptob->seek (object, off, how);
-	  /* 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);
-	    }
-	}
     }
   else /* file descriptor?.  */
     {

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.  */
+  if (pt->rw_active == SCM_PORT_READ && offset == 0 && whence == SEEK_CUR)
-  switch (whence)
+    /* special case to avoid disturbing the unread-char buffer.  */
     {
-    case SEEK_CUR:
+      if (pt->read_buf == pt->putback_buf)
-      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)
+	  target = pt->saved_read_pos - pt->saved_read_buf
-	    {
+	    - (pt->read_end - pt->read_pos);
-	      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
+	  target = pt->read_pos - pt->read_buf;
-					? SCM_WRITE_BLOCK
-					: 0));
 	}
     }
-  pt->read_pos = pt->write_pos = pt->read_buf + target;
+  else
-  if (pt->read_pos > pt->read_end)
+    /* all other cases.  */
     {
-      pt->read_end = (unsigned char *) pt->read_pos;
+      if (pt->rw_active == SCM_PORT_WRITE)
-      pt->read_buf_size = pt->read_end - pt->read_buf;
+	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;
 }