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:  *	@(#)inquire.c	5.2	7/30/85
   7:  */
   8: 
   9: /*
  10:  * inquire.c - f77 i/o inquire statement routine
  11:  */
  12: 
  13: #include "fio.h"
  14: 
  15: f_inqu(a) inlist *a;
  16: {   char *byfile;
  17:     int i;
  18:     int exist;
  19:     unit *p;
  20:     char buf[256], *s;
  21:     long x_inode;
  22: 
  23:     elist = NO;
  24:     lfname = a->infile;
  25:     lunit = a->inunit;
  26:     external = YES;
  27:     p = NULL;
  28:     if(byfile=a->infile)
  29:     {
  30:         g_char(a->infile,a->infilen,buf);
  31:         if((x_inode=inode(buf))==-1)
  32:         {   exist = NO;  /* file doesn't exist */
  33:         }
  34:         else
  35:         {   exist = YES;  /* file does exist */
  36:             for(i=0;i<MXUNIT;i++)
  37:                 if(units[i].ufd && (units[i].uinode==x_inode))
  38:                 {
  39:                     p = &units[i];
  40:                     break;
  41:                 }
  42:         }
  43:     }
  44:     else
  45:     {
  46:         if (not_legal(lunit))
  47:         {   exist = NO;  /* unit doesn't exist */
  48:         }
  49:         else
  50:         {   exist = YES;
  51:             if (units[lunit].ufd)
  52:             {   p= &units[lunit];
  53:                 lfname = p->ufnm;
  54:             }
  55:         }
  56:     }
  57:     if(a->inex) *a->inex = exist;
  58:     if(a->inopen) *a->inopen=(p!=NULL);
  59:     if(a->innum) *a->innum = byfile?(p?(p-units):-1):lunit;
  60:     if(a->innamed) *a->innamed= (byfile || (p && p->ufnm));
  61:     if(a->inname)
  62:     {
  63:         if(byfile) s = buf;
  64:         else if(p && p->ufnm) s = p->ufnm;
  65:         else s="";
  66:         b_char(s,a->inname,a->innamlen);
  67:     }
  68:     if(a->inacc)
  69:     {
  70:         if(!p) s = "unknown";
  71:         else if(p->url) s = "direct";
  72:         else    s = "sequential";
  73:         b_char(s,a->inacc,a->inacclen);
  74:     }
  75:     if(a->inseq)
  76:     {
  77:         if(!p) s = "unknown";
  78:         else s = (p && !p->url)? "yes" : "no";
  79:         b_char(s,a->inseq,a->inseqlen);
  80:     }
  81:     if(a->indir)
  82:     {
  83:         if(!p) s = "unknown";
  84:         else s = (p && p->useek && p->url)? "yes" : "no";
  85:         b_char(s,a->indir,a->indirlen);
  86:     }
  87:     if(a->inform)
  88:     {   if(p)
  89:         {
  90: #ifndef KOSHER
  91:             if(p->uprnt) s = "print"; /*** NOT STANDARD FORTRAN ***/
  92:             else
  93: #endif
  94:                 s = p->ufmt?"formatted":"unformatted";
  95:         }
  96:         else s = "unknown";
  97:         b_char(s,a->inform,a->informlen);
  98:     }
  99:     if(a->infmt)
 100:     {
 101:         if (p) s= p->ufmt? "yes" : "no";
 102:         else s= "unknown";
 103:         b_char(s,a->infmt,a->infmtlen);
 104:     }
 105:     if(a->inunf)
 106:     {
 107:         if (p) s= p->ufmt? "no" : "yes";
 108:         else s= "unknown";
 109:         b_char(s,a->inunf,a->inunflen);
 110:     }
 111:     if(a->inrecl) *a->inrecl = p ? p->url : -1;
 112:     if(a->innrec) {
 113:         if(p && p->url)
 114:             *a->innrec = ((ftell(p->ufd) + p->url - 1)/p->url) + 1;
 115:         else
 116:             *a->innrec = -1;
 117:     }
 118:     if(a->inblank)
 119:     {
 120:         if( p && p->ufmt)
 121:             s = p->ublnk ? "zero" : "null" ;
 122:         else
 123:             s = "unknown";
 124:         b_char(s,a->inblank,a->inblanklen);
 125:     }
 126:     return(OK);
 127: }

Defined functions

f_inqu defined in line 15; never used
Last modified: 1985-07-31
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 982
Valid CSS Valid XHTML 1.0 Strict