1 /****************************************************************
2 Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
3
4 Permission to use, copy, modify, and distribute this software
5 and its documentation for any purpose and without fee is hereby
6 granted, provided that the above copyright notice appear in all
7 copies and that both that the copyright notice and this
8 permission notice and warranty disclaimer appear in supporting
9 documentation, and that the names of AT&T, Bell Laboratories,
10 Lucent or Bellcore or any of their entities not be used in
11 advertising or publicity pertaining to distribution of the
12 software without specific, written prior permission.
13
14 AT&T, Lucent and Bellcore disclaim all warranties with regard to
15 this software, including all implied warranties of
16 merchantability and fitness. In no event shall AT&T, Lucent or
17 Bellcore be liable for any special, indirect or consequential
18 damages or any damages whatsoever resulting from loss of use,
19 data or profits, whether in an action of contract, negligence or
20 other tortious action, arising out of or in connection with the
21 use or performance of this software.
22 ****************************************************************/
23
24 #include <f2c_config.h>
25 #include <stdlib.h>
26 #if defined(_MSC_VER) || defined(__MINGW32__)
27 # include <io.h>
28 # include <stdio.h>
29 #else
30 # ifdef HAVE_ISATTY
31 # include <unistd.h>
32 # else
33 # define isatty(x) 0
34 # endif
35 #endif
36 #include "f2c.h"
37 #include "fio.h"
38 #include "fmt.h" /* for struct syl */
39
40 /*global definitions*/
41 unit f__units[MXUNIT]; /*unit table*/
42 flag f__init; /*0 on entry, 1 after initializations*/
43 cilist *f__elist; /*active external io list*/
44 icilist *f__svic; /*active internal io list*/
45 flag f__reading; /*1 if reading, 0 if writing*/
46 flag f__cplus,f__cblank;
47 const char *f__fmtbuf;
48 flag f__external; /*1 if external io, 0 if internal */
49 int (*f__getn)(void); /* for formatted input */
50 void (*f__putn)(int); /* for formatted output */
51 int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
52 int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void);
53 flag f__sequential; /*1 if sequential io, 0 if direct*/
54 flag f__formatted; /*1 if formatted io, 0 if unformatted*/
55 FILE *f__cf; /*current file*/
56 unit *f__curunit; /*current unit*/
57 int f__recpos; /*place in current record*/
58 OFF_T f__cursor, f__hiwater;
59 int f__scale;
60 char *f__icptr;
61
62 /*error messages*/
63 const char *F_err[] =
64 {
65 "error in format", /* 100 */
66 "illegal unit number", /* 101 */
67 "formatted io not allowed", /* 102 */
68 "unformatted io not allowed", /* 103 */
69 "direct io not allowed", /* 104 */
70 "sequential io not allowed", /* 105 */
71 "can't backspace file", /* 106 */
72 "null file name", /* 107 */
73 "can't stat file", /* 108 */
74 "unit not connected", /* 109 */
75 "off end of record", /* 110 */
76 "truncation failed in endfile", /* 111 */
77 "incomprehensible list input", /* 112 */
78 "out of free space", /* 113 */
79 "unit not connected", /* 114 */
80 "read unexpected character", /* 115 */
81 "bad logical input field", /* 116 */
82 "bad variable type", /* 117 */
83 "bad namelist name", /* 118 */
84 "variable not in namelist", /* 119 */
85 "no end record", /* 120 */
86 "variable count incorrect", /* 121 */
87 "subscript for scalar variable", /* 122 */
88 "invalid array section", /* 123 */
89 "substring out of bounds", /* 124 */
90 "subscript out of bounds", /* 125 */
91 "can't read file", /* 126 */
92 "can't write file", /* 127 */
93 "'new' file exists", /* 128 */
94 "can't append to file", /* 129 */
95 "non-positive record number", /* 130 */
96 "nmLbuf overflow" /* 131 */
97 };
98 #define MAXERR (sizeof(F_err)/sizeof(char *)+100)
99
100 #if defined(_MSC_VER) || defined(__MINGW32__)
101 #undef isatty
102 #define isatty _isatty
103 #undef fileno
104 #define fileno _fileno
105 #endif
106
f__canseek(FILE * f)107 int f__canseek(FILE *f) /*SYSDEP*/
108 {
109 #ifdef NON_UNIX_STDIO
110 return !isatty(fileno(f));
111 #else
112 struct stat x;
113
114 if (fstat(fileno(f),&x) < 0)
115 return(0);
116 #ifdef S_IFMT
117 switch(x.st_mode & S_IFMT) {
118 case S_IFDIR:
119 case S_IFREG:
120 if(x.st_nlink > 0) /* !pipe */
121 return(1);
122 else
123 return(0);
124 case S_IFCHR:
125 if(isatty(fileno(f)))
126 return(0);
127 return(1);
128 #ifdef S_IFBLK
129 case S_IFBLK:
130 return(1);
131 #endif
132 }
133 #else
134 #ifdef S_ISDIR
135 /* POSIX version */
136 if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
137 if(x.st_nlink > 0) /* !pipe */
138 return(1);
139 else
140 return(0);
141 }
142 if (S_ISCHR(x.st_mode)) {
143 if(isatty(fileno(f)))
144 return(0);
145 return(1);
146 }
147 if (S_ISBLK(x.st_mode))
148 return(1);
149 #else
150 Help! How does fstat work on this system?
151 #endif
152 #endif
153 return(0); /* who knows what it is? */
154 #endif
155 }
156
f__fatal(int n,const char * s)157 void f__fatal(int n, const char *s)
158 {
159 if(n<100 && n>=0) perror(s); /*SYSDEP*/
160 else if(n >= (int)MAXERR || n < -1)
161 { fprintf(stderr,"%s: illegal error number %d\n",s,n);
162 }
163 else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
164 else
165 fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
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__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 sig_die(" IO", 1);
180 }
181
f_init(void)182 void f_init(void)
183 { unit *p;
184
185 f__init=1;
186 p= &f__units[0];
187 p->ufd=stderr;
188 p->useek=f__canseek(stderr);
189 p->ufmt=1;
190 p->uwrt=1;
191 p = &f__units[5];
192 p->ufd=stdin;
193 p->useek=f__canseek(stdin);
194 p->ufmt=1;
195 p->uwrt=0;
196 p= &f__units[6];
197 p->ufd=stdout;
198 p->useek=f__canseek(stdout);
199 p->ufmt=1;
200 p->uwrt=1;
201 }
202
f__nowreading(unit * x)203 int f__nowreading(unit *x)
204 {
205 OFF_T loc;
206 int ufmt, urw;
207
208 if (x->urw & 1)
209 goto done;
210 if (!x->ufnm)
211 goto cantread;
212 ufmt = x->url ? 0 : x->ufmt;
213 loc = FTELL(x->ufd);
214 urw = 3;
215 if (!freopen(x->ufnm, f__w_mode[ufmt|2], x->ufd)) {
216 urw = 1;
217 if(!freopen(x->ufnm, f__r_mode[ufmt], x->ufd)) {
218 cantread:
219 errno = 126;
220 return 1;
221 }
222 }
223 FSEEK(x->ufd,loc,SEEK_SET);
224 x->urw = urw;
225 done:
226 x->uwrt = 0;
227 return 0;
228 }
229
f__nowwriting(unit * x)230 int f__nowwriting(unit *x)
231 {
232 OFF_T loc;
233 int ufmt;
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
err__fl(int f,int m,const char * s)267 int err__fl(int f, int m, const char *s)
268 {
269 if (!f)
270 f__fatal(m, s);
271 if (f__doend)
272 (*f__doend)();
273 return errno = m;
274 }
275