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