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]

ioext.c patch for fseek and ftell


I found that the fseek and ftell functions in ioext.c did not work for
string ports. I fixed that and at the same time I found a small bug for
(fseek file pos SEEK_CUR) which did wrong when there were ungetted chars.

The question then is if this patch should go to the bug-guile list?
I put it here on this list instead so e.g. Jim Blandy can decide if
the fseek and ftell functions should manage string ports in this way.
If the change is desired it may be better to change scm_ptobfuns by
adding two extra entries for fseek and ftell to potentially manage
all relevant port types.
	Best regards
	Roland Orre

*** ioext.c.orig	Mon Jan 11 13:43:57 1999
--- ioext.c	Tue Jan 19 19:50:19 1999
***************
*** 204,217 ****
  scm_ftell (object)
       SCM object;
  {
!   long pos;
  
    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 -= SCM_N_READY_CHARS (object);
      }
--- 204,226 ----
  scm_ftell (object)
       SCM object;
  {
!   long pos=0;
  
    object = SCM_COERCE_OUTPORT (object);
  
    SCM_DEFER_INTS;
!   if (SCM_NIMP (object))
      {
!       if (SCM_OPFPORTP (object))
! 	{
! 	  SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (object)));
! 	}
!       else if (SCM_TYP16 (object) == scm_tc16_strport)
! 	{
! 	  pos = SCM_INUM (SCM_CAR (SCM_STREAM (object)));
! 	}
!       else
! 	scm_wta (object, (char *) SCM_ARG1, s_ftell);
        if (pos > 0 && SCM_CRDYP (object))
  	pos -= SCM_N_READY_CHARS (object);
      }
***************
*** 236,242 ****
       SCM offset;
       SCM whence;
  {
!   int rv;
    long loff;
  
    object = SCM_COERCE_OUTPORT (object);
--- 245,251 ----
       SCM offset;
       SCM whence;
  {
!   int rv=0;
    long loff;
  
    object = SCM_COERCE_OUTPORT (object);
***************
*** 244,253 ****
    loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
    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
      {
--- 253,299 ----
    loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
    SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek);
    SCM_DEFER_INTS;
!   if (SCM_NIMP (object))
      {
!       if (SCM_OPFPORTP (object))
! 	{
! 	  if ((SCM_INUM (whence) == SEEK_CUR) && SCM_CRDYP (object))
! 	    loff -= SCM_N_READY_CHARS (object);
! 	  SCM_CLRDY (object);			/* Clear ungetted char */
! 	  rv = fseek ((FILE *)SCM_STREAM (object), loff, SCM_INUM (whence));
! 	}
!       else if (SCM_TYP16 (object) == scm_tc16_strport)
! 	{
! 	  SCM p = SCM_STREAM (object);
! 	  long pos = SCM_INUM (SCM_CAR (p));
! 	  if (SCM_CRDYP (object)) pos -= SCM_N_READY_CHARS (object);
! 	  SCM_CLRDY (object);			/* Clear ungetted char */
! 	  switch (SCM_INUM (whence)) {
! 	  case SEEK_SET:
! 	    pos = loff; break;
! 	  case SEEK_CUR:
! 	    pos = pos + loff; break;
! 	  case SEEK_END:
! 	    pos = SCM_ROLENGTH (SCM_CDR (p)) + loff; break;
! 	  default:
! 	    scm_wta (object, (char *) SCM_ARG3, s_fseek);
! 	  }
! 	  if (pos > SCM_LENGTH (SCM_CDR (p)))
! 	    {
! 	      if (SCM_OUTPORTP (object))
! 		{
! 		  scm_vector_set_length_x
! 		    (SCM_CDR (p), SCM_MAKINUM (pos + (pos >> 1)));
! 		  SCM_SETCAR (p, SCM_MAKINUM (pos));
! 		}
! 	      else
! 		rv = -1;
! 	    }
! 	  else
! 	    SCM_SETCAR (p, SCM_MAKINUM (pos));
! 	}
!       else
! 	scm_wta (object, (char *) SCM_ARG1, s_fseek);
      }
    else
      {