int
s_rsfe(cilist *a) /* start */
{ int n;
if(!init) f_init();
if((n=c_sfe(a,READ))) return(n);
reading=1;
sequential=1;
formatted=1;
external=1;
elist=a;
cursor=recpos=0;
scale=0;
fmtbuf=a->cifmt;
if(pars_f(fmtbuf)<0) err(a->cierr,100,"startio");
curunit= &units[a->ciunit];
cf=curunit->ufd;
getn= x_getc;
doed= rd_ed;
doned= rd_ned;
fmt_bg();
doend=x_endp;
donewrec=xrd_SL;
dorevert=x_rev;
cblank=curunit->ublnk;
cplus=0;
if(curunit->uwrt) nowreading(curunit);
return(0);
}
integer s_rsfe(cilist *a) /* start */
#endif
{ int n;
if(!f__init) f_init();
f__reading=1;
f__sequential=1;
f__formatted=1;
f__external=1;
if(n=c_sfe(a)) return(n);
f__elist=a;
f__cursor=f__recpos=0;
f__scale=0;
f__fmtbuf=a->cifmt;
f__cf=f__curunit->ufd;
if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio");
f__getn= x_getc;
f__doed= rd_ed;
f__doned= rd_ned;
fmt_bg();
f__doend=x_endp;
f__donewrec=xrd_SL;
f__dorevert=x_rev;
f__cblank=f__curunit->ublnk;
f__cplus=0;
if(f__curunit->uwrt && f__nowreading(f__curunit))
err(a->cierr,errno,"read start");
if(f__curunit->uend)
err(f__elist->ciend,(EOF),"read start");
return(0);
}
integer s_wsfe(cilist *a) /*start*/
#endif
{ int n;
if(!f__init) f_init();
if(n=c_sfe(a)) return(n);
f__reading=0;
f__sequential=1;
f__formatted=1;
f__external=1;
f__elist=a;
f__hiwater = f__cursor=f__recpos=0;
f__nonl = 0;
f__scale=0;
f__fmtbuf=a->cifmt;
f__curunit = &f__units[a->ciunit];
f__cf=f__curunit->ufd;
if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio");
f__putn= x_putc;
f__doed= w_ed;
f__doned= w_ned;
f__doend=xw_end;
f__dorevert=xw_rev;
f__donewrec=x_wSL;
fmt_bg();
f__cplus=0;
f__cblank=f__curunit->ublnk;
if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
err(a->cierr,errno,"write start");
return(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);
}
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);
}
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;
}
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);
}
integer s_rdfe(cilist *a)
#endif
{
int n;
if(!f__init) f_init();
f__reading=1;
if((n=c_dfe(a))) return(n);
if(f__curunit->uwrt && f__nowreading(f__curunit))
err(a->cierr,errno,"read start");
f__getn = y_getc;
f__doed = rd_ed;
f__doned = rd_ned;
f__dorevert = f__donewrec = y_err;
f__doend = y_rsk;
if(pars_f(f__fmtbuf)<0)
err(a->cierr,100,"read start");
fmt_bg();
return(0);
}
static int c_si(icilist *a)
{
f__elist = (cilist *)a;
f__fmtbuf=a->icifmt;
f__curunit = 0;
f__sequential=f__formatted=1;
f__external=0;
if(pars_f(f__fmtbuf)<0)
err(a->icierr,100,"startint");
fmt_bg();
f__cblank=f__cplus=f__scale=0;
f__svic=a;
f__icnum=f__recpos=0;
f__cursor = 0;
f__hiwater = 0;
f__icptr = a->iciunit;
f__icend = f__icptr + a->icirlen*a->icirnum;
f__cf = 0;
return(0);
}
integer s_wdfe(cilist *a)
#endif
{
int n;
if(!f__init) f_init();
f__reading=0;
if((n=c_dfe(a))) return(n);
if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
err(a->cierr,errno,"startwrt");
f__putn = x_putc;
f__doed = w_ed;
f__doned= w_ned;
f__dorevert = y_err;
f__donewrec = y_newrec;
f__doend = y_rev;
if(pars_f(f__fmtbuf)<0)
err(a->cierr,100,"startwrt");
fmt_bg();
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);
}
