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

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