projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| 796e5234 | 1 | /* |
| 4cc5540e | 2 | char id_open[] = "@(#)open.c 1.5"; |
| 796e5234 DW |
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 | ||
| 4cc5540e | 18 | short opnbof_; /* open at beginning of file */ |
| 796e5234 DW |
19 | extern char *tmplate; |
| 20 | extern char *fortfile; | |
| 21 | ||
| 22 | f_open(a) olist *a; | |
| 23 | { unit *b; | |
| 24 | int n,exists; | |
| 25 | char buf[256],st; | |
| 26 | cllist x; | |
| 27 | ||
| 28 | lfname = NULL; | |
| 29 | elist = NO; | |
| 30 | external = YES; /* for err */ | |
| 31 | errflag = a->oerr; | |
| 32 | lunit = a->ounit; | |
| 43666f58 | 33 | if(not_legal(lunit)) err(errflag,F_ERUNIT,"open") |
| 796e5234 DW |
34 | b= &units[lunit]; |
| 35 | if(a->osta) st = lcase(*a->osta); | |
| 36 | else st = 'u'; | |
| 37 | if(SCRATCH) | |
| 38 | { strcpy(buf,tmplate); | |
| 39 | mktemp(buf); | |
| 40 | } | |
| 41 | else if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf); | |
| 42 | else sprintf(buf,fortfile,lunit); | |
| 43 | lfname = &buf[0]; | |
| 44 | if(OPEN) | |
| 45 | { | |
| 46 | if(!a->ofnm || inode(buf)==b->uinode) | |
| 47 | { | |
| 48 | if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z'); | |
| 49 | #ifndef KOSHER | |
| 50 | if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p'); | |
| 51 | #endif | |
| 52 | return(OK); | |
| 53 | } | |
| 54 | x.cunit=lunit; | |
| 55 | x.csta=FROM_OPEN; | |
| 56 | x.cerr=errflag; | |
| 57 | if(n=f_clos(&x)) return(n); | |
| 58 | } | |
| 59 | exists = (access(buf,0)==NULL); | |
| 43666f58 DW |
60 | if(!exists && OLD) err(errflag,F_EROLDF,"open"); |
| 61 | if( exists && NEW) err(errflag,F_ERNEWF,"open"); | |
| 796e5234 DW |
62 | if(isdev(buf)) |
| 63 | { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO; | |
| 64 | else err(errflag,errno,buf) | |
| 65 | } | |
| 66 | else | |
| 4cc5540e DW |
67 | { if(!opnbof_ && (b->ufd = fopen(buf, "a")) != NULL) |
| 68 | b->uwrt = YES; | |
| 796e5234 | 69 | else if((b->ufd = fopen(buf, "r")) != NULL) |
| 4cc5540e DW |
70 | { if (!opnbof_) |
| 71 | fseek(b->ufd, 0L, 2); | |
| 796e5234 DW |
72 | b->uwrt = NO; |
| 73 | } | |
| 74 | else err(errflag, errno, buf) | |
| 75 | } | |
| 43666f58 | 76 | if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open") |
| 796e5234 | 77 | b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char)); |
| 43666f58 | 78 | if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open") |
| 796e5234 DW |
79 | strcpy(b->ufnm,buf); |
| 80 | b->uscrtch = SCRATCH; | |
| 81 | b->uend = NO; | |
| 82 | b->useek = canseek(b->ufd); | |
| 42e14fca DW |
83 | if (a->oacc == NULL) |
| 84 | a->oacc = "seq"; | |
| 85 | if (lcase(*a->oacc)=='s' && a->orl > 0) | |
| 86 | { | |
| 4c9938d8 | 87 | fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd); |
| 42e14fca DW |
88 | b->url = 0; |
| 89 | } | |
| 90 | else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0)) | |
| 4c9938d8 DW |
91 | err(errflag,F_ERARG,"recl on open") |
| 92 | else | |
| 93 | b->url = a->orl; | |
| 796e5234 DW |
94 | b->ublnk = (a->oblnk && (lcase(*a->oblnk)=='z')); |
| 95 | if (a->ofm) | |
| 96 | { | |
| 97 | switch(lcase(*a->ofm)) | |
| 98 | { | |
| 99 | case 'f': | |
| 100 | b->ufmt = YES; | |
| 101 | b->uprnt = NO; | |
| 102 | break; | |
| 103 | #ifndef KOSHER | |
| 104 | case 'p': /* print file *** NOT STANDARD FORTRAN ***/ | |
| 105 | b->ufmt = YES; | |
| 106 | b->uprnt = YES; | |
| 107 | break; | |
| 108 | #endif | |
| 109 | case 'u': | |
| 110 | b->ufmt = NO; | |
| 111 | b->uprnt = NO; | |
| 112 | break; | |
| 113 | default: | |
| 43666f58 | 114 | err(errflag,F_ERARG,"open form=") |
| 796e5234 DW |
115 | } |
| 116 | } | |
| 117 | else /* not specified */ | |
| 118 | { b->ufmt = (b->url==0); | |
| 119 | b->uprnt = NO; | |
| 120 | } | |
| 121 | if(b->url && b->useek) rewind(b->ufd); | |
| 122 | return(OK); | |
| 123 | } | |
| 124 | ||
| 125 | fk_open(rd,seq,fmt,n) ftnint n; | |
| 126 | { char nbuf[10]; | |
| 127 | olist a; | |
| 128 | sprintf(nbuf, fortfile, (int)n); | |
| 129 | a.oerr=errflag; | |
| 130 | a.ounit=n; | |
| 131 | a.ofnm=nbuf; | |
| 132 | a.ofnmlen=strlen(nbuf); | |
| 133 | a.osta=NULL; | |
| 134 | a.oacc= seq==SEQ?"s":"d"; | |
| 135 | a.ofm = fmt==FMT?"f":"u"; | |
| 136 | a.orl = seq==DIR?1:0; | |
| 137 | a.oblnk=NULL; | |
| 138 | return(f_open(&a)); | |
| 139 | } | |
| 140 | ||
| 141 | isdev(s) char *s; | |
| 142 | { struct stat x; | |
| 143 | int j; | |
| 144 | if(stat(s, &x) == -1) return(NO); | |
| 145 | if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO); | |
| 146 | else return(YES); | |
| 147 | } | |
| 148 |