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: }

Defined functions

f_open defined in line 21; used 1 times
isdev defined in line 156; used 1 times
  • in line 61

Defined macros

FROM_OPEN defined in line 16; used 1 times
  • in line 54
NEW defined in line 13; used 1 times
  • in line 60
OLD defined in line 14; used 1 times
  • in line 59
OPEN defined in line 15; used 1 times
  • in line 43
SCRATCH defined in line 12; used 2 times
Last modified: 1983-05-20
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 862
Valid CSS Valid XHTML 1.0 Strict