| 1 | #include "config.h"
|
|---|
| 2 | #ifndef NON_UNIX_STDIO
|
|---|
| 3 | #define _INCLUDE_POSIX_SOURCE /* for HP-UX */
|
|---|
| 4 | #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
|
|---|
| 5 | #include <sys/types.h>
|
|---|
| 6 | #include <sys/stat.h>
|
|---|
| 7 | #endif
|
|---|
| 8 | #include "f2c.h"
|
|---|
| 9 | #ifdef KR_headers
|
|---|
| 10 | extern char *malloc();
|
|---|
| 11 | #else
|
|---|
| 12 | #undef abs
|
|---|
| 13 | #undef min
|
|---|
| 14 | #undef max
|
|---|
| 15 | #include <stdlib.h>
|
|---|
| 16 | #endif
|
|---|
| 17 | #include "fio.h"
|
|---|
| 18 | #include "fmt.h" /* for struct syl */
|
|---|
| 19 |
|
|---|
| 20 | /*global definitions*/
|
|---|
| 21 | unit f__units[MXUNIT]; /*unit table*/
|
|---|
| 22 | int f__init; /*bit 0: set after initializations;
|
|---|
| 23 | bit 1: set during I/O involving returns to
|
|---|
| 24 | caller of library (or calls to user code)*/
|
|---|
| 25 | cilist *f__elist; /*active external io list*/
|
|---|
| 26 | icilist *f__svic; /*active internal io list*/
|
|---|
| 27 | flag f__reading; /*1 if reading, 0 if writing*/
|
|---|
| 28 | flag f__cplus,f__cblank;
|
|---|
| 29 | char *f__fmtbuf;
|
|---|
| 30 | int f__fmtlen;
|
|---|
| 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)(); /* for formatted input */
|
|---|
| 36 | void (*f__putn)(); /* for formatted output */
|
|---|
| 37 | #else
|
|---|
| 38 | int (*f__getn)(void); /* for formatted input */
|
|---|
| 39 | void (*f__putn)(int); /* for formatted output */
|
|---|
| 40 | int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
|
|---|
| 41 | int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void);
|
|---|
| 42 | #endif
|
|---|
| 43 | flag f__sequential; /*1 if sequential io, 0 if direct*/
|
|---|
| 44 | flag f__formatted; /*1 if formatted io, 0 if unformatted*/
|
|---|
| 45 | FILE *f__cf; /*current file*/
|
|---|
| 46 | unit *f__curunit; /*current unit*/
|
|---|
| 47 | int f__recpos; /*place in current record*/
|
|---|
| 48 | int f__cursor, f__hiwater, f__scale;
|
|---|
| 49 | char *f__icptr;
|
|---|
| 50 |
|
|---|
| 51 | /*error messages*/
|
|---|
| 52 | char *F_err[] =
|
|---|
| 53 | {
|
|---|
| 54 | "error in format", /* 100 */
|
|---|
| 55 | "illegal unit number", /* 101 */
|
|---|
| 56 | "formatted io not allowed", /* 102 */
|
|---|
| 57 | "unformatted io not allowed", /* 103 */
|
|---|
| 58 | "direct io not allowed", /* 104 */
|
|---|
| 59 | "sequential io not allowed", /* 105 */
|
|---|
| 60 | "can't backspace file", /* 106 */
|
|---|
| 61 | "null file name", /* 107 */
|
|---|
| 62 | "can't stat file", /* 108 */
|
|---|
| 63 | "unit not connected", /* 109 */
|
|---|
| 64 | "off end of record", /* 110 */
|
|---|
| 65 | "truncation failed in endfile", /* 111 */
|
|---|
| 66 | "incomprehensible list input", /* 112 */
|
|---|
| 67 | "out of free space", /* 113 */
|
|---|
| 68 | "unit not connected", /* 114 */
|
|---|
| 69 | "read unexpected character", /* 115 */
|
|---|
| 70 | "bad logical input field", /* 116 */
|
|---|
| 71 | "bad variable type", /* 117 */
|
|---|
| 72 | "bad namelist name", /* 118 */
|
|---|
| 73 | "variable not in namelist", /* 119 */
|
|---|
| 74 | "no end record", /* 120 */
|
|---|
| 75 | "variable count incorrect", /* 121 */
|
|---|
| 76 | "subscript for scalar variable", /* 122 */
|
|---|
| 77 | "invalid array section", /* 123 */
|
|---|
| 78 | "substring out of bounds", /* 124 */
|
|---|
| 79 | "subscript out of bounds", /* 125 */
|
|---|
| 80 | "can't read file", /* 126 */
|
|---|
| 81 | "can't write file", /* 127 */
|
|---|
| 82 | "'new' file exists", /* 128 */
|
|---|
| 83 | "can't append to file", /* 129 */
|
|---|
| 84 | "non-positive record number", /* 130 */
|
|---|
| 85 | "I/O started while already doing I/O", /* 131 */
|
|---|
| 86 | "Temporary file name (TMPDIR?) too long" /* 132 */
|
|---|
| 87 | };
|
|---|
| 88 | #define MAXERR (sizeof(F_err)/sizeof(char *)+100)
|
|---|
| 89 |
|
|---|
| 90 | #ifdef KR_headers
|
|---|
| 91 | f__canseek(f) FILE *f; /*SYSDEP*/
|
|---|
| 92 | #else
|
|---|
| 93 | f__canseek(FILE *f) /*SYSDEP*/
|
|---|
| 94 | #endif
|
|---|
| 95 | {
|
|---|
| 96 | #ifdef NON_UNIX_STDIO
|
|---|
| 97 | return !isatty(fileno(f));
|
|---|
| 98 | #else
|
|---|
| 99 | struct stat x;
|
|---|
| 100 |
|
|---|
| 101 | if (fstat(fileno(f),&x) < 0)
|
|---|
| 102 | return(0);
|
|---|
| 103 | #ifdef S_IFMT
|
|---|
| 104 | switch(x.st_mode & S_IFMT) {
|
|---|
| 105 | case S_IFDIR:
|
|---|
| 106 | case S_IFREG:
|
|---|
| 107 | if(x.st_nlink > 0) /* !pipe */
|
|---|
| 108 | return(1);
|
|---|
| 109 | else
|
|---|
| 110 | return(0);
|
|---|
| 111 | case S_IFCHR:
|
|---|
| 112 | if(isatty(fileno(f)))
|
|---|
| 113 | return(0);
|
|---|
| 114 | return(1);
|
|---|
| 115 | #ifdef S_IFBLK
|
|---|
| 116 | case S_IFBLK:
|
|---|
| 117 | return(1);
|
|---|
| 118 | #endif
|
|---|
| 119 | }
|
|---|
| 120 | #else
|
|---|
| 121 | #ifdef S_ISDIR
|
|---|
| 122 | /* POSIX version */
|
|---|
| 123 | if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
|
|---|
| 124 | if(x.st_nlink > 0) /* !pipe */
|
|---|
| 125 | return(1);
|
|---|
| 126 | else
|
|---|
| 127 | return(0);
|
|---|
| 128 | }
|
|---|
| 129 | if (S_ISCHR(x.st_mode)) {
|
|---|
| 130 | if(isatty(fileno(f)))
|
|---|
| 131 | return(0);
|
|---|
| 132 | return(1);
|
|---|
| 133 | }
|
|---|
| 134 | if (S_ISBLK(x.st_mode))
|
|---|
| 135 | return(1);
|
|---|
| 136 | #else
|
|---|
| 137 | Help! How does fstat work on this system?
|
|---|
| 138 | #endif
|
|---|
| 139 | #endif
|
|---|
| 140 | return(0); /* who knows what it is? */
|
|---|
| 141 | #endif
|
|---|
| 142 | }
|
|---|
| 143 |
|
|---|
| 144 | void
|
|---|
| 145 | #ifdef KR_headers
|
|---|
| 146 | f__fatal(n,s) char *s;
|
|---|
| 147 | #else
|
|---|
| 148 | f__fatal(int n, char *s)
|
|---|
| 149 | #endif
|
|---|
| 150 | {
|
|---|
| 151 | static int dead = 0;
|
|---|
| 152 |
|
|---|
| 153 | if(n<100 && n>=0) perror(s); /*SYSDEP*/
|
|---|
| 154 | else if(n >= (int)MAXERR || n < -1)
|
|---|
| 155 | { fprintf(stderr,"%s: illegal error number %d\n",s,n);
|
|---|
| 156 | }
|
|---|
| 157 | else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
|
|---|
| 158 | else
|
|---|
| 159 | fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
|
|---|
| 160 | if (dead) {
|
|---|
| 161 | fprintf (stderr, "(libf2c f__fatal already called, aborting.)");
|
|---|
| 162 | abort();
|
|---|
| 163 | }
|
|---|
| 164 | dead = 1;
|
|---|
| 165 | if (f__init & 1) {
|
|---|
| 166 | if (f__curunit) {
|
|---|
| 167 | fprintf(stderr,"apparent state: unit %d ",
|
|---|
| 168 | (int)(f__curunit-f__units));
|
|---|
| 169 | fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
|
|---|
| 170 | f__curunit->ufnm);
|
|---|
| 171 | }
|
|---|
| 172 | else
|
|---|
| 173 | fprintf(stderr,"apparent state: internal I/O\n");
|
|---|
| 174 | if (f__fmtbuf)
|
|---|
| 175 | fprintf(stderr,"last format: %.*s\n",f__fmtlen,f__fmtbuf);
|
|---|
| 176 | fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing",
|
|---|
| 177 | f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted",
|
|---|
| 178 | f__external?"external":"internal");
|
|---|
| 179 | }
|
|---|
| 180 | f__init &= ~2; /* No longer doing I/O (no more user code to be called). */
|
|---|
| 181 | sig_die(" IO", 1);
|
|---|
| 182 | }
|
|---|
| 183 | /*initialization routine*/
|
|---|
| 184 | VOID
|
|---|
| 185 | f_init(Void)
|
|---|
| 186 | { unit *p;
|
|---|
| 187 |
|
|---|
| 188 | if (f__init & 2)
|
|---|
| 189 | f__fatal (131, "I/O recursion");
|
|---|
| 190 | f__init = 1;
|
|---|
| 191 | p= &f__units[0];
|
|---|
| 192 | p->ufd=stderr;
|
|---|
| 193 | p->useek=f__canseek(stderr);
|
|---|
| 194 | p->ufmt=1;
|
|---|
| 195 | p->uwrt=1;
|
|---|
| 196 | p = &f__units[5];
|
|---|
| 197 | p->ufd=stdin;
|
|---|
| 198 | p->useek=f__canseek(stdin);
|
|---|
| 199 | p->ufmt=1;
|
|---|
| 200 | p->uwrt=0;
|
|---|
| 201 | p= &f__units[6];
|
|---|
| 202 | p->ufd=stdout;
|
|---|
| 203 | p->useek=f__canseek(stdout);
|
|---|
| 204 | p->ufmt=1;
|
|---|
| 205 | p->uwrt=1;
|
|---|
| 206 | }
|
|---|
| 207 | #ifdef KR_headers
|
|---|
| 208 | f__nowreading(x) unit *x;
|
|---|
| 209 | #else
|
|---|
| 210 | f__nowreading(unit *x)
|
|---|
| 211 | #endif
|
|---|
| 212 | {
|
|---|
| 213 | off_t loc;
|
|---|
| 214 | int ufmt, urw;
|
|---|
| 215 | extern char *f__r_mode[], *f__w_mode[];
|
|---|
| 216 |
|
|---|
| 217 | if (x->urw & 1)
|
|---|
| 218 | goto done;
|
|---|
| 219 | if (!x->ufnm)
|
|---|
| 220 | goto cantread;
|
|---|
| 221 | ufmt = x->url ? 0 : x->ufmt;
|
|---|
| 222 | loc = FTELL(x->ufd);
|
|---|
| 223 | urw = 3;
|
|---|
| 224 | if (!freopen(x->ufnm, f__w_mode[ufmt|2], x->ufd)) {
|
|---|
| 225 | urw = 1;
|
|---|
| 226 | if(!freopen(x->ufnm, f__r_mode[ufmt], x->ufd)) {
|
|---|
| 227 | cantread:
|
|---|
| 228 | errno = 126;
|
|---|
| 229 | return 1;
|
|---|
| 230 | }
|
|---|
| 231 | }
|
|---|
| 232 | FSEEK(x->ufd,loc,SEEK_SET);
|
|---|
| 233 | x->urw = urw;
|
|---|
| 234 | done:
|
|---|
| 235 | x->uwrt = 0;
|
|---|
| 236 | return 0;
|
|---|
| 237 | }
|
|---|
| 238 | #ifdef KR_headers
|
|---|
| 239 | f__nowwriting(x) unit *x;
|
|---|
| 240 | #else
|
|---|
| 241 | f__nowwriting(unit *x)
|
|---|
| 242 | #endif
|
|---|
| 243 | {
|
|---|
| 244 | off_t loc;
|
|---|
| 245 | int ufmt;
|
|---|
| 246 | extern char *f__w_mode[];
|
|---|
| 247 |
|
|---|
| 248 | if (x->urw & 2)
|
|---|
| 249 | goto done;
|
|---|
| 250 | if (!x->ufnm)
|
|---|
| 251 | goto cantwrite;
|
|---|
| 252 | ufmt = x->url ? 0 : x->ufmt;
|
|---|
| 253 | if (x->uwrt == 3) { /* just did write, rewind */
|
|---|
| 254 | if (!(f__cf = x->ufd =
|
|---|
| 255 | freopen(x->ufnm,f__w_mode[ufmt],x->ufd)))
|
|---|
| 256 | goto cantwrite;
|
|---|
| 257 | x->urw = 2;
|
|---|
| 258 | }
|
|---|
| 259 | else {
|
|---|
| 260 | loc=FTELL(x->ufd);
|
|---|
| 261 | if (!(f__cf = x->ufd =
|
|---|
| 262 | freopen(x->ufnm, f__w_mode[ufmt |= 2], x->ufd)))
|
|---|
| 263 | {
|
|---|
| 264 | x->ufd = NULL;
|
|---|
| 265 | cantwrite:
|
|---|
| 266 | errno = 127;
|
|---|
| 267 | return(1);
|
|---|
| 268 | }
|
|---|
| 269 | x->urw = 3;
|
|---|
| 270 | FSEEK(x->ufd,loc,SEEK_SET);
|
|---|
| 271 | }
|
|---|
| 272 | done:
|
|---|
| 273 | x->uwrt = 1;
|
|---|
| 274 | return 0;
|
|---|
| 275 | }
|
|---|
| 276 |
|
|---|
| 277 | int
|
|---|
| 278 | #ifdef KR_headers
|
|---|
| 279 | err__fl(f, m, s) int f, m; char *s;
|
|---|
| 280 | #else
|
|---|
| 281 | err__fl(int f, int m, char *s)
|
|---|
| 282 | #endif
|
|---|
| 283 | {
|
|---|
| 284 | if (!f)
|
|---|
| 285 | f__fatal(m, s);
|
|---|
| 286 | if (f__doend)
|
|---|
| 287 | (*f__doend)();
|
|---|
| 288 | f__init &= ~2;
|
|---|
| 289 | return errno = m;
|
|---|
| 290 | }
|
|---|
