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