![[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 [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libI77|
Return to open.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / 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.1 6/7/85
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: mktemp(buf);
49: }
50: else
51: {
52: if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf);
53: else sprintf(buf,fortfile,lunit);
54: /* check if overriding file name via environment variable
55: * first copy tail of name - delete periods as Bourne Shell
56: * croaks if any periods in name
57: */
58: p1 = buf;
59: p2 = env_name;
60: while ((ch = *p1++) != '\0') {
61: if(ch == '/') p2 = env_name;
62: else if(ch != '.') *p2++ = ch;
63: }
64: if(p2 != env_name) {
65: *p2 = '\0';
66: if( (env_val = getenv( env_name )) != NULL ) {
67: if(strlen(env_val) >= BUF_LEN-1 )
68: err(errflag,F_ERSTAT,"open: file name too long");
69: strcpy(buf, env_val);
70: }
71: }
72: }
73: lfname = &buf[0];
74: if(OPEN)
75: {
76: if(!a->ofnm || inode(buf)==b->uinode)
77: {
78: if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z');
79: #ifndef KOSHER
80: if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p');
81: #endif
82: return(OK);
83: }
84: x.cunit=lunit;
85: x.csta=FROM_OPEN;
86: x.cerr=errflag;
87: if(n=f_clos(&x)) return(n);
88: }
89: exists = (access(buf,0)==NULL);
90: if(!exists && OLD) err(errflag,F_EROLDF,"open");
91: if( exists && NEW) err(errflag,F_ERNEWF,"open");
92: errno = F_ERSYS;
93: if(isdev(buf))
94: { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO;
95: else err(errflag,errno,buf)
96: }
97: else
98: {
99: errno = F_ERSYS;
100: if((b->ufd = fopen(buf, "a")) != NULL)
101: { if(!opneof)
102: { if(freopen(buf, "r", b->ufd) != NULL)
103: b->uwrt = NO;
104: else
105: err(errflag, errno, buf)
106: }
107: else
108: b->uwrt = YES;
109: }
110: else if((b->ufd = fopen(buf, "r")) != NULL)
111: { if (opneof)
112: fseek(b->ufd, 0L, 2);
113: b->uwrt = NO;
114: }
115: else err(errflag, errno, buf)
116: }
117: if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
118: b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
119: if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
120: strcpy(b->ufnm,buf);
121: b->uscrtch = SCRATCH;
122: b->uend = NO;
123: b->useek = canseek(b->ufd);
124: if (a->oacc == NULL)
125: a->oacc = "seq";
126: if (lcase(*a->oacc)=='s' && a->orl > 0)
127: {
128: fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd);
129: b->url = 0;
130: }
131: else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0))
132: err(errflag,F_ERARG,"recl on open")
133: else
134: b->url = a->orl;
135: if (a->oblnk)
136: b->ublnk = (lcase(*a->oblnk)=='z');
137: else if (lunit == STDERR)
138: b->ublnk = NO;
139: else
140: b->ublnk = blzero;
141: if (a->ofm)
142: {
143: switch(lcase(*a->ofm))
144: {
145: case 'f':
146: b->ufmt = YES;
147: b->uprnt = NO;
148: break;
149: #ifndef KOSHER
150: case 'p': /* print file *** NOT STANDARD FORTRAN ***/
151: b->ufmt = YES;
152: b->uprnt = YES;
153: break;
154: #endif
155: case 'u':
156: b->ufmt = NO;
157: b->uprnt = NO;
158: break;
159: default:
160: err(errflag,F_ERARG,"open form=")
161: }
162: }
163: else /* not specified */
164: { b->ufmt = (b->url==0);
165: if (lunit == STDERR)
166: b->uprnt = NO;
167: else
168: b->uprnt = ccntrl;
169: }
170: if(b->url && b->useek) rewind(b->ufd);
171: return(OK);
172: }
173:
174: fk_open(rd,seq,fmt,n) ftnint n;
175: { char nbuf[10];
176: olist a;
177: sprintf(nbuf, fortfile, (int)n);
178: a.oerr=errflag;
179: a.ounit=n;
180: a.ofnm=nbuf;
181: a.ofnmlen=strlen(nbuf);
182: a.osta=NULL;
183: a.oacc= seq==SEQ?"s":"d";
184: a.ofm = fmt==FMT?"f":"u";
185: a.orl = seq==DIR?1:0;
186: a.oblnk=NULL;
187: return(f_open(&a));
188: }
189:
190: LOCAL
191: isdev(s) char *s;
192: { struct stat x;
193: int j;
194: if(stat(s, &x) == -1) return(NO);
195: if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
196: else return(YES);
197: }
198:
199: /*initialization routine*/
200: f_init()
201: {
202: ini_std(STDERR, stderr, WRITE);
203: ini_std(STDIN, stdin, READ);
204: ini_std(STDOUT, stdout, WRITE);
205: setlinebuf(stderr);
206: }
207:
208: LOCAL
209: ini_std(u,F,w) FILE *F;
210: { unit *p;
211: p = &units[u];
212: p->ufd = F;
213: p->ufnm = NULL;
214: p->useek = canseek(F);
215: p->ufmt = YES;
216: p->uwrt = (w==WRITE)? YES : NO;
217: p->uscrtch = p->uend = NO;
218: p->ublnk = blzero;
219: p->uprnt = ccntrl;
220: p->url = 0;
221: p->uinode = finode(F);
222: }
223:
224: LOCAL
225: canseek(f) FILE *f; /*SYSDEP*/
226: { struct stat x;
227: return( (fstat(fileno(f),&x)==0) &&
228: (x.st_nlink > 0 /*!pipe*/) && !isatty(fileno(f)) );
229: }
230:
231: LOCAL
232: finode(f) FILE *f;
233: { struct stat x;
234: if(fstat(fileno(f),&x)==0) return(x.st_ino);
235: else return(-1);
236: }
237:
238: inode(a) char *a;
239: { struct stat x;
240: if(stat(a,&x)==0) return(x.st_ino);
241: else return(-1);
242: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.