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 164