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 | long 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 | long 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 | } |
---|