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
7 #ifndef NON_POSIX_STDIO
11 #include "unistd.h" /* for access */
16 extern char *malloc();
18 extern char *mktemp();
20 extern integer
f_clos();
26 extern int f__canseek(FILE*);
27 extern integer
f_clos(cllist
*);
30 #ifdef NON_ANSI_RW_MODES
31 char *f__r_mode
[2] = {"r", "r"};
32 char *f__w_mode
[4] = {"w", "w", "r+w", "r+w"};
34 char *f__r_mode
[2] = {"rb", "r"};
35 char *f__w_mode
[4] = {"wb", "w", "r+b", "r+"};
38 static char f__buf0
[400], *f__buf
= f__buf0
;
39 int f__buflen
= (int)sizeof(f__buf0
);
43 f__bufadj(n
, c
) int n
, c
;
45 f__bufadj(int n
, int c
)
49 char *nbuf
, *s
, *t
, *te
;
51 if (f__buf
== f__buf0
)
55 len
= (unsigned int)f__buflen
;
56 if (len
!= f__buflen
|| !(nbuf
= (char*)malloc(len
)))
57 f__fatal(113, "malloc failure");
63 if (f__buf
!= f__buf0
)
78 if (f__hiwater
> f__recpos
)
79 f__recpos
= f__hiwater
;
82 f__bufadj(n
, f__recpos
);
92 break; /* normally happens the first time */
105 if (f__recpos
>= f__buflen
)
106 f__bufadj(f__recpos
, f__buflen
);
107 f__buf
[f__recpos
++] = c
;
110 #define opnerr(f,m,s) \
111 do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0)
115 opn_err(m
, s
, a
) int m
; char *s
; olist
*a
;
117 opn_err(int m
, char *s
, olist
*a
)
121 /* supply file name to error message */
122 if (a
->ofnmlen
>= f__buflen
)
123 f__bufadj((int)a
->ofnmlen
, 0);
124 g_char(a
->ofnm
, a
->ofnmlen
, f__curunit
->ufnm
= f__buf
);
130 integer
f_open(a
) olist
*a
;
132 integer
f_open(olist
*a
)
140 #ifndef NON_UNIX_STDIO
143 if(f__init
!= 1) f_init();
145 if(a
->ounit
>=MXUNIT
|| a
->ounit
<0)
146 err(a
->oerr
,101,"open");
147 f__curunit
= b
= &f__units
[a
->ounit
];
152 b
->ublnk
= *a
->oblnk
== 'z' || *a
->oblnk
== 'Z';
155 #ifdef NON_UNIX_STDIO
157 && strlen(b
->ufnm
) == a
->ofnmlen
158 && !strncmp(b
->ufnm
, a
->ofnm
, (unsigned)a
->ofnmlen
))
161 g_char(a
->ofnm
,a
->ofnmlen
,buf
);
162 if (f__inode(buf
,&n
) == b
->uinode
&& n
== b
->udev
)
168 if ((rv
= f_clos(&x
)) != 0)
171 b
->url
= (int)a
->orl
;
172 b
->ublnk
= a
->oblnk
&& (*a
->oblnk
== 'z' || *a
->oblnk
== 'Z');
174 { if(b
->url
>0) b
->ufmt
=0;
177 else if(*a
->ofm
=='f' || *a
->ofm
== 'F') b
->ufmt
=1;
185 g_char(a
->ofnm
,a
->ofnmlen
,buf
);
187 opnerr(a
->oerr
,107,"open");
190 sprintf(buf
, "fort.%ld", (long)a
->ounit
);
196 switch(a
->osta
? *a
->osta
: 'u')
200 #ifdef NON_POSIX_STDIO
201 if (!(tf
= fopen(buf
,"r")))
202 opnerr(a
->oerr
,errno
,"open");
206 opnerr(a
->oerr
,errno
,"open");
212 #ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */
213 s
= tempnam (0, buf
);
214 if (strlen (s
) >= sizeof (buf
))
215 err (a
->oerr
, 132, "open");
216 (void) strcpy (buf
, s
);
218 #else /* ! defined (HAVE_TEMPNAM) */
222 (void) strcpy(buf
,"tmp.FXXXXXX");
225 #endif /* ! defined (HAVE_TEMPNAM) */
229 #ifdef NON_POSIX_STDIO
230 if ((tf
= fopen(buf
,"r")) || (tf
= fopen(buf
,"a"))) {
232 opnerr(a
->oerr
,128,"open");
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));
247 if(b
->ufnm
==NULL
) opnerr(a
->oerr
,113,"no space");
248 (void) strcpy(b
->ufnm
,buf
);
249 if ((s
= a
->oacc
) && b
->url
)
251 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
])) {
259 err(a
->oerr
, errno
, "open");
261 b
->useek
= f__canseek(b
->ufd
= tf
);
262 #ifndef NON_UNIX_STDIO
263 if((b
->uinode
= f__inode(buf
,&b
->udev
)) == -1)
264 opnerr(a
->oerr
,108,"open");
269 else if ((s
= a
->oacc
) && (*s
== 'a' || *s
== 'A')
270 && fseek(b
->ufd
, 0L, SEEK_END
))
271 opnerr(a
->oerr
,129,"open");
275 fk_open(seq
,fmt
,n
) ftnint n
;
277 fk_open(int seq
, int fmt
, ftnint n
)
284 (void) sprintf(nbuf
,"fort.%ld",(long)n
);
288 a
.ofnmlen
=strlen(nbuf
);
290 a
.oacc
= seq
==SEQ
?"s":"d";
291 a
.ofm
= fmt
==FMT
?"f":"u";
292 a
.orl
= seq
==DIR?1:0;
297 f__init
= save_init
| 1;