|
|
1.1 root 1: /*
2: char id_open[] = "@(#)open.c 1.10";
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 "\2" /* 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)
67: { if(!opneof)
68: { if(freopen(buf, "r", b->ufd) != NULL)
69: b->uwrt = NO;
70: else
71: err(errflag, errno, buf)
72: }
73: else
74: b->uwrt = YES;
75: }
76: else if((b->ufd = fopen(buf, "r")) != NULL)
77: { if (opneof)
78: fseek(b->ufd, 0L, 2);
79: b->uwrt = NO;
80: }
81: else err(errflag, errno, buf)
82: }
83: if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
84: b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
85: if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
86: strcpy(b->ufnm,buf);
87: b->uscrtch = SCRATCH;
88: b->uend = NO;
89: b->useek = canseek(b->ufd);
90: if (a->oacc == NULL)
91: a->oacc = "seq";
92: if (lcase(*a->oacc)=='s' && a->orl > 0)
93: {
94: fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd);
95: b->url = 0;
96: }
97: else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0))
98: err(errflag,F_ERARG,"recl on open")
99: else
100: b->url = a->orl;
101: if (a->oblnk)
102: b->ublnk = (lcase(*a->oblnk)=='z');
103: else if (lunit == STDERR)
104: b->ublnk = NO;
105: else
106: b->ublnk = blzero;
107: if (a->ofm)
108: {
109: switch(lcase(*a->ofm))
110: {
111: case 'f':
112: b->ufmt = YES;
113: b->uprnt = NO;
114: break;
115: #ifndef KOSHER
116: case 'p': /* print file *** NOT STANDARD FORTRAN ***/
117: b->ufmt = YES;
118: b->uprnt = YES;
119: break;
120: #endif
121: case 'u':
122: b->ufmt = NO;
123: b->uprnt = NO;
124: break;
125: default:
126: err(errflag,F_ERARG,"open form=")
127: }
128: }
129: else /* not specified */
130: { b->ufmt = (b->url==0);
131: if (lunit == STDERR)
132: b->uprnt = NO;
133: else
134: b->uprnt = ccntrl;
135: }
136: if(b->url && b->useek) rewind(b->ufd);
137: return(OK);
138: }
139:
140: fk_open(rd,seq,fmt,n) ftnint n;
141: { char nbuf[10];
142: olist a;
143: sprintf(nbuf, fortfile, (int)n);
144: a.oerr=errflag;
145: a.ounit=n;
146: a.ofnm=nbuf;
147: a.ofnmlen=strlen(nbuf);
148: a.osta=NULL;
149: a.oacc= seq==SEQ?"s":"d";
150: a.ofm = fmt==FMT?"f":"u";
151: a.orl = seq==DIR?1:0;
152: a.oblnk=NULL;
153: return(f_open(&a));
154: }
155:
156: isdev(s) char *s;
157: { struct stat x;
158: int j;
159: if(stat(s, &x) == -1) return(NO);
160: if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
161: else return(YES);
162: }
163:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.