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