1: /*
   2:  * Copyright (c) 1980 Regents of the University of California.
   3:  * All rights reserved.  The Berkeley software License Agreement
   4:  * specifies the terms and conditions for redistribution.
   5:  *
   6:  *	@(#)open.c	5.2	1/8/86
   7:  */
   8: 
   9: /*
  10:  * open.c  -  f77 file open and I/O library initialization routines
  11:  */
  12: 
  13: #include    <sys/types.h>
  14: #include    <sys/stat.h>
  15: #include    <errno.h>
  16: #include    "fio.h"
  17: 
  18: #define SCRATCH (st=='s')
  19: #define NEW (st=='n')
  20: #define OLD (st=='o')
  21: #define OPEN    (b->ufd)
  22: #define FROM_OPEN   "\2"    /* for use in f_clos() */
  23: #define BUF_LEN 256
  24: 
  25: LOCAL char *tmplate = "tmp.FXXXXXX";    /* scratch file template */
  26: LOCAL char *fortfile = "fort.%d";   /* default file template */
  27: 
  28: char *getenv();
  29: 
  30: f_open(a) olist *a;
  31: {   unit *b;
  32:     int n,exists;
  33:     char buf[BUF_LEN], env_name[BUF_LEN];
  34:     char *env_val, *p1, *p2, ch, st;
  35:     cllist x;
  36: 
  37:     lfname = NULL;
  38:     elist = NO;
  39:     external = YES;         /* for err */
  40:     errflag = a->oerr;
  41:     lunit = a->ounit;
  42:     if(not_legal(lunit)) err(errflag,F_ERUNIT,"open")
  43:     b= &units[lunit];
  44:     if(a->osta) st = lcase(*a->osta);
  45:     else st = 'u';
  46:     if(SCRATCH)
  47:     {   strcpy(buf,tmplate);
  48:         /* make a new temp file name, err if mktemp fails */
  49:         if( strcmp( mktemp(buf), "/" ) == 0 )
  50:             err(errflag, F_ERSYS, "open")
  51:     }
  52:     else
  53:     {
  54:         if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf);
  55:         else sprintf(buf,fortfile,lunit);
  56:         /*   check if overriding file name via environment variable
  57: 		 *   first copy tail of name - delete periods as Bourne Shell
  58: 		 *      croaks if any periods in name
  59: 		 */
  60:          p1 = buf;
  61:          p2 = env_name;
  62:          while ((ch = *p1++) != '\0') {
  63:             if(ch == '/') p2 = env_name;
  64:             else if(ch != '.') *p2++ = ch;
  65:          }
  66:          if(p2 != env_name) {
  67:             *p2 = '\0';
  68:             if( (env_val = getenv( env_name  )) != NULL ) {
  69:             if(strlen(env_val) >= BUF_LEN-1 )
  70:                 err(errflag,F_ERSTAT,"open: file name too long");
  71:             strcpy(buf, env_val);
  72:             }
  73:          }
  74:     }
  75:     lfname = &buf[0];
  76:     if(OPEN)
  77:     {
  78:         if(!a->ofnm || inode(buf)==b->uinode)
  79:         {
  80:             if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z');
  81: #ifndef KOSHER
  82:             if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p');
  83: #endif
  84:             return(OK);
  85:         }
  86:         x.cunit=lunit;
  87:         x.csta=FROM_OPEN;
  88:         x.cerr=errflag;
  89:         if(n=f_clos(&x)) return(n);
  90:     }
  91:     exists = (access(buf,0)==NULL);
  92:     if(!exists && OLD) err(errflag,F_EROLDF,"open");
  93:     if( exists && NEW) err(errflag,F_ERNEWF,"open");
  94:     errno = F_ERSYS;
  95:     if(isdev(buf))
  96:     {   if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO;
  97:         else    err(errflag,errno,buf)
  98:     }
  99:     else
 100:     {
 101:         errno = F_ERSYS;
 102:         if((b->ufd = fopen(buf, "a")) != NULL)
 103:         {   if(!opneof)
 104:             {   if(freopen(buf, "r", b->ufd) != NULL)
 105:                     b->uwrt = NO;
 106:                 else
 107:                     err(errflag, errno, buf)
 108:             }
 109:             else
 110:                 b->uwrt = YES;
 111:         }
 112:         else if((b->ufd = fopen(buf, "r")) != NULL)
 113:         {   if (opneof)
 114:                 fseek(b->ufd, 0L, 2);
 115:             b->uwrt = NO;
 116:         }
 117:         else    err(errflag, errno, buf)
 118:     }
 119:     if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
 120:     b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
 121:     if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
 122:     strcpy(b->ufnm,buf);
 123:     b->uscrtch = SCRATCH;
 124:     b->uend = NO;
 125:     b->useek = canseek(b->ufd);
 126:     if (a->oacc == NULL)
 127:         a->oacc = "seq";
 128:     if (lcase(*a->oacc)=='s' && a->orl > 0)
 129:     {
 130:         fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd);
 131:         b->url = 0;
 132:     }
 133:     else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0))
 134:         err(errflag,F_ERARG,"recl on open")
 135:     else
 136:         b->url = a->orl;
 137:     if (a->oblnk)
 138:         b->ublnk = (lcase(*a->oblnk)=='z');
 139:     else if (lunit == STDERR)
 140:         b->ublnk = NO;
 141:     else
 142:         b->ublnk = blzero;
 143:     if (a->ofm)
 144:     {
 145:         switch(lcase(*a->ofm))
 146:         {
 147:         case 'f':
 148:             b->ufmt = YES;
 149:             b->uprnt = NO;
 150:             break;
 151: #ifndef KOSHER
 152:         case 'p':   /* print file *** NOT STANDARD FORTRAN ***/
 153:             b->ufmt = YES;
 154:             b->uprnt = YES;
 155:             break;
 156: #endif
 157:         case 'u':
 158:             b->ufmt = NO;
 159:             b->uprnt = NO;
 160:             break;
 161:         default:
 162:             err(errflag,F_ERARG,"open form=")
 163:         }
 164:     }
 165:     else    /* not specified */
 166:     {   b->ufmt = (b->url==0);
 167:         if (lunit == STDERR)
 168:             b->uprnt = NO;
 169:         else
 170:             b->uprnt = ccntrl;
 171:     }
 172:     if(b->url && b->useek) rewind(b->ufd);
 173:     return(OK);
 174: }
 175: 
 176: fk_open(rd,seq,fmt,n) ftnint n;
 177: {   char nbuf[10];
 178:     olist a;
 179:     sprintf(nbuf, fortfile, (int)n);
 180:     a.oerr=errflag;
 181:     a.ounit=n;
 182:     a.ofnm=nbuf;
 183:     a.ofnmlen=strlen(nbuf);
 184:     a.osta=NULL;
 185:     a.oacc= seq==SEQ?"s":"d";
 186:     a.ofm = fmt==FMT?"f":"u";
 187:     a.orl = seq==DIR?1:0;
 188:     a.oblnk=NULL;
 189:     return(f_open(&a));
 190: }
 191: 
 192: LOCAL
 193: isdev(s) char *s;
 194: {   struct stat x;
 195:     int j;
 196:     if(stat(s, &x) == -1) return(NO);
 197:     if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
 198:     else    return(YES);
 199: }
 200: 
 201: /*initialization routine*/
 202: f_init()
 203: {
 204:     ini_std(STDERR, stderr, WRITE);
 205:     ini_std(STDIN, stdin, READ);
 206:     ini_std(STDOUT, stdout, WRITE);
 207:     setlinebuf(stderr);
 208: }
 209: 
 210: LOCAL
 211: ini_std(u,F,w) FILE *F;
 212: {   unit *p;
 213:     p = &units[u];
 214:     p->ufd = F;
 215:     p->ufnm = NULL;
 216:     p->useek = canseek(F);
 217:     p->ufmt = YES;
 218:     p->uwrt = (w==WRITE)? YES : NO;
 219:     p->uscrtch = p->uend = NO;
 220:     p->ublnk = blzero;
 221:     p->uprnt = ccntrl;
 222:     p->url = 0;
 223:     p->uinode = finode(F);
 224: }
 225: 
 226: LOCAL
 227: canseek(f) FILE *f; /*SYSDEP*/
 228: {   struct stat x;
 229:     return( (fstat(fileno(f),&x)==0) &&
 230:     (x.st_nlink > 0 /*!pipe*/) && !isatty(fileno(f)) );
 231: }
 232: 
 233: LOCAL
 234: finode(f) FILE *f;
 235: {   struct stat x;
 236:     if(fstat(fileno(f),&x)==0) return(x.st_ino);
 237:     else return(-1);
 238: }
 239: 
 240: inode(a) char *a;
 241: {   struct stat x;
 242:     if(stat(a,&x)==0) return(x.st_ino);
 243:     else return(-1);
 244: }

Defined functions

canseek defined in line 226; used 2 times
f_init defined in line 202; used 1 times
f_open defined in line 30; used 1 times
finode defined in line 233; used 2 times
ini_std defined in line 210; used 3 times
inode defined in line 240; used 2 times
isdev defined in line 192; used 1 times
  • in line 95

Defined variables

fortfile defined in line 26; used 2 times
tmplate defined in line 25; used 1 times
  • in line 47

Defined macros

BUF_LEN defined in line 23; used 3 times
FROM_OPEN defined in line 22; used 1 times
  • in line 87
NEW defined in line 19; used 1 times
  • in line 93
OLD defined in line 20; used 1 times
  • in line 92
OPEN defined in line 21; used 1 times
  • in line 76
SCRATCH defined in line 18; used 2 times
Last modified: 1987-02-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 3258
Valid CSS Valid XHTML 1.0 Strict