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