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;