![[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 / libsI77|
Return to open.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libsI77 |
1.1 root 1: /*
2: char id_open[] = "@(#)open.c 1.2";
3: *
4: * open.c - f77 file open routines
5: */
6:
7: #include <sys/types.h>
8: #include <sys/stat.h>
9: #include <errno.h>
10: #include "fio.h"
11:
12: #define SCRATCH (st=='s')
13: #define NEW (st=='n')
14: #define OLD (st=='o')
15: #define OPEN (b->ufd)
16: #define FROM_OPEN "\1" /* for use in f_clos() */
17:
18: extern char *tmplate;
19: extern char *fortfile;
20:
21: f_open(a) olist *a;
22: { unit *b;
23: int n,exists;
24: char buf[256],st;
25: cllist x;
26:
27: lfname = NULL;
28: elist = NO;
29: external = YES; /* for err */
30: errflag = a->oerr;
31: lunit = a->ounit;
32: if(not_legal(lunit)) err(errflag,F_ERUNIT,"open")
33: b= &units[lunit];
34: if(a->osta) st = lcase(*a->osta);
35: else st = 'u';
36: if(SCRATCH)
37: { strcpy(buf,tmplate);
38: mktemp(buf);
39: }
40: else if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf);
41: else sprintf(buf,fortfile,lunit);
42: lfname = &buf[0];
43: if(OPEN)
44: {
45: if(!a->ofnm || inode(buf)==b->uinode)
46: {
47: if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z');
48: #ifndef KOSHER
49: if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p');
50: #endif
51: return(OK);
52: }
53: x.cunit=lunit;
54: x.csta=FROM_OPEN;
55: x.cerr=errflag;
56: if(n=f_clos(&x)) return(n);
57: }
58: exists = (access(buf,0)==NULL);
59: if(!exists && OLD) err(errflag,F_EROLDF,"open");
60: if( exists && NEW) err(errflag,F_ERNEWF,"open");
61: if(isdev(buf))
62: { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO;
63: else err(errflag,errno,buf)
64: }
65: else
66: { if((b->ufd = fopen(buf, "a")) != NULL) b->uwrt = YES;
67: else if((b->ufd = fopen(buf, "r")) != NULL)
68: { fseek(b->ufd, 0L, 2);
69: b->uwrt = NO;
70: }
71: else err(errflag, errno, buf)
72: }
73: if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
74: b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
75: if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
76: strcpy(b->ufnm,buf);
77: b->uscrtch = SCRATCH;
78: b->uend = NO;
79: b->useek = canseek(b->ufd);
80: b->url = a->orl;
81: b->ublnk = (a->oblnk && (lcase(*a->oblnk)=='z'));
82: if (a->ofm)
83: {
84: switch(lcase(*a->ofm))
85: {
86: case 'f':
87: b->ufmt = YES;
88: b->uprnt = NO;
89: break;
90: #ifndef KOSHER
91: case 'p': /* print file *** NOT STANDARD FORTRAN ***/
92: b->ufmt = YES;
93: b->uprnt = YES;
94: break;
95: #endif
96: case 'u':
97: b->ufmt = NO;
98: b->uprnt = NO;
99: break;
100: default:
101: err(errflag,F_ERARG,"open form=")
102: }
103: }
104: else /* not specified */
105: { b->ufmt = (b->url==0);
106: b->uprnt = NO;
107: }
108: if(b->url && b->useek) rewind(b->ufd);
109: return(OK);
110: }
111:
112: fk_open(rd,seq,fmt,n) ftnint n;
113: { char nbuf[10];
114: olist a;
115: sprintf(nbuf, fortfile, (int)n);
116: a.oerr=errflag;
117: a.ounit=n;
118: a.ofnm=nbuf;
119: a.ofnmlen=strlen(nbuf);
120: a.osta=NULL;
121: a.oacc= seq==SEQ?"s":"d";
122: a.ofm = fmt==FMT?"f":"u";
123: a.orl = seq==DIR?1:0;
124: a.oblnk=NULL;
125: return(f_open(&a));
126: }
127:
128: isdev(s) char *s;
129: { struct stat x;
130: int j;
131: if(stat(s, &x) == -1) return(NO);
132: if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
133: else return(YES);
134: }
135:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.