source: trunk/third/gcc/libf2c/libI77/open.c @ 18474

Revision 18474, 6.3 KB checked in by ghudson, 21 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r18473, which included commits to RCS files with non-trunk default branches.
Line 
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
4#include "config.h"
5#include "f2c.h"
6#include "fio.h"
7#include <string.h>
8#ifndef NON_POSIX_STDIO
9#ifdef MSDOS
10#include "io.h"
11#else
12#include "unistd.h"     /* for access */
13#endif
14#endif
15
16#ifdef KR_headers
17extern char *malloc();
18#ifdef NON_ANSI_STDIO
19extern char *mktemp();
20#endif
21extern integer f_clos();
22#else
23#undef abs
24#undef min
25#undef max
26#include <stdlib.h>
27extern int f__canseek(FILE*);
28extern integer f_clos(cllist*);
29#endif
30
31#ifdef NON_ANSI_RW_MODES
32char *f__r_mode[2] = {"r", "r"};
33char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
34#else
35char *f__r_mode[2] = {"rb", "r"};
36char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
37#endif
38
39 static char f__buf0[400], *f__buf = f__buf0;
40 int f__buflen = (int)sizeof(f__buf0);
41
42 static void
43#ifdef KR_headers
44f__bufadj(n, c) int n, c;
45#else
46f__bufadj(int n, int c)
47#endif
48{
49        unsigned int len;
50        char *nbuf, *s, *t, *te;
51
52        if (f__buf == f__buf0)
53                f__buflen = 1024;
54        while(f__buflen <= n)
55                f__buflen <<= 1;
56        len = (unsigned int)f__buflen;
57        if (len != f__buflen || !(nbuf = (char*)malloc(len)))
58                f__fatal(113, "malloc failure");
59        s = nbuf;
60        t = f__buf;
61        te = t + c;
62        while(t < te)
63                *s++ = *t++;
64        if (f__buf != f__buf0)
65                free(f__buf);
66        f__buf = nbuf;
67        }
68
69 int
70#ifdef KR_headers
71f__putbuf(c) int c;
72#else
73f__putbuf(int c)
74#endif
75{
76        char *s, *se;
77        int n;
78
79        if (f__hiwater > f__recpos)
80                f__recpos = f__hiwater;
81        n = f__recpos + 1;
82        if (n >= f__buflen)
83                f__bufadj(n, f__recpos);
84        s = f__buf;
85        se = s + f__recpos;
86        if (c)
87                *se++ = c;
88        *se = 0;
89        for(;;) {
90                fputs(s, f__cf);
91                s += strlen(s);
92                if (s >= se)
93                        break;  /* normally happens the first time */
94                putc(*s++, f__cf);
95                }
96        return 0;
97        }
98
99 void
100#ifdef KR_headers
101x_putc(c)
102#else
103x_putc(int c)
104#endif
105{
106        if (f__recpos >= f__buflen)
107                f__bufadj(f__recpos, f__buflen);
108        f__buf[f__recpos++] = c;
109        }
110
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)
113
114 static void
115#ifdef KR_headers
116opn_err(m, s, a) int m; char *s; olist *a;
117#else
118opn_err(int m, char *s, olist *a)
119#endif
120{
121        if (a->ofnm) {
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);
126                }
127        f__fatal(m, s);
128        }
129
130#ifdef KR_headers
131integer f_open(a) olist *a;
132#else
133integer f_open(olist *a)
134#endif
135{       unit *b;
136        integer rv;
137        char buf[256], *s, *env;
138        cllist x;
139        int ufmt;
140        FILE *tf;
141        int fd, len;
142#ifndef NON_UNIX_STDIO
143        int n;
144#endif
145        if(f__init != 1) f_init();
146        f__external = 1;
147        if(a->ounit>=MXUNIT || a->ounit<0)
148                err(a->oerr,101,"open");
149        f__curunit = b = &f__units[a->ounit];
150        if(b->ufd) {
151                if(a->ofnm==0)
152                {
153                same:   if (a->oblnk)
154                                b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
155                        return(0);
156                }
157#ifdef NON_UNIX_STDIO
158                if (b->ufnm
159                 && strlen(b->ufnm) == a->ofnmlen
160                 && !strncmp(b->ufnm, a->ofnm, (unsigned)a->ofnmlen))
161                        goto same;
162#else
163                g_char(a->ofnm,a->ofnmlen,buf);
164                if (f__inode(buf,&n) == b->uinode && n == b->udev)
165                        goto same;
166#endif
167                x.cunit=a->ounit;
168                x.csta=0;
169                x.cerr=a->oerr;
170                if ((rv = f_clos(&x)) != 0)
171                        return rv;
172                }
173        b->url = (int)a->orl;
174        b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
175        if(a->ofm==0)
176        {       if(b->url>0) b->ufmt=0;
177                else b->ufmt=1;
178        }
179        else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
180        else b->ufmt=0;
181        ufmt = b->ufmt;
182#ifdef url_Adjust
183        if (b->url && !ufmt)
184                url_Adjust(b->url);
185#endif
186        if (a->ofnm) {
187                g_char(a->ofnm,a->ofnmlen,buf);
188                if (!buf[0])
189                        opnerr(a->oerr,107,"open");
190                }
191        else
192                sprintf(buf, "fort.%ld", (long)a->ounit);
193        b->uscrtch = 0;
194        b->uend=0;
195        b->uwrt = 0;
196        b->ufd = 0;
197        b->urw = 3;
198        switch(a->osta ? *a->osta : 'u')
199        {
200        case 'o':
201        case 'O':
202#ifdef NON_POSIX_STDIO
203                if (!(tf = fopen(buf,"r")))
204                        opnerr(a->oerr,errno,"open");
205                fclose(tf);
206#else
207                if (access(buf,0))
208                        opnerr(a->oerr,errno,"open");
209#endif
210                break;
211         case 's':
212         case 'S':
213                b->uscrtch=1;
214#ifdef HAVE_MKSTEMP             /* Allow use of TMPDIR preferentially. */
215                env = getenv("TMPDIR");
216                if (!env) env = getenv("TEMP");
217                if (!env) env = "/tmp";
218                len = strlen(env);
219                if (len > 256 - sizeof "/tmp.FXXXXXX")
220                  err (a->oerr, 132, "open");
221                strcpy(buf, env);
222                strcat(buf, "/tmp.FXXXXXX");
223                fd = mkstemp(buf);
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);
232                free (s);
233#else /* ! defined (HAVE_TEMPNAM) */
234#ifdef HAVE_TMPNAM
235                tmpnam(buf);
236#else
237                (void) strcpy(buf,"tmp.FXXXXXX");
238                (void) mktemp(buf);
239#endif
240#endif /* ! defined (HAVE_TEMPNAM) */
241#endif /* ! defined (HAVE_MKSTEMP) */
242                goto replace;
243        case 'n':
244        case 'N':
245#ifdef NON_POSIX_STDIO
246                if ((tf = fopen(buf,"r")) || (tf = fopen(buf,"a"))) {
247                        fclose(tf);
248                        opnerr(a->oerr,128,"open");
249                        }
250#else
251                if (!access(buf,0))
252                        opnerr(a->oerr,128,"open");
253#endif
254                /* no break */
255        case 'r':       /* Fortran 90 replace option */
256        case 'R':
257 replace:
258                if (tf = fopen(buf,f__w_mode[0]))
259                        fclose(tf);
260        }
261
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)
266                ufmt = 0;
267        if(!(tf = fopen(buf, f__w_mode[ufmt|2]))) {
268                if (tf = fopen(buf, f__r_mode[ufmt]))
269                        b->urw = 1;
270                else if (tf = fopen(buf, f__w_mode[ufmt])) {
271                        b->uwrt = 1;
272                        b->urw = 2;
273                        }
274                else
275                        err(a->oerr, errno, "open");
276                }
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");
281#endif
282        if(b->useek)
283                if (a->orl)
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");
288        return(0);
289}
290#ifdef KR_headers
291fk_open(seq,fmt,n) ftnint n;
292#else
293fk_open(int seq, int fmt, ftnint n)
294#endif
295{       char nbuf[10];
296        olist a;
297        int rtn;
298        int save_init;
299
300        (void) sprintf(nbuf,"fort.%ld",(long)n);
301        a.oerr=1;
302        a.ounit=n;
303        a.ofnm=nbuf;
304        a.ofnmlen=strlen(nbuf);
305        a.osta=NULL;
306        a.oacc= seq==SEQ?"s":"d";
307        a.ofm = fmt==FMT?"f":"u";
308        a.orl = seq==DIR?1:0;
309        a.oblnk=NULL;
310        save_init = f__init;
311        f__init &= ~2;
312        rtn = f_open(&a);
313        f__init = save_init | 1;
314        return rtn;
315}
Note: See TracBrowser for help on using the repository browser.