1 #include "stdlib.h"
2 #ifndef NON_UNIX_STDIO
3 #include "sys/types.h"
4 #include "sys/stat.h"
5 #endif
6 #include "f2c.h"
7 #include "fio.h"
8 #include "fmt.h" /* for struct syl */
9 #include "rawio.h" /* for fcntl.h, fdopen */
10 #ifdef NON_UNIX_STDIO
11 #ifdef KR_headers
12 extern char *malloc();
13 #else
14 #undef abs
15 #undef min
16 #undef max
17 #include "stdlib.h"
18 #endif
19 #endif
20
21 /*global definitions*/
22 unit f__units[MXUNIT]; /*unit table*/
23 flag f__init; /*0 on entry, 1 after initializations*/
24 cilist *f__elist; /*active external io list*/
25 icilist *f__svic; /*active internal io list*/
26 flag f__reading; /*1 if reading, 0 if writing*/
27 flag f__cplus,f__cblank;
28 char *f__fmtbuf;
29 flag f__external; /*1 if external io, 0 if internal */
30 #ifdef KR_headers
31 int (*f__doed)(),(*f__doned)();
32 int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)();
33 int (*f__getn)(),(*f__putn)(); /*for formatted io*/
34 #else
35 int (*f__getn)(void),(*f__putn)(int); /*for formatted io*/
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 };
81 #define MAXERR (sizeof(F_err)/sizeof(char *)+100)
82
83 #ifdef KR_headers
f__canseek(f)84 f__canseek(f) FILE *f; /*SYSDEP*/
85 #else
86 f__canseek(FILE *f) /*SYSDEP*/
87 #endif
88 {
89 #ifdef NON_UNIX_STDIO
90 return !isatty(fileno(f));
91 #else
92 struct stat x;
93
94 if (fstat(fileno(f),&x) < 0)
95 return(0);
96 #ifdef S_IFMT
97 switch(x.st_mode & S_IFMT) {
98 case S_IFDIR:
99 case S_IFREG:
100 if(x.st_nlink > 0) /* !pipe */
101 return(1);
102 else
103 return(0);
104 case S_IFCHR:
105 if(isatty(fileno(f)))
106 return(0);
107 return(1);
108 #ifdef S_IFBLK
109 case S_IFBLK:
110 return(1);
111 #endif
112 }
113 #else
114 #ifdef S_ISDIR
115 /* POSIX version */
116 if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
117 if(x.st_nlink > 0) /* !pipe */
118 return(1);
119 else
120 return(0);
121 }
122 if (S_ISCHR(x.st_mode)) {
123 if(isatty(fileno(f)))
124 return(0);
125 return(1);
126 }
127 if (S_ISBLK(x.st_mode))
128 return(1);
129 #else
130 Help! How does fstat work on this system?
131 #endif
132 #endif
133 return(0); /* who knows what it is? */
134 #endif
135 }
136
137 void
138 #ifdef KR_headers
f__fatal(n,s)139 f__fatal(n,s) char *s;
140 #else
141 f__fatal(int n, char *s)
142 #endif
143 {
144 if(n<100 && n>=0) perror(s); /*SYSDEP*/
145 else if(n >= (int)MAXERR || n < -1)
146 { fprintf(stderr,"%s: illegal error number %d\n",s,n);
147 }
148 else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
149 else
150 fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
151 if (f__curunit) {
152 fprintf(stderr,"apparent state: unit %ld ",(long)(f__curunit-f__units));
153 fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
154 f__curunit->ufnm);
155 }
156 else
157 fprintf(stderr,"apparent state: internal I/O\n");
158 if (f__fmtbuf)
159 fprintf(stderr,"last format: %s\n",f__fmtbuf);
160 fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing",
161 f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted",
162 f__external?"external":"internal");
163 sig_die(" IO", 1);
164 }
165 /*initialization routine*/
166 VOID
f_init(Void)167 f_init(Void)
168 { unit *p;
169
170 f__init=1;
171 p= &f__units[0];
172 p->ufd=stderr;
173 p->useek=f__canseek(stderr);
174 #ifdef NON_UNIX_STDIO
175 setbuf(stderr, (char *)malloc(BUFSIZ));
176 #else
177 stderr->_flag &= ~_IONBF;
178 #endif
179 p->ufmt=1;
180 p->uwrt=1;
181 p = &f__units[5];
182 p->ufd=stdin;
183 p->useek=f__canseek(stdin);
184 p->ufmt=1;
185 p->uwrt=0;
186 p= &f__units[6];
187 p->ufd=stdout;
188 p->useek=f__canseek(stdout);
189 p->ufmt=1;
190 p->uwrt=1;
191 }
192 #ifdef KR_headers
f__nowreading(x)193 f__nowreading(x) unit *x;
194 #else
195 f__nowreading(unit *x)
196 #endif
197 {
198 long loc;
199 int ufmt;
200 extern char *f__r_mode[];
201
202 if (!x->ufnm)
203 goto cantread;
204 ufmt = x->ufmt;
205 loc=ftell(x->ufd);
206 if(freopen(x->ufnm,f__r_mode[ufmt],x->ufd) == NULL) {
207 cantread:
208 errno = 126;
209 return(1);
210 }
211 x->uwrt=0;
212 (void) fseek(x->ufd,loc,SEEK_SET);
213 return(0);
214 }
215 #ifdef KR_headers
f__nowwriting(x)216 f__nowwriting(x) unit *x;
217 #else
218 f__nowwriting(unit *x)
219 #endif
220 {
221 long loc;
222 int ufmt;
223 extern char *f__w_mode[];
224 #ifndef NON_UNIX_STDIO
225 int k;
226 #endif
227
228 if (!x->ufnm)
229 goto cantwrite;
230 ufmt = x->ufmt;
231 #ifdef NON_UNIX_STDIO
232 ufmt |= 2;
233 #endif
234 if (x->uwrt == 3) { /* just did write, rewind */
235 #ifdef NON_UNIX_STDIO
236 if (!(f__cf = x->ufd =
237 freopen(x->ufnm,f__w_mode[ufmt],x->ufd)))
238 #else
239 if (close(creat(x->ufnm,0666)))
240 #endif
241 goto cantwrite;
242 }
243 else {
244 loc=ftell(x->ufd);
245 #ifdef NON_UNIX_STDIO
246 if (!(f__cf = x->ufd =
247 freopen(x->ufnm, f__w_mode[ufmt], x->ufd)))
248 #else
249 if (fclose(x->ufd) < 0
250 || (k = x->uwrt == 2 ? creat(x->ufnm,0666)
251 : open(x->ufnm,O_WRONLY)) < 0
252 || (f__cf = x->ufd = fdopen(k,f__w_mode[ufmt])) == NULL)
253 #endif
254 {
255 x->ufd = NULL;
256 cantwrite:
257 errno = 127;
258 return(1);
259 }
260 (void) fseek(x->ufd,loc,SEEK_SET);
261 }
262 x->uwrt = 1;
263 return(0);
264 }
265
266 int
267 #ifdef KR_headers
err__fl(f,m,s)268 err__fl(f, m, s) int f, m; char *s;
269 #else
270 err__fl(int f, int m, char *s)
271 #endif
272 {
273 if (!f)
274 f__fatal(m, s);
275 if (f__doend)
276 (*f__doend)();
277 return errno = m;
278 }
279