![[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 [Research Unix] / researchv10dc / libI77|
Return to open.c CVS log | Up to [Research Unix] / researchv10dc / libI77 |
1.1 ! root 1: #include "sys/types.h" ! 2: #include "sys/stat.h" ! 3: #include "f2c.h" ! 4: #include "fio.h" ! 5: #include "string.h" ! 6: #include "rawio.h" ! 7: ! 8: #ifdef KR_headers ! 9: extern char *malloc(), *mktemp(); ! 10: extern integer f_clos(); ! 11: #else ! 12: #undef abs ! 13: #undef min ! 14: #undef max ! 15: #include "stdlib.h" ! 16: extern int f__canseek(FILE*); ! 17: extern integer f_clos(cllist*); ! 18: #endif ! 19: ! 20: #ifdef NON_ANSI_RW_MODES ! 21: char *f__r_mode[2] = {"r", "r"}; ! 22: char *f__w_mode[4] = {"w", "w", "r+w", "r+w"}; ! 23: #else ! 24: char *f__r_mode[2] = {"rb", "r"}; ! 25: char *f__w_mode[4] = {"wb", "w", "r+b", "r+"}; ! 26: #endif ! 27: ! 28: #ifdef KR_headers ! 29: f__isdev(s) char *s; ! 30: #else ! 31: f__isdev(char *s) ! 32: #endif ! 33: { ! 34: #ifdef NON_UNIX_STDIO ! 35: int i, j; ! 36: ! 37: i = open(s,O_RDONLY); ! 38: if (i == -1) ! 39: return 0; ! 40: j = isatty(i); ! 41: close(i); ! 42: return j; ! 43: #else ! 44: struct stat x; ! 45: ! 46: if(stat(s, &x) == -1) return(0); ! 47: #ifdef S_IFMT ! 48: switch(x.st_mode&S_IFMT) { ! 49: case S_IFREG: ! 50: case S_IFDIR: ! 51: return(0); ! 52: } ! 53: #else ! 54: #ifdef S_ISREG ! 55: /* POSIX version */ ! 56: if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) ! 57: return(0); ! 58: else ! 59: #else ! 60: Help! How does stat work on this system? ! 61: #endif ! 62: #endif ! 63: return(1); ! 64: #endif ! 65: } ! 66: #ifdef KR_headers ! 67: integer f_open(a) olist *a; ! 68: #else ! 69: integer f_open(olist *a) ! 70: #endif ! 71: { unit *b; ! 72: int n; ! 73: integer rv; ! 74: char buf[256], *s; ! 75: cllist x; ! 76: #ifdef NON_UNIX_STDIO ! 77: FILE *tf; ! 78: #else ! 79: struct stat stb; ! 80: #endif ! 81: if(a->ounit>=MXUNIT || a->ounit<0) ! 82: err(a->oerr,101,"open") ! 83: f__curunit = b = &f__units[a->ounit]; ! 84: if(b->ufd) { ! 85: if(a->ofnm==0) ! 86: { ! 87: same: if (a->oblnk) ! 88: b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z'; ! 89: return(0); ! 90: } ! 91: #ifdef NON_UNIX_STDIO ! 92: if (b->ufnm ! 93: && strlen(b->ufnm) == a->ofnmlen ! 94: && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen)) ! 95: goto same; ! 96: #else ! 97: g_char(a->ofnm,a->ofnmlen,buf); ! 98: if (f__inode(buf,&n) == b->uinode && n == b->udev) ! 99: goto same; ! 100: #endif ! 101: x.cunit=a->ounit; ! 102: x.csta=0; ! 103: x.cerr=a->oerr; ! 104: if ((rv = f_clos(&x)) != 0) ! 105: return rv; ! 106: } ! 107: b->url = (int)a->orl; ! 108: b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z'); ! 109: if(a->ofm==0) ! 110: { if(b->url>0) b->ufmt=0; ! 111: else b->ufmt=1; ! 112: } ! 113: else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1; ! 114: else b->ufmt=0; ! 115: #ifdef url_Adjust ! 116: if (b->url && !b->ufmt) ! 117: url_Adjust(b->url); ! 118: #endif ! 119: if (a->ofnm) { ! 120: g_char(a->ofnm,a->ofnmlen,buf); ! 121: if (!buf[0]) ! 122: err(a->oerr,107,"open") ! 123: } ! 124: else ! 125: sprintf(buf, "fort.%ld", a->ounit); ! 126: b->uscrtch = 0; ! 127: switch(a->osta ? *a->osta : 'u') ! 128: { ! 129: case 'o': ! 130: case 'O': ! 131: #ifdef NON_UNIX_STDIO ! 132: if(access(buf,0)) ! 133: #else ! 134: if(stat(buf,&stb)) ! 135: #endif ! 136: err(a->oerr,errno,"open") ! 137: break; ! 138: case 's': ! 139: case 'S': ! 140: b->uscrtch=1; ! 141: #ifdef _POSIX_SOURCE ! 142: tmpnam(buf); ! 143: #else ! 144: (void) strcpy(buf,"tmp.FXXXXXX"); ! 145: (void) mktemp(buf); ! 146: #endif ! 147: goto replace; ! 148: case 'n': ! 149: case 'N': ! 150: #ifdef NON_UNIX_STDIO ! 151: if(!access(buf,0)) ! 152: #else ! 153: if(!stat(buf,&stb)) ! 154: #endif ! 155: err(a->oerr,128,"open") ! 156: /* no break */ ! 157: case 'r': /* Fortran 90 replace option */ ! 158: case 'R': ! 159: replace: ! 160: #ifdef NON_UNIX_STDIO ! 161: if (tf = fopen(buf,f__w_mode[0])) ! 162: fclose(tf); ! 163: #else ! 164: (void) close(creat(buf, 0666)); ! 165: #endif ! 166: } ! 167: ! 168: b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1)); ! 169: if(b->ufnm==NULL) err(a->oerr,113,"no space"); ! 170: (void) strcpy(b->ufnm,buf); ! 171: b->uend=0; ! 172: b->uwrt = 0; ! 173: if(f__isdev(buf)) ! 174: { b->ufd = fopen(buf,f__r_mode[b->ufmt]); ! 175: if(b->ufd==NULL) err(a->oerr,errno,buf) ! 176: } ! 177: else { ! 178: if(!(b->ufd = fopen(buf, f__r_mode[b->ufmt]))) { ! 179: #ifdef NON_UNIX_STDIO ! 180: if (b->ufd = fopen(buf, f__w_mode[b->ufmt+2])) ! 181: b->uwrt = 2; ! 182: else if (b->ufd = fopen(buf, f__w_mode[b->ufmt])) ! 183: b->uwrt = 1; ! 184: else ! 185: #else ! 186: if ((n = open(buf,O_WRONLY)) >= 0) ! 187: b->uwrt = 2; ! 188: else { ! 189: n = creat(buf, 0666); ! 190: b->uwrt = 1; ! 191: } ! 192: if (n < 0 ! 193: || (b->ufd = fdopen(n, f__w_mode[b->ufmt])) == NULL) ! 194: #endif ! 195: err(a->oerr, errno, "open"); ! 196: } ! 197: } ! 198: b->useek=f__canseek(b->ufd); ! 199: #ifndef NON_UNIX_STDIO ! 200: if((b->uinode=f__inode(buf,&b->udev))==-1) ! 201: err(a->oerr,108,"open") ! 202: #endif ! 203: if(b->useek) ! 204: if (a->orl) ! 205: rewind(b->ufd); ! 206: else if ((s = a->oacc) && (*s == 'a' || *s == 'A') ! 207: && fseek(b->ufd, 0L, SEEK_END)) ! 208: err(a->oerr,129,"open"); ! 209: return(0); ! 210: } ! 211: #ifdef KR_headers ! 212: fk_open(seq,fmt,n) ftnint n; ! 213: #else ! 214: fk_open(int seq, int fmt, ftnint n) ! 215: #endif ! 216: { char nbuf[10]; ! 217: olist a; ! 218: (void) sprintf(nbuf,"fort.%ld",n); ! 219: a.oerr=1; ! 220: a.ounit=n; ! 221: a.ofnm=nbuf; ! 222: a.ofnmlen=strlen(nbuf); ! 223: a.osta=NULL; ! 224: a.oacc= seq==SEQ?"s":"d"; ! 225: a.ofm = fmt==FMT?"f":"u"; ! 226: a.orl = seq==DIR?1:0; ! 227: a.oblnk=NULL; ! 228: return(f_open(&a)); ! 229: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.