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