1 /* Define _XOPEN_SOURCE to get tempnam prototype with glibc et al --
2 more general than _INCLUDE_XOPEN_SOURCE used elsewhere `for HP-UX'. */
3 #define _XOPEN_SOURCE 1
8 #ifndef NON_POSIX_STDIO
12 #include "unistd.h" /* for access */
17 extern char *malloc();
19 extern char *mktemp();
21 extern integer
f_clos();
27 extern int f__canseek(FILE*);
28 extern integer
f_clos(cllist
*);
31 #ifdef NON_ANSI_RW_MODES
32 char *f__r_mode
[2] = {"r", "r"};
33 char *f__w_mode
[4] = {"w", "w", "r+w", "r+w"};
35 char *f__r_mode
[2] = {"rb", "r"};
36 char *f__w_mode
[4] = {"wb", "w", "r+b", "r+"};
39 static char f__buf0
[400], *f__buf
= f__buf0
;
40 int f__buflen
= (int)sizeof(f__buf0
);
44 f__bufadj(n
, c
) int n
, c
;
46 f__bufadj(int n
, int c
)
50 char *nbuf
, *s
, *t
, *te
;
52 if (f__buf
== f__buf0
)
56 len
= (unsigned int)f__buflen
;
57 if (len
!= f__buflen
|| !(nbuf
= (char*)malloc(len
)))
58 f__fatal(113, "malloc failure");
64 if (f__buf
!= f__buf0
)
79 if (f__hiwater
> f__recpos
)
80 f__recpos
= f__hiwater
;
83 f__bufadj(n
, f__recpos
);
93 break; /* normally happens the first time */
106 if (f__recpos
>= f__buflen
)
107 f__bufadj(f__recpos
, f__buflen
);
108 f__buf
[f__recpos
++] = c
;
111 #define opnerr(f,m,s) \
112 do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0)
116 opn_err(m
, s
, a
) int m
; char *s
; olist
*a
;
118 opn_err(int m
, char *s
, olist
*a
)
122 /* supply file name to error message */
123 if (a
->ofnmlen
>= f__buflen
)
124 f__bufadj((int)a
->ofnmlen
, 0);
125 g_char(a
->ofnm
, a
->ofnmlen
, f__curunit
->ufnm
= f__buf
);
131 integer
f_open(a
) olist
*a
;
133 integer
f_open(olist
*a
)
137 char buf
[256], *s
, *env
;
142 #ifndef NON_UNIX_STDIO
145 if(f__init
!= 1) f_init();
147 if(a
->ounit
>=MXUNIT
|| a
->ounit
<0)
148 err(a
->oerr
,101,"open");
149 f__curunit
= b
= &f__units
[a
->ounit
];
154 b
->ublnk
= *a
->oblnk
== 'z' || *a
->oblnk
== 'Z';
157 #ifdef NON_UNIX_STDIO
159 && strlen(b
->ufnm
) == a
->ofnmlen
160 && !strncmp(b
->ufnm
, a
->ofnm
, (unsigned)a
->ofnmlen
))
163 g_char(a
->ofnm
,a
->ofnmlen
,buf
);
164 if (f__inode(buf
,&n
) == b
->uinode
&& n
== b
->udev
)
170 if ((rv
= f_clos(&x
)) != 0)
173 b
->url
= (int)a
->orl
;
174 b
->ublnk
= a
->oblnk
&& (*a
->oblnk
== 'z' || *a
->oblnk
== 'Z');
176 { if(b
->url
>0) b
->ufmt
=0;
179 else if(*a
->ofm
=='f' || *a
->ofm
== 'F') b
->ufmt
=1;
187 g_char(a
->ofnm
,a
->ofnmlen
,buf
);
189 opnerr(a
->oerr
,107,"open");
192 sprintf(buf
, "fort.%ld", (long)a
->ounit
);
198 switch(a
->osta
? *a
->osta
: 'u')
202 #ifdef NON_POSIX_STDIO
203 if (!(tf
= fopen(buf
,"r")))
204 opnerr(a
->oerr
,errno
,"open");
208 opnerr(a
->oerr
,errno
,"open");
214 #ifdef HAVE_MKSTEMP /* Allow use of TMPDIR preferentially. */
215 env
= getenv("TMPDIR");
216 if (!env
) env
= getenv("TEMP");
217 if (!env
) env
= "/tmp";
219 if (len
> 256 - sizeof "/tmp.FXXXXXX")
220 err (a
->oerr
, 132, "open");
222 strcat(buf
, "/tmp.FXXXXXX");
224 if (fd
== -1 || close(fd
))
225 err (a
->oerr
, 132, "open");
226 #else /* ! defined (HAVE_MKSTEMP) */
227 #ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */
228 s
= tempnam (0, buf
);
229 if (strlen (s
) >= sizeof (buf
))
230 err (a
->oerr
, 132, "open");
231 (void) strcpy (buf
, s
);
233 #else /* ! defined (HAVE_TEMPNAM) */
237 (void) strcpy(buf
,"tmp.FXXXXXX");
240 #endif /* ! defined (HAVE_TEMPNAM) */
241 #endif /* ! defined (HAVE_MKSTEMP) */
245 #ifdef NON_POSIX_STDIO
246 if ((tf
= fopen(buf
,"r")) || (tf
= fopen(buf
,"a"))) {
248 opnerr(a
->oerr
,128,"open");
252 opnerr(a
->oerr
,128,"open");
255 case 'r': /* Fortran 90 replace option */
258 if (tf
= fopen(buf
,f__w_mode
[0]))
262 b
->ufnm
=(char *) malloc((unsigned int)(strlen(buf
)+1));
263 if(b
->ufnm
==NULL
) opnerr(a
->oerr
,113,"no space");
264 (void) strcpy(b
->ufnm
,buf
);
265 if ((s
= a
->oacc
) && b
->url
)
267 if(!(tf
= fopen(buf
, f__w_mode
[ufmt
|2]))) {
268 if (tf
= fopen(buf
, f__r_mode
[ufmt
]))
270 else if (tf
= fopen(buf
, f__w_mode
[ufmt
])) {
275 err(a
->oerr
, errno
, "open");
277 b
->useek
= f__canseek(b
->ufd
= tf
);
278 #ifndef NON_UNIX_STDIO
279 if((b
->uinode
= f__inode(buf
,&b
->udev
)) == -1)
280 opnerr(a
->oerr
,108,"open");
284 FSEEK(b
->ufd
, 0, SEEK_SET
);
285 else if ((s
= a
->oacc
) && (*s
== 'a' || *s
== 'A')
286 && FSEEK(b
->ufd
, 0, SEEK_END
))
287 opnerr(a
->oerr
,129,"open");
291 fk_open(seq
,fmt
,n
) ftnint n
;
293 fk_open(int seq
, int fmt
, ftnint n
)
300 (void) sprintf(nbuf
,"fort.%ld",(long)n
);
304 a
.ofnmlen
=strlen(nbuf
);
306 a
.oacc
= seq
==SEQ
?"s":"d";
307 a
.ofm
= fmt
==FMT
?"f":"u";
308 a
.orl
= seq
==DIR?1:0;
313 f__init
= save_init
| 1;