|
|
1.1 root 1: #include "sys/types.h"
2: #include "sys/stat.h"
3: #include "f2c.h"
4: #include "fio.h"
5: #include "string.h"
6: #include "rawio.h"
7:
8: #ifdef KR_headers
9: extern char *malloc(), *mktemp();
10: extern integer f_clos();
11: #else
12: #undef abs
13: #undef min
14: #undef max
15: #include "stdlib.h"
16: extern int f__canseek(FILE*);
17: extern integer f_clos(cllist*);
18: #endif
19:
20: #ifdef NON_ANSI_RW_MODES
21: char *f__r_mode[2] = {"r", "r"};
22: char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
23: #else
24: char *f__r_mode[2] = {"rb", "r"};
25: char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
26: #endif
27:
28: #ifdef KR_headers
29: f__isdev(s) char *s;
30: #else
31: f__isdev(char *s)
32: #endif
33: {
34: #ifdef NON_UNIX_STDIO
35: int i, j;
36:
37: i = open(s,O_RDONLY);
38: if (i == -1)
39: return 0;
40: j = isatty(i);
41: close(i);
42: return j;
43: #else
44: struct stat x;
45:
46: if(stat(s, &x) == -1) return(0);
47: #ifdef S_IFMT
48: switch(x.st_mode&S_IFMT) {
49: case S_IFREG:
50: case S_IFDIR:
51: return(0);
52: }
53: #else
54: #ifdef S_ISREG
55: /* POSIX version */
56: if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
57: return(0);
58: else
59: #else
60: Help! How does stat work on this system?
61: #endif
62: #endif
63: return(1);
64: #endif
65: }
66: #ifdef KR_headers
67: integer f_open(a) olist *a;
68: #else
69: integer f_open(olist *a)
70: #endif
71: { unit *b;
72: int n;
73: integer rv;
74: char buf[256], *s;
75: cllist x;
76: #ifdef NON_UNIX_STDIO
77: FILE *tf;
78: #else
79: struct stat stb;
80: #endif
81: if(a->ounit>=MXUNIT || a->ounit<0)
82: err(a->oerr,101,"open")
83: f__curunit = b = &f__units[a->ounit];
84: if(b->ufd) {
85: if(a->ofnm==0)
86: {
87: same: if (a->oblnk)
88: b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
89: return(0);
90: }
91: #ifdef NON_UNIX_STDIO
92: if (b->ufnm
93: && strlen(b->ufnm) == a->ofnmlen
94: && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen))
95: goto same;
96: #else
97: g_char(a->ofnm,a->ofnmlen,buf);
98: if (f__inode(buf,&n) == b->uinode && n == b->udev)
99: goto same;
100: #endif
101: x.cunit=a->ounit;
102: x.csta=0;
103: x.cerr=a->oerr;
104: if ((rv = f_clos(&x)) != 0)
105: return rv;
106: }
107: b->url = (int)a->orl;
108: b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
109: if(a->ofm==0)
110: { if(b->url>0) b->ufmt=0;
111: else b->ufmt=1;
112: }
113: else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
114: else b->ufmt=0;
115: #ifdef url_Adjust
116: if (b->url && !b->ufmt)
117: url_Adjust(b->url);
118: #endif
119: if (a->ofnm) {
120: g_char(a->ofnm,a->ofnmlen,buf);
121: if (!buf[0])
122: err(a->oerr,107,"open")
123: }
124: else
125: sprintf(buf, "fort.%ld", a->ounit);
126: b->uscrtch = 0;
127: switch(a->osta ? *a->osta : 'u')
128: {
129: case 'o':
130: case 'O':
131: #ifdef NON_UNIX_STDIO
132: if(access(buf,0))
133: #else
134: if(stat(buf,&stb))
135: #endif
136: err(a->oerr,errno,"open")
137: break;
138: case 's':
139: case 'S':
140: b->uscrtch=1;
141: #ifdef _POSIX_SOURCE
142: tmpnam(buf);
143: #else
144: (void) strcpy(buf,"tmp.FXXXXXX");
145: (void) mktemp(buf);
146: #endif
147: goto replace;
148: case 'n':
149: case 'N':
150: #ifdef NON_UNIX_STDIO
151: if(!access(buf,0))
152: #else
153: if(!stat(buf,&stb))
154: #endif
155: err(a->oerr,128,"open")
156: /* no break */
157: case 'r': /* Fortran 90 replace option */
158: case 'R':
159: replace:
160: #ifdef NON_UNIX_STDIO
161: if (tf = fopen(buf,f__w_mode[0]))
162: fclose(tf);
163: #else
164: (void) close(creat(buf, 0666));
165: #endif
166: }
167:
168: b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
169: if(b->ufnm==NULL) err(a->oerr,113,"no space");
170: (void) strcpy(b->ufnm,buf);
171: b->uend=0;
172: b->uwrt = 0;
173: if(f__isdev(buf))
174: { b->ufd = fopen(buf,f__r_mode[b->ufmt]);
175: if(b->ufd==NULL) err(a->oerr,errno,buf)
176: }
177: else {
178: if(!(b->ufd = fopen(buf, f__r_mode[b->ufmt]))) {
179: #ifdef NON_UNIX_STDIO
180: if (b->ufd = fopen(buf, f__w_mode[b->ufmt+2]))
181: b->uwrt = 2;
182: else if (b->ufd = fopen(buf, f__w_mode[b->ufmt]))
183: b->uwrt = 1;
184: else
185: #else
186: if ((n = open(buf,O_WRONLY)) >= 0)
187: b->uwrt = 2;
188: else {
189: n = creat(buf, 0666);
190: b->uwrt = 1;
191: }
192: if (n < 0
193: || (b->ufd = fdopen(n, f__w_mode[b->ufmt])) == NULL)
194: #endif
195: err(a->oerr, errno, "open");
196: }
197: }
198: b->useek=f__canseek(b->ufd);
199: #ifndef NON_UNIX_STDIO
200: if((b->uinode=f__inode(buf,&b->udev))==-1)
201: err(a->oerr,108,"open")
202: #endif
203: if(b->useek)
204: if (a->orl)
205: rewind(b->ufd);
206: else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
207: && fseek(b->ufd, 0L, SEEK_END))
208: err(a->oerr,129,"open");
209: return(0);
210: }
211: #ifdef KR_headers
212: fk_open(seq,fmt,n) ftnint n;
213: #else
214: fk_open(int seq, int fmt, ftnint n)
215: #endif
216: { char nbuf[10];
217: olist a;
218: (void) sprintf(nbuf,"fort.%ld",n);
219: a.oerr=1;
220: a.ounit=n;
221: a.ofnm=nbuf;
222: a.ofnmlen=strlen(nbuf);
223: a.osta=NULL;
224: a.oacc= seq==SEQ?"s":"d";
225: a.ofm = fmt==FMT?"f":"u";
226: a.orl = seq==DIR?1:0;
227: a.oblnk=NULL;
228: return(f_open(&a));
229: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.