|
|
1.1 ! root 1: #ifndef MSDOS ! 2: #include "sys/types.h" ! 3: #include "sys/stat.h" ! 4: #endif ! 5: #include "f2c.h" ! 6: #include "fio.h" ! 7: #include "fcntl.h" ! 8: #include "rawio.h" ! 9: #include "fmt.h" /* for struct syl */ ! 10: #ifdef NON_UNIX_STDIO ! 11: #ifdef KR_headers ! 12: extern char *malloc(); ! 13: #else ! 14: #undef abs ! 15: #undef min ! 16: #undef max ! 17: #include "stdlib.h" ! 18: #endif ! 19: #endif ! 20: #ifndef O_WRONLY ! 21: #define O_WRONLY 1 ! 22: #endif ! 23: ! 24: /*global definitions*/ ! 25: unit f__units[MXUNIT]; /*unit table*/ ! 26: flag f__init; /*0 on entry, 1 after initializations*/ ! 27: cilist *f__elist; /*active external io list*/ ! 28: flag f__reading; /*1 if reading, 0 if writing*/ ! 29: flag f__cplus,f__cblank; ! 30: char *f__fmtbuf; ! 31: flag f__external; /*1 if external io, 0 if internal */ ! 32: #ifdef KR_headers ! 33: int (*f__doed)(),(*f__doned)(); ! 34: int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)(); ! 35: int (*f__getn)(),(*f__putn)(); /*for formatted io*/ ! 36: #else ! 37: int (*f__getn)(void),(*f__putn)(int); /*for formatted io*/ ! 38: int (*f__doed)(struct f__syl*, char*, ftnlen),(*f__doned)(struct f__syl*); ! 39: int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void); ! 40: #endif ! 41: flag f__sequential; /*1 if sequential io, 0 if direct*/ ! 42: flag f__formatted; /*1 if formatted io, 0 if unformatted*/ ! 43: FILE *f__cf; /*current file*/ ! 44: unit *f__curunit; /*current unit*/ ! 45: int f__recpos; /*place in current record*/ ! 46: int f__cursor,f__scale; ! 47: ! 48: /*error messages*/ ! 49: char *F_err[] = ! 50: { ! 51: "error in format", /* 100 */ ! 52: "illegal unit number", /* 101 */ ! 53: "formatted io not allowed", /* 102 */ ! 54: "unformatted io not allowed", /* 103 */ ! 55: "direct io not allowed", /* 104 */ ! 56: "sequential io not allowed", /* 105 */ ! 57: "can't backspace file", /* 106 */ ! 58: "null file name", /* 107 */ ! 59: "can't stat file", /* 108 */ ! 60: "unit not connected", /* 109 */ ! 61: "off end of record", /* 110 */ ! 62: "truncation failed in endfile", /* 111 */ ! 63: "incomprehensible list input", /* 112 */ ! 64: "out of free space", /* 113 */ ! 65: "unit not connected", /* 114 */ ! 66: "read unexpected character", /* 115 */ ! 67: "bad logical input field", /* 116 */ ! 68: "bad variable type", /* 117 */ ! 69: "bad namelist name", /* 118 */ ! 70: "variable not in namelist", /* 119 */ ! 71: "no end record", /* 120 */ ! 72: "variable count incorrect", /* 121 */ ! 73: "subscript for scalar variable", /* 122 */ ! 74: "invalid array section", /* 123 */ ! 75: "substring out of bounds", /* 124 */ ! 76: "subscript out of bounds", /* 125 */ ! 77: "can't read file", /* 126 */ ! 78: "can't write file", /* 127 */ ! 79: "'new' file exists" /* 128 */ ! 80: }; ! 81: #define MAXERR (sizeof(F_err)/sizeof(char *)+100) ! 82: ! 83: #ifdef KR_headers ! 84: f__canseek(f) FILE *f; /*SYSDEP*/ ! 85: #else ! 86: f__canseek(FILE *f) /*SYSDEP*/ ! 87: #endif ! 88: { ! 89: #ifdef MSDOS ! 90: return !isatty(fileno(f)); ! 91: #else ! 92: struct stat x; ! 93: ! 94: if (fstat(fileno(f),&x) < 0) ! 95: return(0); ! 96: #ifdef S_IFMT ! 97: switch(x.st_mode & S_IFMT) { ! 98: case S_IFDIR: ! 99: case S_IFREG: ! 100: if(x.st_nlink > 0) /* !pipe */ ! 101: return(1); ! 102: else ! 103: return(0); ! 104: case S_IFCHR: ! 105: if(isatty(fileno(f))) ! 106: return(0); ! 107: return(1); ! 108: #ifdef S_IFBLK ! 109: case S_IFBLK: ! 110: return(1); ! 111: #endif ! 112: } ! 113: #else ! 114: #ifdef S_ISDIR ! 115: /* POSIX version */ ! 116: if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) { ! 117: if(x.st_nlink > 0) /* !pipe */ ! 118: return(1); ! 119: else ! 120: return(0); ! 121: } ! 122: if (S_ISCHR(x.st_mode)) { ! 123: if(isatty(fileno(f))) ! 124: return(0); ! 125: return(1); ! 126: } ! 127: if (S_ISBLK(x.st_mode)) ! 128: return(1); ! 129: #else ! 130: Help! How does fstat work on this system? ! 131: #endif ! 132: #endif ! 133: return(0); /* who knows what it is? */ ! 134: #endif ! 135: } ! 136: ! 137: void ! 138: #ifdef KR_headers ! 139: f__fatal(n,s) char *s; ! 140: #else ! 141: f__fatal(int n, char *s) ! 142: #endif ! 143: { ! 144: if(n<100 && n>=0) perror(s); /*SYSDEP*/ ! 145: else if(n >= (int)MAXERR || n < -1) ! 146: { fprintf(stderr,"%s: illegal error number %d\n",s,n); ! 147: } ! 148: else if(n == -1) fprintf(stderr,"%s: end of file\n",s); ! 149: else ! 150: fprintf(stderr,"%s: %s\n",s,F_err[n-100]); ! 151: if (f__curunit) { ! 152: fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); ! 153: fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", ! 154: f__curunit->ufnm); ! 155: } ! 156: else ! 157: fprintf(stderr,"apparent state: internal I/O\n"); ! 158: if (f__fmtbuf) ! 159: fprintf(stderr,"last format: %s\n",f__fmtbuf); ! 160: fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", ! 161: f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", ! 162: f__external?"external":"internal"); ! 163: sig_die(" IO", 1); ! 164: } ! 165: /*initialization routine*/ ! 166: VOID ! 167: f_init(Void) ! 168: { unit *p; ! 169: ! 170: f__init=1; ! 171: p= &f__units[0]; ! 172: p->ufd=stderr; ! 173: p->useek=f__canseek(stderr); ! 174: #ifdef COMMENTED_OUT ! 175: if(isatty(fileno(stderr))) { ! 176: extern char *malloc(); ! 177: setbuf(stderr, malloc(BUFSIZ)); ! 178: /* setvbuf(stderr, _IOLBF, 0, 0); */ ! 179: } /* wastes space, but win for debugging in windows */ ! 180: #endif ! 181: #ifdef NON_UNIX_STDIO ! 182: setbuf(stderr, malloc(BUFSIZ)); ! 183: #else ! 184: stderr->_flag &= ~_IONBF; ! 185: #endif ! 186: p->ufmt=1; ! 187: p->uwrt=1; ! 188: p = &f__units[5]; ! 189: p->ufd=stdin; ! 190: p->useek=f__canseek(stdin); ! 191: p->ufmt=1; ! 192: p->uwrt=0; ! 193: p= &f__units[6]; ! 194: p->ufd=stdout; ! 195: p->useek=f__canseek(stdout); ! 196: /* IOLBUF and setvbuf only in system 5+ */ ! 197: #ifdef COMMENTED_OUT ! 198: if(isatty(fileno(stdout))) { ! 199: extern char _sobuf[]; ! 200: setbuf(stdout, _sobuf); ! 201: /* setvbuf(stdout, _IOLBF, 0, 0); /* the buf arg in setvbuf? */ ! 202: p->useek = 1; /* only within a record no bigger than BUFSIZ */ ! 203: } ! 204: #endif ! 205: p->ufmt=1; ! 206: p->uwrt=1; ! 207: } ! 208: #ifdef KR_headers ! 209: f__nowreading(x) unit *x; ! 210: #else ! 211: f__nowreading(unit *x) ! 212: #endif ! 213: { ! 214: long loc; ! 215: extern char *f__r_mode[]; ! 216: if (!x->ufnm) ! 217: goto cantread; ! 218: loc=ftell(x->ufd); ! 219: if(freopen(x->ufnm,f__r_mode[x->ufmt],x->ufd) == NULL) { ! 220: cantread: ! 221: errno = 126; ! 222: return(1); ! 223: } ! 224: x->uwrt=0; ! 225: (void) fseek(x->ufd,loc,SEEK_SET); ! 226: return(0); ! 227: } ! 228: #ifdef KR_headers ! 229: f__nowwriting(x) unit *x; ! 230: #else ! 231: f__nowwriting(unit *x) ! 232: #endif ! 233: { ! 234: long loc; ! 235: int k; ! 236: extern char *f__w_mode[]; ! 237: ! 238: if (!x->ufnm) ! 239: goto cantwrite; ! 240: if (x->uwrt == 3) { /* just did write, rewind */ ! 241: if (close(creat(x->ufnm,0666))) ! 242: goto cantwrite; ! 243: } ! 244: else { ! 245: loc=ftell(x->ufd); ! 246: if (fclose(x->ufd) < 0 ! 247: || (k = x->uwrt == 2 ? creat(x->ufnm,0666) ! 248: : open(x->ufnm,O_WRONLY)) < 0 ! 249: || (f__cf = x->ufd = fdopen(k,f__w_mode[x->ufmt])) == NULL) { ! 250: x->ufd = NULL; ! 251: cantwrite: ! 252: errno = 127; ! 253: return(1); ! 254: } ! 255: (void) fseek(x->ufd,loc,SEEK_SET); ! 256: } ! 257: x->uwrt = 1; ! 258: return(0); ! 259: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.