Пример #1
0
int
c_sue (cilist64 *a, unit **fu)
{
    unit *ftnunit;

    if ((ftnunit = map_luno (a->ciunit)) == NULL)
        errret(a->cierr, 101, "startio");
    while (fu != &f77curunit && test_and_set( &ftnunit->lock_unit, 1L ))
        ;
    *fu = ftnunit;
    if (ftnunit->uconn <= 0 && fk_open (SEQ, UNF, a->ciunit)) {
        ftnunit->uconn = 0;
        errret(a->cierr, 114, "sue");
    }
    ftnunit->f77errlist.cierr = a->cierr;
    ftnunit->f77errlist.ciend = a->ciend;
    ftnunit->f77errlist.cieor = a->cieor;
    ftnunit->f77errlist.cisize = a->cisize;
    ftnunit->f77errlist.iciunit = 0;
    if (ftnunit->ufmt > 0) {
        if ((ftnunit->ufd == stdin || ftnunit->ufd == stdout ||
                ftnunit->ufd == stderr) && ftnunit->useek)
            /* these guys can be redirected so it might not be an error,
            ** let's assume it is correct here.   If there is any error
            ** it can be caught later
            */
            ftnunit->ufmt = 1;
        else
            errret(a->cierr, 103, "sue");
    }
    if (!ftnunit->useek && ftnunit->uacc == SEQUENTIAL)
        errret(a->cierr, 103, "sue");
    return (0);
}
Пример #2
0
int s_rdfe64_mp(cilist64 *a, unit **fu) {

#else
int
s_rdfe_mp (cilist *a, unit **fu) {

#endif
   int             n;
   unit            *ftnunit;

   if (!f77init)
      f_init ();
   if (n = c_dfe (a, fu)) {
      if (*fu) (*fu)->lock_unit = 0;
      return (n);
   }
   ftnunit = *fu;
   if (ftnunit->uwrt & WR_OP)
      (void) f77nowreading (ftnunit);
#ifdef I90
   if (ftnunit->uaction == WRITEONLY )
	errret(ftnunit->f77errlist.cierr,180,"startread");
#endif
   ftnunit->f77getn = y_getc;
   ftnunit->f77gets = y_gets;
   ftnunit->f77ungetn = y_ungetc;
   ftnunit->f77doed = rd_ed;
   ftnunit->f77doned = rd_ned;
   ftnunit->f77donewrec = yrd_SL;
   ftnunit->f77dorevert = ftnunit->f77doend = y_rsk;
   if (pars_f (ftnunit, ftnunit->f77fmtbuf) < 0)
      errret(a->cierr, 100, "startio");
   fmt_bg (ftnunit);
   return (0);
}
Пример #3
0
Файл: uio.c Проект: xyuan/Path64
int
do_ud (unit *ftnunit, XINT *number, char *ptr, ftnlen len)
{
   XINT             nread = *number * len;
   XINT64             disk_loc; 
     
   if (ftnunit->url != 1) {   /* Normal case.          */
      disk_loc =(ftnunit->uirec - 1) * ftnunit->url + ftnunit->f77recpos;
      ftnunit->f77recpos += nread;
      if (ftnunit->f77recpos > ftnunit->url && ftnunit->url != 1)
         errret(ftnunit->f77errlist.cierr, 110, "eof/uio");
   } else {                      /* Record length of one. */
      disk_loc = ftnunit->uirec;
      ftnunit->uirec += nread;
   }
 

   /* 
    * Read or write the data. 
    */

   if (!(ftnunit->uwrt & WR_OP)) {
      if (-1 == _fio_du_read (ftnunit, ptr, nread, disk_loc, (int) ftnunit->ufd))
	 errret(ftnunit->f77errlist.cierr, errno, "eof/uio");
   } else {
      if (ftnunit->ureadonly)
	 errret( ftnunit->f77errlist.cierr, F_ERREADONLY, "direct unformatted write" );
      if (-1 == _fio_du_write (ftnunit, ptr, nread, disk_loc, (int) ftnunit->ufd))
	 errret(ftnunit->f77errlist.cierr, errno, "system write error");
   }
   return (0);
}
Пример #4
0
int s_wdfe64_mp (cilist64 *a, unit **fu) {

#else

int
s_wdfe_mp (cilist *a, unit **fu) {
#endif
   int             n;
   unit		*ftnunit;

   if (!f77init)
      f_init ();
   if (n = c_dfe (a, fu)) {
      if (*fu) (*fu)->lock_unit = 0;
      return (n);
   }
   ftnunit = *fu;
   if (ftnunit->uwrt != WR_READY && f77nowwriting (ftnunit))
      errret(a->cierr, 160, "startwrt");
   ftnunit->f77putn = y_putc;
   ftnunit->f77ungetn = y_ungetc;
   ftnunit->f77doed = w_ed;
   ftnunit->f77doned = w_ned;
   ftnunit->f77donewrec = y_wSL;
   ftnunit->f77dorevert = y_rev;
   ftnunit->f77doend = y_end;
   ftnunit->uirec = a->cirec;
   if (ftnunit->umaxrec && (a->cirec > ftnunit->umaxrec))
      errret(a->cierr, 159, "startwrt");
   if (pars_f (ftnunit, ftnunit->f77fmtbuf) < 0)
      errret(a->cierr, 100, "startwrt");
   fmt_bg (ftnunit);
   return (0);
}
Пример #5
0
int32 wsfe (cilist *a, unit **fu, int f90sw)
#endif
{
   int32             n;
   unit             *ftnunit;

   if (!f77init)
      f_init ();

   if (n = c_sfe (a, fu))
      return n;

   ftnunit = *fu;
   if (ftnunit->uacc == DIRECT)
      errret(a->cierr, 171, "sequential write");

   ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
   ftnunit->f77cplus = 0;
   ftnunit->f77scale = 0;
#ifdef I90
   ftnunit->f90sw = f90sw;
   if (!f90sw) ftnunit->f77recpos = ftnunit->f77recend = 0;
   /* in f90 mode we initialize f77recpos and f77recend in the caller, dont
      know why. */
#else
   ftnunit->f77recpos = ftnunit->f77recend = 0;
#endif
   ftnunit->f77errlist.cierr = a->cierr;
   ftnunit->f77errlist.ciend = a->ciend;
   ftnunit->f77errlist.cieor = a->cieor;
   ftnunit->f77errlist.cisize = a->cisize;
   ftnunit->f77errlist.iciunit = 0; 
   ftnunit->f77fmtbuf = a->cifmt;
   if (ftnunit->uacc == KEYED) {
      ftnunit->f77idxlist.cimatch = a->cimatch;
      ftnunit->f77idxlist.cikeytype = a->cikeytype;
      ftnunit->f77idxlist.cikeyval.cicharval = a->cikeyval.cicharval;
      ftnunit->f77idxlist.cikeyid = a->cikeyid;
      ftnunit->f77idxlist.cinml = a->cinml;
      ftnunit->f77idxlist.cikeyvallen = a->cikeyvallen;
   }
   if (pars_f (ftnunit, ftnunit->f77fmtbuf) < 0)
      errret(a->cierr, 100, "startio");
   ftnunit->f77putn = x_putc;
   ftnunit->f77ungetn = x_ungetc;
   ftnunit->f77doed = w_ed;
   ftnunit->f77doned = w_ned;
   ftnunit->f77doend = xw_end;
   ftnunit->f77dorevert = xw_rev;
   ftnunit->f77donewrec = x_wSL;
   fmt_bg (ftnunit);
   ftnunit->f77cblank = ftnunit->ublnk;
   if (ftnunit->url > ftnunit->f77fio_size)
       check_buflen( ftnunit, ftnunit->url > FIO_ALLOC ? ftnunit->url : FIO_ALLOC );
   return 0;
}
Пример #6
0
int
e_rsue_mp (unit **fu)
{
    unit		*ftnunit = *fu;
    int n;
    if (ftnunit->uacc != KEYED && ftnunit->url != 1) {
        XINT             nleft = ftnunit->f77reclen - ftnunit->f77recpos;

        if ((ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
            return( e_rdue_mp (fu) );
        } else if (ftnunit->uacc == DIRECT) {
            if (nleft > 0) {
                if (nleft <= ftnunit->f77fio_size && nleft < 1000) {
                    fread (ftnunit->f77fio_buf, nleft, 1, ftnunit->ufd);
                } else {
                    (void) fseek (ftnunit->ufd, nleft, 1);
                }
            }
        } else {
            if (nleft + sizeof (int) <= ftnunit->f77fio_size && nleft < 1000) {
                fread (ftnunit->f77fio_buf, nleft + sizeof (int), 1, ftnunit->ufd);
            } else {
                (void) fseek (ftnunit->ufd, (long) (nleft + sizeof (int)), 1);
            }
        }
        if (ferror (ftnunit->ufd))
            errret(ftnunit->f77errlist.cierr, errno, "sue");
    }
    ftnunit->lock_unit = 0;
    return (0);
}
Пример #7
0
int
s_xsle64_mp (cilist64 *a, unit **fu)
{
   int             n = s_wsle64_mp(a, fu);
#else
int
s_xsle_mp (cilist *a, unit **fu)
{
   int             n = s_wsle_mp(a, fu);
#endif
   unit		*ftnunit = *fu;

   if (n) {
      return n;
   }
   ftnunit->f77idxlist.cimatch = a->cimatch;
   ftnunit->f77idxlist.cikeytype = a->cikeytype;
   ftnunit->f77idxlist.cikeyval.cicharval = a->cikeyval.cicharval;
   ftnunit->f77idxlist.cikeyid = a->cikeyid;
   ftnunit->f77idxlist.cinml = a->cinml;
   ftnunit->f77idxlist.cikeyvallen = a->cikeyvallen;
   if (ftnunit->uacc != KEYED)
      errret(a->cierr, 162, "rewrite");
   ftnunit->dowrite = idxrewrite;
   return (0);
}
Пример #8
0
int
e_rdfe_mp (unit **fu)
{
   unit *ftnunit = *fu;
   (void) en_fio (fu);
   if (ftnunit->ufd && ferror (ftnunit->ufd))
      errret(ftnunit->f77errlist.cierr, errno, "dfe");
   ftnunit->lock_unit = 0;
   return (0);
}
Пример #9
0
static int
s_wsue_com (cilist64 *a, unit **fu)
{
    unit		  *ftnunit;
    int             n;

    n = wsue(a, fu);
    ftnunit = *fu;
    if (n) {
        errret(a->cierr, n, "s_wsue");
    }
    if (ftnunit->uacc == KEYED) {
        ftnunit->f77idxlist.cimatch = a->cimatch;
        ftnunit->f77idxlist.cikeytype = a->cikeytype;
        ftnunit->f77idxlist.cikeyval.cicharval = a->cikeyval.cicharval;
        ftnunit->f77idxlist.cikeyid = a->cikeyid;
        ftnunit->f77idxlist.cinml = a->cinml;
        ftnunit->f77idxlist.cikeyvallen = a->cikeyvallen;
        ftnunit->f77do_unf = do_ui;
    }
    else {
        if (ftnunit->uacc == DIRECT) {
            ftnunit->f77recpos = 0;
            ftnunit->f77do_unf = do_ud;
            _fio_seq_pos( ftnunit->ufd, ftnunit );
        } else {
            if (ftnunit->uwrt != WR_READY && f77nowwriting (ftnunit))
                errret(a->cierr, 160, "startwrt");
            est_reclen = ftnunit->f77reclen = 0;
            ftnunit->overflowed = 0;
            ftnunit->f77recpos = 4;
            ftnunit->f77do_unf = do_us;
            if (ftnunit->uerror)
                unf_position (ftnunit->ufd, ftnunit);
        }
    }
    return 0;
}
Пример #10
0
int
c_si (icilist *a, unit *ftnunit)
#endif
{
   ftnunit->f77fmtbuf = a->icifmt;
   if (f77vfmt_com_.PFI != NULL) {
      /*
       * If something has been placed in the global static f77vfmt_com_
       * structure, then use it.  This means we must be running an
       * executable built with a pre-mongoose compiler which is using
       * variable format I/O.
       */
      ftnunit->vfmt = f77vfmt_com_.PFI;
      ftnunit->vfmtfp = f77vfmt_com_.static_link;
   } else {
      /*
       * Otherwise, grab the same information from the icilist structure.
       * This means one of three things:
       * 1) executable built with pre-mongoose compiler, no variable format:
       *       The civfmt and civfmtfp fields are actually past the end
       *       of the space allocated for the icilist structure, so we
       *       are reading something else which is unknown, and it will
       *       not be used.  This is hopefully not a problem.
       * 2) executable built with mongoose compiler, no variable format:
       *       The civfmt and civfmtfp fields are there in the icilist
       *       structure, but are uninitialized and the values will not
       *       be used.  This is not a problem.
       * 3) executable built with mongoose compiler, variable format:
       *       The values are there, are valid, and will be used.
       */
      ftnunit->vfmt = a->icivfmt;
      ftnunit->vfmtfp = a->icivfmtfp;
   }
   ftnunit->f77cblank = ftnunit->f77cplus = ftnunit->f77scale = 0;
   ftnunit->f77errlist.cierr = a->icierr;
   ftnunit->f77errlist.ciend = a->iciend;
   ftnunit->f77errlist.cieor = 0;
   ftnunit->f77errlist.cisize = 0;
   ftnunit->f77errlist.iciunit = a->iciunit;
   ftnunit->f77errlist.icirlen = a->icirlen;
   ftnunit->f77errlist.icirnum = a->icirnum;
   ftnunit->f77errlist.iciunit = a->iciunit;
   ftnunit->f77recpos = ftnunit->f77recend = icnum = icpos = 0;
   if (pars_f (ftnunit, ftnunit->f77fmtbuf) < 0)
      errret(a->icierr, 100, "startint");
   fmt_bg (ftnunit);
   icptr = ftnunit->f77errlist.iciunit;
   icend = icptr + ftnunit->f77errlist.icirlen * ftnunit->f77errlist.icirnum;
   return (0);
}
Пример #11
0
static int
f_unl_com (alist *a, int lock)
#endif
{
   unit           *ftnunit = find_luno(a->aunit);

   if (ftnunit == NULL)
      err (a->aerr, 101, "unlock");
   while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
       ;
   if (ftnunit->uconn > 0) {
      if (ftnunit->uacc != KEYED)
	 errret(a->aerr, 163, "unlock");
      if (isrelease (ftnunit->isfd) < SUCCESS)
	 ierrret(a->aerr, iserrno, "unlock");
   }
   else
      err (a->aerr, 101, "delete");
   if (lock) ftnunit->lock_unit = 0;
   return 0;
}
Пример #12
0
int
s_xsfe_mp (cilist *a, unit **fu)
#endif
{
   int             n = wsfe(a, fu, 0);
   unit		  *ftnunit;
   
   ftnunit = *fu;
   ftnunit->f77idxlist.cimatch = a->cimatch;
   ftnunit->f77idxlist.cikeytype = a->cikeytype;
   ftnunit->f77idxlist.cikeyval.cicharval = a->cikeyval.cicharval;
   ftnunit->f77idxlist.cikeyid = a->cikeyid;
   ftnunit->f77idxlist.cinml = a->cinml;
   ftnunit->f77idxlist.cikeyvallen = a->cikeyvallen;
   if (n) {
      return n;
   }
   if (ftnunit->uacc != KEYED)
      errret(a->cierr, 162, "rewrite");
   ftnunit->dowrite = idxrewrite;
   return (0);
}
Пример #13
0
static int32 s_wsfe_com (cilist64 *a, unit **fu)
{
   unit           *ftnunit;
   int             n = wsfe(a, fu, 0);

   ftnunit = *fu;
   if (n)
      return n;
   if (ftnunit->uacc != KEYED) {
      if (f77nowwriting (ftnunit))
	 errret(a->cierr, 160, "startwrt");
   }

#ifdef I90
   ftnunit->f90sw = 0;
   ftnunit->f90nadv = 0;
   ftnunit->f77recpos = 0;
   ftnunit->f77recend = 0;
#endif
   ftnunit->dowrite = x_wEND;
   return (0);
}
Пример #14
0
static int
s_rsue_com (cilist64 *a, unit **fu)
{
    int             n;
    unit           *ftnunit;
    int		f77reclen_32bit;

    if (!f77init)
        f_init ();

    n = c_sue (a, fu);
    ftnunit = *fu;
    if (n) {
        if (n > 0) {
            errret(a->cierr, n, "s_rsue");
        } else {
            errret(a->ciend, n, "s_rsue");
        }
    }

    ftnunit->f77recpos = ftnunit->f77reclen = 0;

#ifdef I90
    if (ftnunit->uaction == WRITEONLY )
        errret(ftnunit->f77errlist.cierr,180,"startread");
#endif

    /*
     * The direct unformatted case, yup, in the sequential unformatted
     * file.
     */

    if ((ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
        if (ftnunit->url != 1) {
            ftnunit->f77do_unf = do_ud;
            ftnunit->f77reclen = ftnunit->url;
        } else {
            /* For 'SYSTEM' file set a very large MAX_INT value for record
            length so it cannot be exceeded
            */
#if (_MIPS_SIM == _MIPS_SIM_ABI64)
            ftnunit->f77reclen = LONGLONG_MAX;
#else
            ftnunit->f77reclen = LONG_MAX;
#endif
            ftnunit->f77do_unf = do_ud;
        }
        _fio_seq_pos( ftnunit->ufd, ftnunit );
        ftnunit->uwrt &= ~WR_OP;
        return (0);
    } else {
        if (ftnunit->uwrt & WR_OP)
            (void) f77nowreading (ftnunit);
    }

    /* The normal case. */

    if (ftnunit->uacc == KEYED) {
        ftnunit->f77do_unf = do_ui;
        ftnunit->f77idxlist.cimatch = a->cimatch;
        ftnunit->f77idxlist.cikeytype = a->cikeytype;
        ftnunit->f77idxlist.cikeyval.cicharval = a->cikeyval.cicharval;
        ftnunit->f77idxlist.cikeyid = a->cikeyid;
        ftnunit->f77idxlist.cinml = a->cinml;
        ftnunit->f77idxlist.cikeyvallen = a->cikeyvallen;
        if (n = idxread(ftnunit)) {
            if (n > 0) {
                errret(a->cierr, n, "s_rsue");
            } else {
                errret(a->ciend, n, "s_rsue");
            }
        }
    } else if (ftnunit->url != 1) {
        ftnunit->f77do_unf = do_us;
        if (ftnunit->uerror)
            unf_position (ftnunit->ufd, ftnunit);
        if (fread ((char *) &f77reclen_32bit, sizeof (int), 1, ftnunit->ufd) != 1) {
            if (feof (ftnunit->ufd)) {
                ftnunit->uend = 1;
                errret(a->ciend, EOF, "start");
            }
            clearerr(ftnunit->ufd);
            errret(a->cierr, errno, "start");
        }
        ftnunit->f77reclen = f77reclen_32bit;
    } else {
        ftnunit->f77reclen = INT_MAX;
        ftnunit->f77do_unf = do_ud;
    }
    return (0);
}
Пример #15
0
int s_rsfe_com (cilist *a, unit **fu)
#endif
{
   int             n;
   unit           *ftnunit;

   if (!f77init)
      f_init ();
   if (n = c_sfe (a, fu))
      return (n);
   ftnunit = *fu;

/* Fix BN 9768.
 * If user tries to read from stdout  then cause startio to abort with an
 * error. This is particularly importrant if a user is tries to read from
 * fortran unit 6 , which by default is connected to stdout. Even though
 * the standard says nothing about the way unit 5 and unit 6 should be
 * handled, I generally think that it is a good idea to distinguish 
 * between these and not allow users to read from stdout.
 * ---ravi---1/7/92
 */
   /* Fix 12308: Read error from stdout should occur for only files
    * connected to terminal. The change is taken from the 'fix'
    * section of the bug description - Bhaskar 08/14/92 */
   if (ftnunit->ufd == stdout && isatty (fileno (ftnunit->ufd)))
      errret(a->cierr, 173, "startio");
   ftnunit->f77errlist.cierr = a->cierr;
   ftnunit->f77errlist.ciend = a->ciend;
   ftnunit->f77errlist.cieor = a->cieor;
   ftnunit->f77errlist.cisize = a->cisize;
   ftnunit->f77errlist.iciunit = 0; 
   ftnunit->f77scale = 0;
   ftnunit->f77fmtbuf = a->cifmt;
   if (ftnunit->uacc == KEYED) {
      ftnunit->f77idxlist.cimatch = a->cimatch;
      ftnunit->f77idxlist.cikeytype = a->cikeytype;
      ftnunit->f77idxlist.cikeyval.cicharval = a->cikeyval.cicharval;
      ftnunit->f77idxlist.cikeyid = a->cikeyid;
      ftnunit->f77idxlist.cinml = a->cinml;
      ftnunit->f77idxlist.cikeyvallen = a->cikeyvallen;
   }
   else {
      if (ftnunit->uacc == DIRECT)
	 errret(a->cierr, 171, "sequential read");
      if (ftnunit->ualias->ucc == CC_FORTRAN &&
	  ftnunit->ualias->ucchar) {
	 putc (ftnunit->ualias->ucchar, ftnunit->ualias->ufd);
	 ftnunit->ualias->ucchar = '\0';
      } else if (ftnunit->ucc == CC_FORTRAN && ftnunit->ucchar) {
	 putc (ftnunit->ucchar, ftnunit->ufd);
	 ftnunit->ucchar = '\0';
      }
   }
#ifdef I90
   ftnunit->f90sw = 0;
   ftnunit->f90nadv = 0;
#endif
   if (pars_f (ftnunit, ftnunit->f77fmtbuf) < 0)
      errret(a->cierr, 100, "startio");
   ftnunit->f77getn = x_getc;
   ftnunit->f77gets = x_gets;
   ftnunit->f77ungetn = x_ungetc;
   ftnunit->f77doed = rd_ed;
   ftnunit->f77doned = rd_ned;
   fmt_bg (ftnunit);
   ftnunit->f77doend = x_endp;
   ftnunit->f77donewrec = xrd_SL;
   ftnunit->f77dorevert = x_rev;
   ftnunit->f77cblank = ftnunit->ublnk;
   ftnunit->f77cplus = 0;

   if (ftnunit->ufd == stdin && feof (ftnunit->ufd) && f77vms_flag_[VMS_IN])
      clearerr(ftnunit->ufd);
   (void) f77nowreading (ftnunit);
   check_buflen( ftnunit, ftnunit->url > FIO_ALLOC ? ftnunit->url : FIO_ALLOC );

#ifdef I90
   if (ftnunit->uaction == WRITEONLY ) 
       errret(ftnunit->f77errlist.cierr,180,"startread");
   ftnunit->f77recpos = 0;
   ftnunit->f77recend = 0;
#endif

   n = xrd_SL (ftnunit);
   if (n > 0) {
     errret(a->cierr, n, "s_rsfe");
   } else if (n < 0) {
     errret(a->ciend, n, "s_rsfe");
   } else 
     return(0);
}
Пример #16
0
static int
f_rew_com (alist *a, int lock)
{
   unit           *ftnunit;
  
   if ((ftnunit = find_luno (a->aunit)) == NULL)
      return(0);
   while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
       ;

   if (ftnunit->uacc == KEYED)
      errret(a->aerr, 164, "rewind");

   if (ftnunit->uconn <= 0) {
      ftnunit->lock_unit = 0;
      return (0);
   }

   if (!ftnunit->useek && !ftnunit->uistty)
      errret(a->aerr, 106, "rewind");
   ftnunit->uend = 0;

   /* Need to reset the associate variable to 1 if exists */
   if (ftnunit->uassocv)
      set_var (ftnunit->uassocv, ftnunit->umask, ASSOCV, (ftnll) 1);

   /* Rewind of a direct unformatted file. */

   if ((ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
      if (-1 == lseek ((int) ftnunit->ufd, 0, SEEK_SET)) {
	 errret(a->aerr, 106, "rewind");
      }
      /* need to change the internal buffer position in fio_direct_io as well */
      _fio_set_seek((int) ftnunit->ufd,  (ftnll) 0, 0);
      ftnunit->uirec = 0;
      ftnunit->lock_unit = 0;
      return (1);
   }

#ifdef I90
   /* Make sure these variables are zeroed out to allow record to be reread. */
   ftnunit->f77recpos = 0;
   ftnunit->f77recend = 0;
#endif

   if (f77vms_flag_[VMS_EF]) {	/* rewind to the last endfile record
				 * or beginning of file */
      char            buf[513];
      XINT64             y, x;
      int	 i, n;
      char            ch;

      /*  If last operation was a WRITE, truncate the file and then make
      sure that the file mode is switched to READ so the the next 
      REWIND/BACKSPACE won't truncate the file again
      */
      if (ftnunit->uwrt & WR_OP) {
#ifdef I90
	 /* If in Fortran-90 nonadvancing mode, write endfile record (\n only). */
	 if (ftnunit->f90sw == 1 && ftnunit->f90nadv == 1 ) {
	     putc ('\n', ftnunit->ufd);
	     ftnunit->f90nadv = 0;
	 }
#endif
	 (void) t_runc (ftnunit, a->aerr);
	 /* If the file is in write-only mode make sure that it is readable */
	 if (f77nowreading(ftnunit))
	    errret(a->aerr, 106, "rewind");
      }
      if (ftnunit->ufmt != 1) {
	 if (ftell (ftnunit->ufd) == 0) {
            ftnunit->lock_unit = 0;
	    return (0);		/* already at beginning of file */
	 }
	 if (fseek (ftnunit->ufd, (long) (-sizeof (int)), 1) < 0)
	    errret(a->aerr, 106, "rewind");
	 for (i = 0;; i++) {
	    (void) fread ((char *) &n, sizeof (int), 1, ftnunit->ufd);
	    if (n != 1 || i == 0) {
	       if (fseek (ftnunit->ufd, (long) (-n - 3 * sizeof (int)), 1)) {
		  rewind (ftnunit->ufd);
                  ftnunit->lock_unit = 0;
		  return (0);
	       }
	    } else {
	       if (fseek (ftnunit->ufd, -(sizeof (int) + 1), 1)) {
		  rewind (ftnunit->ufd);
                  ftnunit->lock_unit = 0;
		  return (0);
	       }
	       (void) fread ((char *) &ch, 1, 1, ftnunit->ufd);
	       if (ch == '\032') {
		  fseek (ftnunit->ufd, sizeof (int), 1);
                  ftnunit->lock_unit = 0;
		  return (0);
	       }
	       fseek (ftnunit->ufd, -(2 * sizeof (int) + 1), 1);
	    }
	 }
      }
      y = x = FTELL (ftnunit->ufd) - 2;	/* skip the last endfile
					 * record */
      if (y < 0) {
	  (void) fseek(ftnunit->ufd, 0L, 0);
          ftnunit->lock_unit = 0;
	  return(0);
      }
      ch = '\0';
      for (;;) {
	 if (x < sizeof (buf) - 1)
	    x = 0;
	 else
	    x -= sizeof (buf) - 1;
	 (void) FSEEK (ftnunit->ufd, x, 0);
	 n = (int) fread (buf, 1, (int) (y - x), ftnunit->ufd);
	 buf[n] = ch;
	 for (i = n - 1; i >= 1; i--) {
	    if (buf[i] != '\032' || buf[i + 1] != '\n')
	       continue;
	    (void) fseek (ftnunit->ufd, (long) (i + 2 - n), 1);
            ftnunit->lock_unit = 0;
	    return (0);
	 }
	 if (x == 0) {
	    (void) fseek (ftnunit->ufd, 0L, 0);
            ftnunit->lock_unit = 0;
	    return (0);
	 }
	 y = x;
	 ch = buf[0];
      }
   }
      /*  If last operation was a WRITE, truncate the file and then make
      sure that the file mode is switched to READ so the the next 
      REWIND/BACKSPACE won't truncate the file again
      */
   if (ftnunit->uwrt & WR_OP) {
#ifdef I90
      /* If in Fortran-90 nonadvancing mode, write endfile record (\n only). */
      if (ftnunit->f90sw == 1 && ftnunit->f90nadv == 1 ) {
	  putc ('\n', ftnunit->ufd);
	  ftnunit->f90nadv = 0;
      }
#endif
      (void) t_runc (ftnunit, a->aerr);
      /* If the file is in write-only mode make sure that it is readable */
      if (f77nowreading(ftnunit))
	 errret(a->aerr, 106, "backspace");
   }
   rewind (ftnunit->ufd);
   ftnunit->lock_unit = 0;
   return (0);
}
Пример #17
0
Файл: uio.c Проект: xyuan/Path64
int
do_us (unit *ftnunit, XINT *number, char *ptr, ftnlen len)
{
   if (!(ftnunit->uwrt & WR_OP)) {
      XINT             nread = *number * len;

      ftnunit->f77recpos += nread;
      if (ftnunit->f77reclen == 1 && f77vms_flag_[VMS_EF]) {
	 /* VMS endfile record */
	 (void) fread (ptr, 1, 1, ftnunit->ufd);
	 if (*ptr == '\032') {
	    (void) fseek (ftnunit->ufd, sizeof (int), 1);
	    return( EOF );	/* Endfile record */
	 } else if (ftnunit->f77recpos > 1)
	    errret(ftnunit->f77errlist.cierr, 110, "eof/uio");
	 return (0);
      }
      if (ftnunit->f77recpos > ftnunit->f77reclen) {
	 ftnunit->f77recpos -= nread;
	 (void) fread (ptr, (int) ftnunit->f77reclen - ftnunit->f77recpos, 1, ftnunit->ufd);
	 errret(ftnunit->f77errlist.cierr, 110, "eof/uio");
      }
      (void) fread (ptr, (int) nread, 1, ftnunit->ufd);
      return (0);
   } else {

/* 7/18/90 MNH  REPLACE FWRITE WITH MEMCPY -- FWRITE BEGAN AT BYTE #5 TO */
/* ALLOW SPACE FOR EVENTUAL FRWITE OF "f77reclen" TO BEGINNING OF FILE */
      XINT             n = *number * len;
      int             seekdone = 0;

      if (ftnunit->f77recpos + n > ftnunit->f77fio_size || n >= BUFSIZ || est_reclen) {
	 if (!ftnunit->overflowed) {
	    ftnunit->overflowed = 1;
	    if (!est_reclen) {
	       if (ftnunit->f77recpos == 4) {
		  fseek (ftnunit->ufd, 4, 1);
		  seekdone = 1;
		  ftnunit->f77recpos = 0;
	       }
	    } else
	       *(int *) ftnunit->f77fio_buf = est_reclen;
	 }
	 if (ftnunit->f77recpos) {
	    if (fwrite (ftnunit->f77fio_buf, ftnunit->f77recpos, 1, ftnunit->ufd) != 1)
	       errret(ftnunit->f77errlist.cierr, errno, "system write error");
	    ftnunit->f77recpos = 0;
	 }
	 if (n >= BUFSIZ) {
	    /* for large user data it's preferable to flush the
	     * system buffer to disk so that it won't have to copy
	     * the user array, which could be several megs, to the
	     * system buffer before writing it out */
	    if (!seekdone)
	       fseek (ftnunit->ufd, 0, 1);
	    if (fwrite (ptr, n, 1, ftnunit->ufd) != 1)
	       errret(ftnunit->f77errlist.cierr, errno, "system write error");
	    ftnunit->f77reclen += n;
	    return (0);
	 }
      }
      if (!est_reclen) {
	 if (ftnunit->f77recpos + n > ftnunit->f77fio_size)
             check_buflen( ftnunit, ftnunit->f77recpos + n );
	 memcpy (ftnunit->f77fio_buf + ftnunit->f77recpos, ptr, n);
	 ftnunit->f77recpos += n;
      } else if (fwrite (ptr, n, 1, ftnunit->ufd) != 1) {
	 ftnunit->f77recpos = 0;
	 errret(ftnunit->f77errlist.cierr, errno, "system write error");
      }
      ftnunit->f77reclen += n;
      return (0);
   }
}
Пример #18
0
static ftnint
__f77_f_back_com (alist *a, int lock) 

{
   unit           *ftnunit;
   int             n, i;
   ftnll            x, y;
   char            buf[512];

   if ((ftnunit = find_luno (a->aunit)) == NULL)
      err(a->aerr, 114, "backspace");
   while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
       ;
   if (ftnunit->uacc == APPEND || ftnunit->uacc == KEYED)
      errret(a->aerr, 165, "backspace");
   if (ftnunit->useek == 0 || ftnunit->url == 1)
      errret(a->aerr, 106, "backspace");
   if (ftnunit->uend == 1) {
      ftnunit->uend = 0;
      ftnunit->lock_unit = 0;
      return (0);
   }
   if (ftnunit->uwrt & WR_OP) {
#ifdef I90
      /* If in Fortran-90 nonadvancing mode, write endfile record (\n only). */
      if (ftnunit->f90sw == 1 && ftnunit->f90nadv == 1 ) {
	  putc ('\n', ftnunit->ufd);
	  ftnunit->f90nadv = 0;
      }
#endif
      /* Just completed a write operation, a backspace would force
      the truncation of the file at the current position.
      */
      (void) t_runc (ftnunit, a->aerr);
      /* make sure it gets switched back to reading mode so the
      file won't get truncated again if it gets backspace/rewind again
      */
      if (f77nowreading(ftnunit))
	 errret(a->aerr, 106, "backspace");
   }
   /* Backspace a direct unformatted file. */

   if ((ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
      if (ftnunit->uirec != 0)
	 ftnunit->uirec--;
      ftnunit->lock_unit = 0;
      return (0);
   }
   if (ftnunit->ufmt != 1) {
      if (ftnunit->uerror)
	 unf_position (ftnunit->ufd, ftnunit);
      if (fseek (ftnunit->ufd, -(long) sizeof (int), 1)) {
	  fseek(ftnunit->ufd, 0L, 0);
          ftnunit->lock_unit = 0;
	  return(0);
      }
      /* NEED TO CHANGE HERE DLAI */
      (void) fread ((char *) &n, sizeof (int), 1, ftnunit->ufd);
      (void) fseek (ftnunit->ufd, (long) (-n - 2 * sizeof (int)), 1);
      ftnunit->lock_unit = 0;
      return (0);
   }

   y = x = FTELL (ftnunit->ufd) - 1;	/* skip the last CR */

   /* If already at the beginning of file, ignore the backspace */

   if (x < 0) {
      ftnunit->lock_unit = 0;
      return (0);
   }

#ifdef I90
   /* Make sure these variables are zeroed out to allow record to be reread. */
   ftnunit->f77recpos = 0;
   ftnunit->f77recend = 0;
#endif

   for (;;) {
      if (x < sizeof (buf))
	 x = 0;
      else
	 x -= sizeof (buf);
      (void) FSEEK (ftnunit->ufd, x, 0);
      /* n should be ll for 64 bit records */
      n = (int) fread (buf, 1, (int) (y - x), ftnunit->ufd);
      for (i = n - 1; i >= 0; i--) {
	 if (buf[i] != '\n')
	    continue;
	 (void) fseek (ftnunit->ufd, (long) (i + 1 - n), 1);
         ftnunit->lock_unit = 0;
	 return (0);
      }
      if (x == 0) {
	 (void) fseek (ftnunit->ufd, 0L, 0);
         ftnunit->lock_unit = 0;
	 return (0);
      } else if (n <= 0)
	 errret (a->aerr, (EOF), "backspace")
	    (void) FSEEK (ftnunit->ufd, x, 0);
      y = x;
   }
}