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');
157 else if (*a
->ofm
== 'f' || *a
->ofm
== 'F')
168 g_char (a
->ofnm
, a
->ofnmlen
, buf
);
170 opnerr (a
->oerr
, 107, "open");
173 sprintf (buf
, "fort.%ld", (long) a
->ounit
);
179 switch (a
->osta
? *a
->osta
: 'u')
183 #ifdef NON_POSIX_STDIO
184 if (!(tf
= fopen (buf
, "r")))
185 opnerr (a
->oerr
, errno
, "open");
189 opnerr (a
->oerr
, errno
, "open");
195 #ifdef HAVE_MKSTEMP /* Allow use of TMPDIR preferentially. */
196 env
= getenv ("TMPDIR");
198 env
= getenv ("TEMP");
202 if (len
> 256 - (int) sizeof ("/tmp.FXXXXXX"))
203 err (a
->oerr
, 132, "open");
205 strcat (buf
, "/tmp.FXXXXXX");
207 if (fd
== -1 || close (fd
))
208 err (a
->oerr
, 132, "open");
209 #else /* ! defined (HAVE_MKSTEMP) */
210 #ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */
211 s
= tempnam (0, buf
);
212 if (strlen (s
) >= sizeof (buf
))
213 err (a
->oerr
, 132, "open");
214 (void) strcpy (buf
, s
);
216 #else /* ! defined (HAVE_TEMPNAM) */
220 (void) strcpy (buf
, "tmp.FXXXXXX");
223 #endif /* ! defined (HAVE_TEMPNAM) */
224 #endif /* ! defined (HAVE_MKSTEMP) */
228 #ifdef NON_POSIX_STDIO
229 if ((tf
= fopen (buf
, "r")) || (tf
= fopen (buf
, "a")))
232 opnerr (a
->oerr
, 128, "open");
235 if (!access (buf
, 0))
236 opnerr (a
->oerr
, 128, "open");
239 case 'r': /* Fortran 90 replace option */
242 if ((tf
= fopen (buf
, f__w_mode
[0])))
246 b
->ufnm
= (char *) malloc ((unsigned int) (strlen (buf
) + 1));
248 opnerr (a
->oerr
, 113, "no space");
249 (void) strcpy (b
->ufnm
, buf
);
250 if ((s
= a
->oacc
) && b
->url
)
252 if (!(tf
= fopen (buf
, f__w_mode
[ufmt
| 2])))
254 if ((tf
= fopen (buf
, f__r_mode
[ufmt
])))
256 else if ((tf
= fopen (buf
, f__w_mode
[ufmt
])))
262 err (a
->oerr
, errno
, "open");
264 b
->useek
= f__canseek (b
->ufd
= tf
);
265 #ifndef NON_UNIX_STDIO
266 if ((b
->uinode
= f__inode (buf
, &b
->udev
)) == -1)
267 opnerr (a
->oerr
, 108, "open");
272 FSEEK (b
->ufd
, 0, SEEK_SET
);
273 else if ((s
= a
->oacc
) && (*s
== 'a' || *s
== 'A')
274 && FSEEK (b
->ufd
, 0, SEEK_END
))
275 opnerr (a
->oerr
, 129, "open");
281 fk_open (int seq
, int fmt
, ftnint n
)
288 (void) sprintf (nbuf
, "fort.%ld", (long) n
);
292 a
.ofnmlen
= strlen (nbuf
);
294 a
.oacc
= seq
== SEQ
? "s" : "d";
295 a
.ofm
= fmt
== FMT
? "f" : "u";
296 a
.orl
= seq
== DIR ? 1 : 0;
301 f__init
= save_init
| 1;