5 #ifndef NON_POSIX_STDIO
9 #include "unistd.h" /* for access */
17 extern int f__canseek (FILE *);
18 extern integer f_clos (cllist *);
20 #ifdef NON_ANSI_RW_MODES
21 char *f__r_mode[2] = { "r", "r" };
22 char *f__w_mode[4] = { "w", "w", "r+w", "r+w" };
24 char *f__r_mode[2] = { "rb", "r" };
25 char *f__w_mode[4] = { "wb", "w", "r+b", "r+" };
28 static char f__buf0[400], *f__buf = f__buf0;
29 int f__buflen = (int) sizeof (f__buf0);
32 f__bufadj (int n, int c)
35 char *nbuf, *s, *t, *te;
37 if (f__buf == f__buf0)
39 while (f__buflen <= n)
41 len = (unsigned int) f__buflen;
42 if (len != f__buflen || !(nbuf = (char *) malloc (len)))
43 f__fatal (113, "malloc failure");
49 if (f__buf != f__buf0)
60 if (f__hiwater > f__recpos)
61 f__recpos = f__hiwater;
64 f__bufadj (n, f__recpos);
75 break; /* normally happens the first time */
84 if (f__recpos >= f__buflen)
85 f__bufadj (f__recpos, f__buflen);
86 f__buf[f__recpos++] = c;
89 #define opnerr(f,m,s) \
90 do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0)
93 opn_err (int m, char *s, olist * a)
97 /* supply file name to error message */
98 if (a->ofnmlen >= f__buflen)
99 f__bufadj ((int) a->ofnmlen, 0);
100 g_char (a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf);
110 char buf[256], *s, *env;
115 #ifndef NON_UNIX_STDIO
121 if (a->ounit >= MXUNIT || a->ounit < 0)
122 err (a->oerr, 101, "open");
123 f__curunit = b = &f__units[a->ounit];
129 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
132 #ifdef NON_UNIX_STDIO
134 && strlen (b->ufnm) == a->ofnmlen
135 && !strncmp (b->ufnm, a->ofnm, (unsigned) a->ofnmlen))
138 g_char (a->ofnm, a->ofnmlen, buf);
139 if (f__inode (buf, &n) == b->uinode && n == b->udev)
145 if ((rv = f_clos (&x)) != 0)
148 b->url = (int) a->orl;
149 b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
151 if ((a->oacc) && (*a->oacc == 'D' || *a->oacc == 'd'))
155 else if (*a->ofm == 'f' || *a->ofm == 'F')
166 g_char (a->ofnm, a->ofnmlen, buf);
168 opnerr (a->oerr, 107, "open");
171 sprintf (buf, "fort.%ld", (long) a->ounit);
177 switch (a->osta ? *a->osta : 'u')
181 #ifdef NON_POSIX_STDIO
182 if (!(tf = fopen (buf, "r")))
183 opnerr (a->oerr, errno, "open");
187 opnerr (a->oerr, errno, "open");
193 #ifdef HAVE_MKSTEMP /* Allow use of TMPDIR preferentially. */
194 env = getenv ("TMPDIR");
196 env = getenv ("TEMP");
200 if (len > 256 - (int) sizeof ("/tmp.FXXXXXX"))
201 err (a->oerr, 132, "open");
203 strcat (buf, "/tmp.FXXXXXX");
205 if (fd == -1 || close (fd))
206 err (a->oerr, 132, "open");
207 #else /* ! defined (HAVE_MKSTEMP) */
208 #ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */
209 s = tempnam (0, buf);
210 if (strlen (s) >= sizeof (buf))
211 err (a->oerr, 132, "open");
212 (void) strcpy (buf, s);
214 #else /* ! defined (HAVE_TEMPNAM) */
218 (void) strcpy (buf, "tmp.FXXXXXX");
221 #endif /* ! defined (HAVE_TEMPNAM) */
222 #endif /* ! defined (HAVE_MKSTEMP) */
226 #ifdef NON_POSIX_STDIO
227 if ((tf = fopen (buf, "r")) || (tf = fopen (buf, "a")))
230 opnerr (a->oerr, 128, "open");
233 if (!access (buf, 0))
234 opnerr (a->oerr, 128, "open");
237 case 'r': /* Fortran 90 replace option */
240 if ((tf = fopen (buf, f__w_mode[0])))
244 b->ufnm = (char *) malloc ((unsigned int) (strlen (buf) + 1));
246 opnerr (a->oerr, 113, "no space");
247 (void) strcpy (b->ufnm, buf);
248 if ((s = a->oacc) && b->url)
250 if (!(tf = fopen (buf, f__w_mode[ufmt | 2])))
252 if ((tf = fopen (buf, f__r_mode[ufmt])))
254 else if ((tf = fopen (buf, f__w_mode[ufmt])))
260 err (a->oerr, errno, "open");
262 b->useek = f__canseek (b->ufd = tf);
263 #ifndef NON_UNIX_STDIO
264 if ((b->uinode = f__inode (buf, &b->udev)) == -1)
265 opnerr (a->oerr, 108, "open");
270 FSEEK (b->ufd, 0, SEEK_SET);
271 else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
272 && FSEEK (b->ufd, 0, SEEK_END))
273 opnerr (a->oerr, 129, "open");
279 fk_open (int seq, int fmt, ftnint n)
286 (void) sprintf (nbuf, "fort.%ld", (long) n);
290 a.ofnmlen = strlen (nbuf);
292 a.oacc = seq == SEQ ? "s" : "d";
293 a.ofm = fmt == FMT ? "f" : "u";
294 a.orl = seq == DIR ? 1 : 0;
299 f__init = save_init | 1;