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