unit_chk(integer Unit, char *who) #endif { if (Unit >= MXUNIT || Unit < 0) f__fatal(101, who); return f__units[Unit].ufd; }
static void opn_err (int m, char *s, olist * a) { if (a->ofnm) { /* supply file name to error message */ if (a->ofnmlen >= f__buflen) f__bufadj ((int) a->ofnmlen, 0); g_char (a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf); } f__fatal (m, s); }
static const char *ap_end(const char *s) { char quote; quote= *s++; for(;*s;s++) { if(*s!=quote) continue; if(*++s!=quote) return(s); } if(f__elist->cierr) { errno = 100; return(NULL); } f__fatal(100, "bad string"); /*NOTREACHED*/ return 0; }
integer f_end(alist *a) #endif { unit *b; FILE *tf; if (f__init & 2) f__fatal (131, "I/O recursion"); if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile"); b = &f__units[a->aunit]; if(b->ufd==NULL) { char nbuf[10]; sprintf(nbuf,"fort.%ld",a->aunit); if (tf = fopen(nbuf, f__w_mode[0])) fclose(tf); return(0); } b->uend=1; return(b->useek ? t_runc(a) : 0); }
integer f_rew(alist *a) #endif { unit *b; if (f__init & 2) f__fatal (131, "I/O recursion"); if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"rewind"); b = &f__units[a->aunit]; if(b->ufd == NULL || b->uwrt == 3) return(0); if(!b->useek) err(a->aerr,106,"rewind"); if(b->uwrt) { (void) t_runc(a); b->uwrt = 3; } FSEEK(b->ufd, 0, SEEK_SET); b->uend=0; return(0); }
static void f__bufadj (int n, int c) { unsigned int len; char *nbuf, *s, *t, *te; if (f__buf == f__buf0) f__buflen = 1024; while (f__buflen <= n) f__buflen <<= 1; len = (unsigned int) f__buflen; if (len != f__buflen || !(nbuf = (char *) malloc (len))) f__fatal (113, "malloc failure"); s = nbuf; t = f__buf; te = t + c; while (t < te) *s++ = *t++; if (f__buf != f__buf0) free (f__buf); f__buf = nbuf; }
c_si(icilist *a) #endif { if (f__init & 2) f__fatal (131, "I/O recursion"); f__init |= 2; 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); }
static FILE *unit_chk(integer Unit, const char *who) { if (Unit >= MXUNIT || Unit < 0) f__fatal(101, who); return f__units[Unit].ufd; }
l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) #endif { #define Ptr ((flex *)ptr) int i; longint x; double y,z; real *xx; doublereal *yy; for(i=0;i< *number; i++) { switch((int)type) { default: f__fatal(204,"unknown type in lio"); case TYINT1: x = Ptr->flchar; goto xint; case TYSHORT: x=Ptr->flshort; goto xint; #ifdef Allow_TYQUAD case TYQUAD: x = Ptr->fllongint; goto xint; #endif case TYLONG: x=Ptr->flint; xint: lwrt_I(x); break; case TYREAL: y=Ptr->flreal; goto xfloat; case TYDREAL: y=Ptr->fldouble; xfloat: lwrt_F(y); break; case TYCOMPLEX: xx= &Ptr->flreal; y = *xx++; z = *xx; goto xcomplex; case TYDCOMPLEX: yy = &Ptr->fldouble; y= *yy++; z = *yy; xcomplex: lwrt_C(y,z); break; case TYLOGICAL1: x = Ptr->flchar; goto xlog; case TYLOGICAL2: x = Ptr->flshort; goto xlog; case TYLOGICAL: x = Ptr->flint; xlog: lwrt_L(Ptr->flint, len); break; case TYCHAR: lwrt_A(ptr,len); break; } ptr += len; } return(0); }
integer f_inqu(inlist *a) #endif { flag byfile; int i, n; unit *p; char buf[256]; long x; if (f__init & 2) f__fatal (131, "I/O recursion"); if(a->infile!=NULL) { byfile=1; g_char(a->infile,a->infilen,buf); #ifdef NON_UNIX_STDIO x = access(buf,0) ? -1 : 0; for(i=0,p=NULL;i<MXUNIT;i++) if(f__units[i].ufd != NULL && f__units[i].ufnm != NULL && !strcmp(f__units[i].ufnm,buf)) { p = &f__units[i]; break; } #else x=f__inode(buf, &n); for(i=0,p=NULL;i<MXUNIT;i++) if(f__units[i].uinode==x && f__units[i].ufd!=NULL && f__units[i].udev == n) { p = &f__units[i]; break; } #endif } else { byfile=0; if(a->inunit<MXUNIT && a->inunit>=0) { p= &f__units[a->inunit]; } else { p=NULL; } } if(a->inex!=NULL) if(byfile && x != -1 || !byfile && p!=NULL) *a->inex=1; else *a->inex=0; if(a->inopen!=NULL) if(byfile) *a->inopen=(p!=NULL); else *a->inopen=(p!=NULL && p->ufd!=NULL); if(a->innum!=NULL) *a->innum= p-f__units; if(a->innamed!=NULL) if(byfile || p!=NULL && p->ufnm!=NULL) *a->innamed=1; else *a->innamed=0; if(a->inname!=NULL) if(byfile) b_char(buf,a->inname,a->innamlen); else if(p!=NULL && p->ufnm!=NULL) b_char(p->ufnm,a->inname,a->innamlen); if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL) if(p->url) b_char("DIRECT",a->inacc,a->inacclen); else b_char("SEQUENTIAL",a->inacc,a->inacclen); if(a->inseq!=NULL) if(p!=NULL && p->url) b_char("NO",a->inseq,a->inseqlen); else b_char("YES",a->inseq,a->inseqlen); if(a->indir!=NULL) if(p==NULL || p->url) b_char("YES",a->indir,a->indirlen); else b_char("NO",a->indir,a->indirlen); if(a->infmt!=NULL) if(p!=NULL && p->ufmt==0) b_char("UNFORMATTED",a->infmt,a->infmtlen); else b_char("FORMATTED",a->infmt,a->infmtlen); if(a->inform!=NULL) if(p!=NULL && p->ufmt==0) b_char("NO",a->inform,a->informlen); else b_char("YES",a->inform,a->informlen); if(a->inunf) if(p!=NULL && p->ufmt==0) b_char("YES",a->inunf,a->inunflen); else if (p!=NULL) b_char("NO",a->inunf,a->inunflen); else b_char("UNKNOWN",a->inunf,a->inunflen); if(a->inrecl!=NULL && p!=NULL) *a->inrecl=p->url; if(a->innrec!=NULL && p!=NULL && p->url>0) *a->innrec=ftell(p->ufd)/p->url+1; if(a->inblank && p!=NULL && p->ufmt) if(p->ublnk) b_char("ZERO",a->inblank,a->inblanklen); else b_char("NULL",a->inblank,a->inblanklen); return(0); }