(no subject)

From: Tom Hicks <hickst_at_lx2.tucson.saic.com>
Date: Tue, 14 Feb 1995 17:00:26 +0700

Subject: re: file positioning

Recently, Hilmar Lapp writes:

>From stk-request_at_kaolin.unice.fr Mon Feb 6 10:19:38 1995
>From: Hilmar Lapp <hili_at_al-bundy.biologie.uni-freiburg.de>
>Subject: file positioning

>while looking up the functions that support file-IO in STk, I wasn't able
>to find any function that does something like file-positioning (like
>fseek() does in C). There isn't any such kind of procedure described in
>the manual or elsewhere.

>My question: does this mean, that there is no such function predefined ?
>(or, in other terms: do I have to code this myself ?)
>
>I'd appeciate any help, hints or comments.

>Hilmar Lapp Institut f. Biologie II Universitaet Freiburg
>e-mail: hlapp_at_deep-thought.biologie.uni-freiburg.de
>http://www.biologie.uni-freiburg.de/~hili/hili.html

We've done this already (unofficially) for a project we are working on.
Here follows the code which I put into the public domain. As usual,
no warranties given or implied. It's been tested only under Linux and
SunOS 4.1.3. If someone wants to add this to the official version,
that's great with me.
        -tom

-----------------------------------------------------------------
/*
 * EXtended IO routines - Add additional features to STk's io functions.
 *
 * Currently includes: tell, seek
 *
 * Written by: Tom Hicks (hickst_at_aries.tucson.saic.com) 12/3/94.
 * Last Modified: 12/04/94. Alter to be compatible with SUNOS.
 *
 */
#include <stdio.h>
#include <stk.h>

/* Following define garbage is for compatibility with SUNOS 4.1.3 */
#ifndef SEEK_SET
#define SEEK_SET 0
#define SEEK_CUR 1
#define SEEK_END 2
#endif

/*
 * tell - STk access to the ftell(2) stream position function.
 *
 * Input: port - a valid Scheme input or output FILE port. No string
 * or tty ports permitted.
 *
 * Output: a Scheme integer representing the file position returned.
 */
PRIMITIVE tell(SCM port)
{
  char buff[100];
  long loc;

  /* Check the port argument for currently open input and output streams */
  if (OPORTP(port) || IPORTP(port)) /* test seekability */
    if (port->storage_as.port.f == NULL) { /* port is closed */
      sprintf(buff, "tell: port is closed"); /* so signal error */
      err(buff, port);
    }
    else /* port is open so */
      loc = ftell(port->storage_as.port.f); /* get current fpos */
  else { /* not the right type*/
    sprintf(buff, "tell: port is not seekable");
    err(buff, port);
  }

  if (loc == -1) { /* TELL fails anyway */
    sprintf(buff, "tell: error while trying to tell on port");
    err(buff, port);
  }

  return makeinteger(loc); /* return the fpos */
}

/*
 * seek - STk access to the fseek(2) stream positioning function.
 *
 * Input: port - a valid Scheme input or output FILE port. No string
 * or tty ports permitted.
 * offset - a Scheme integer representing the offset location to seek.
 * mode - a Scheme integer representing the base location of the
 * offset argument, as follows:
 * 0 seek from the start of file. Equivalent to an fsee(2) whence
 * argument of SEEK_SET.
 * 1 seek from the current position indicator. Equivalent to an
 * fseek(2) whence argument of SEEK_CUR.
 * 2 seek from the end-of-file. Equivalent to an fseek(2) whence
 * argument of SEEK_END.
 *
 * Output: a Scheme integer representing the new file position after seeking.
 */
PRIMITIVE seek(SCM port, SCM offset, SCM mode)
{
  char buff[100];
  int res, whence;
  long cmode, coffset, newpos;

  /* parse and convert the Scheme mode argument to the fseek whence argument */
  cmode = integer_value(mode); /* get the integer out */
  switch (cmode) { /* which mode is it? */
    case 0: /* from start of file */
            whence = SEEK_SET;
            break;
    case 1: /* from current position*/
            whence = SEEK_CUR;
            break;
    case 2: /* from end-of-file */
            whence = SEEK_END;
            break;
    default:
           sprintf(buff, "seek: mode argument must be an integer 0, 1, or 2");
           err(buff, mode);
           break;
  }
            
  /* Convert the Scheme offset argument to a C long for fseek(2) */
  coffset = integer_value(offset); /* get the integer out */
  if (coffset == LONG_MIN) { /* offset not an int */
    sprintf(buff, "seek: offset argument must be an integer");
    err(buff, offset);
  }

  /*
   * Check the port argument for currently open input or output file.
   * If port is of correct type, then do the seek.
   */
  if (OPORTP(port) || IPORTP(port)) { /* test port seekability*/
    if (port->storage_as.port.f == NULL) { /* port is closed */
      sprintf(buff, "seek: port is closed"); /* so cause error */
      err(buff, port);
    }
    else { /* port open, do seek */
      res = fseek(port->storage_as.port.f, coffset, whence);
      newpos = ftell(port->storage_as.port.f); /* note new file pos */
    }
  }
  else { /* its not correct type */
    sprintf(buff, "seek: port is not seekable");
    err(buff, port);
  }

  if (res == -1) { /* if SEEK fails anyway */
    sprintf(buff, "seek: error while trying to seek on port");
    err(buff, port);
  }

  /* if seek is successful, then return the previous file position */
  return makeinteger(newpos);
}


/*
 * Init function must be "init_" prepended to the name of the
 * shared object file (excluding the ".so" extension) in order for
 * correct interface with stk.
 *
 */
void init_exio( void )
{
    add_new_primitive( "seek", tc_subr_3, seek );
    add_new_primitive( "tell", tc_subr_1, tell );
}
-----------------------------------------------------------------
Received on Wed Feb 15 1995 - 00:58:35 CET

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST