![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to open.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.lib / libI77|
Return to open.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.lib / libI77 |
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: *
6: * @(#)open.c 5.2 1/8/86
7: */
8:
9: /*
10: * open.c - f77 file open and I/O library initialization routines
11: */
12:
13: #include <sys/types.h>
14: #include <sys/stat.h>
15: #include <errno.h>
16: #include "fio.h"
17:
18: #define SCRATCH (st=='s')
19: #define NEW (st=='n')
20: #define OLD (st=='o')
21: #define OPEN (b->ufd)
22: #define FROM_OPEN "\2" /* for use in f_clos() */
23: #define BUF_LEN 256
24:
25: LOCAL char *tmplate = "tmp.FXXXXXX"; /* scratch file template */
26: LOCAL char *fortfile = "fort.%d"; /* default file template */
27:
28: char *getenv();
29:
30: f_open(a) olist *a;
31: { unit *b;
32: int n,exists;
33: char buf[BUF_LEN], env_name[BUF_LEN];
34: char *env_val, *p1, *p2, ch, st;
35: cllist x;
36:
37: lfname = NULL;
38: elist = NO;
39: external = YES; /* for err */
40: errflag = a->oerr;
41: lunit = a->ounit;
42: if(not_legal(lunit)) err(errflag,F_ERUNIT,"open")
43: b= &units[lunit];
44: if(a->osta) st = lcase(*a->osta);
45: else st = 'u';
46: if(SCRATCH)
47: { strcpy(buf,tmplate);
48: /* make a new temp file name, err if mktemp fails */
49: if( strcmp( mktemp(buf), "/" ) == 0 )
50: err(errflag, F_ERSYS, "open")
51: }
52: else
53: {
54: if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf);
55: else sprintf(buf,fortfile,lunit);
56: /* check if overriding file name via environment variable
57: * first copy tail of name - delete periods as Bourne Shell
58: * croaks if any periods in name
59: */
60: p1 = buf;
61: p2 = env_name;
62: while ((ch = *p1++) != '\0') {
63: if(ch == '/') p2 = env_name;
64: else if(ch != '.') *p2++ = ch;
65: }
66: if(p2 != env_name) {
67: *p2 = '\0';
68: if( (env_val = getenv( env_name )) != NULL ) {
69: if(strlen(env_val) >= BUF_LEN-1 )
70: err(errflag,F_ERSTAT,"open: file name too long");
71: strcpy(buf, env_val);
72: }
73: }
74: }
75: lfname = &buf[0];
76: if(OPEN)
77: {
78: if(!a->ofnm || inode(buf)==b->uinode)
79: {
80: if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z');
81: #ifndef KOSHER
82: if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p');
83: #endif
84: return(OK);
85: }
86: x.cunit=lunit;
87: x.csta=FROM_OPEN;
88: x.cerr=errflag;
89: if(n=f_clos(&x)) return(n);
90: }
91: exists = (access(buf,0)==NULL);
92: if(!exists && OLD) err(errflag,F_EROLDF,"open");
93: if( exists && NEW) err(errflag,F_ERNEWF,"open");
94: errno = F_ERSYS;
95: if(isdev(buf))
96: { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO;
97: else err(errflag,errno,buf)
98: }
99: else
100: {
101: errno = F_ERSYS;
102: if((b->ufd = fopen(buf, "a")) != NULL)
103: { if(!opneof)
104: { if(freopen(buf, "r", b->ufd) != NULL)
105: b->uwrt = NO;
106: else
107: err(errflag, errno, buf)
108: }
109: else
110: b->uwrt = YES;
111: }
112: else if((b->ufd = fopen(buf, "r")) != NULL)
113: { if (opneof)
114: fseek(b->ufd, 0L, 2);
115: b->uwrt = NO;
116: }
117: else err(errflag, errno, buf)
118: }
119: if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
120: b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
121: if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
122: strcpy(b->ufnm,buf);
123: b->uscrtch = SCRATCH;
124: b->uend = NO;
125: b->useek = canseek(b->ufd);
126: if (a->oacc == NULL)
127: a->oacc = "seq";
128: if (lcase(*a->oacc)=='s' && a->orl > 0)
129: {
130: fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd);
131: b->url = 0;
132: }
133: else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0))
134: err(errflag,F_ERARG,"recl on open")
135: else
136: b->url = a->orl;
137: if (a->oblnk)
138: b->ublnk = (lcase(*a->oblnk)=='z');
139: else if (lunit == STDERR)
140: b->ublnk = NO;
141: else
142: b->ublnk = blzero;
143: if (a->ofm)
144: {
145: switch(lcase(*a->ofm))
146: {
147: case 'f':
148: b->ufmt = YES;
149: b->uprnt = NO;
150: break;
151: #ifndef KOSHER
152: case 'p': /* print file *** NOT STANDARD FORTRAN ***/
153: b->ufmt = YES;
154: b->uprnt = YES;
155: break;
156: #endif
157: case 'u':
158: b->ufmt = NO;
159: b->uprnt = NO;
160: break;
161: default:
162: err(errflag,F_ERARG,"open form=")
163: }
164: }
165: else /* not specified */
166: { b->ufmt = (b->url==0);
167: if (lunit == STDERR)
168: b->uprnt = NO;
169: else
170: b->uprnt = ccntrl;
171: }
172: if(b->url && b->useek) rewind(b->ufd);
173: return(OK);
174: }
175:
176: fk_open(rd,seq,fmt,n) ftnint n;
177: { char nbuf[10];
178: olist a;
179: sprintf(nbuf, fortfile, (int)n);
180: a.oerr=errflag;
181: a.ounit=n;
182: a.ofnm=nbuf;
183: a.ofnmlen=strlen(nbuf);
184: a.osta=NULL;
185: a.oacc= seq==SEQ?"s":"d";
186: a.ofm = fmt==FMT?"f":"u";
187: a.orl = seq==DIR?1:0;
188: a.oblnk=NULL;
189: return(f_open(&a));
190: }
191:
192: LOCAL
193: isdev(s) char *s;
194: { struct stat x;
195: int j;
196: if(stat(s, &x) == -1) return(NO);
197: if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
198: else return(YES);
199: }
200:
201: /*initialization routine*/
202: f_init()
203: {
204: ini_std(STDERR, stderr, WRITE);
205: ini_std(STDIN, stdin, READ);
206: ini_std(STDOUT, stdout, WRITE);
207: setlinebuf(stderr);
208: }
209:
210: LOCAL
211: ini_std(u,F,w) FILE *F;
212: { unit *p;
213: p = &units[u];
214: p->ufd = F;
215: p->ufnm = NULL;
216: p->useek = canseek(F);
217: p->ufmt = YES;
218: p->uwrt = (w==WRITE)? YES : NO;
219: p->uscrtch = p->uend = NO;
220: p->ublnk = blzero;
221: p->uprnt = ccntrl;
222: p->url = 0;
223: p->uinode = finode(F);
224: }
225:
226: LOCAL
227: canseek(f) FILE *f; /*SYSDEP*/
228: { struct stat x;
229: return( (fstat(fileno(f),&x)==0) &&
230: (x.st_nlink > 0 /*!pipe*/) && !isatty(fileno(f)) );
231: }
232:
233: LOCAL
234: finode(f) FILE *f;
235: { struct stat x;
236: if(fstat(fileno(f),&x)==0) return(x.st_ino);
237: else return(-1);
238: }
239:
240: inode(a) char *a;
241: { struct stat x;
242: if(stat(a,&x)==0) return(x.st_ino);
243: else return(-1);
244: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.