lang/fortran/lib/libI77/inquire.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 integer f_inqu(a) inlist *a;
   4 {       flag byfile;
   5         int i, n;
   6         unit *p;
   7         char buf[256];
   8         long x;
   9         if(a->infile!=NULL)
  10         {       byfile=1;
  11                 g_char(a->infile,a->infilen,buf);
  12 #ifdef MSDOS
  13                 x = access(buf,0) ? -1 : 0;
  14                 for(i=0,p=NULL;i<MXUNIT;i++)
  15                         if(units[i].ufd!=NULL && !strcmp(units[i].ufnm,buf)) {
  16                                 p = &units[i];
  17                                 break;
  18                                 }
  19 #else
  20                 x=inode(buf, &n);
  21                 for(i=0,p=NULL;i<MXUNIT;i++)
  22                         if(units[i].uinode==x
  23                         && units[i].ufd!=NULL
  24                         && units[i].udev == n) {
  25                                 p = &units[i];
  26                                 break;
  27                                 }
  28 #endif
  29         }
  30         else
  31         {
  32                 byfile=0;
  33                 if(a->inunit<MXUNIT && a->inunit>=0)
  34                 {
  35                         p= &units[a->inunit];
  36                 }
  37                 else
  38                 {
  39                         p=NULL;
  40                 }
  41         }
  42         if(a->inex!=NULL)
  43                 if(byfile && x != -1 || !byfile && p!=NULL)
  44                         *a->inex=1;
  45                 else *a->inex=0;
  46         if(a->inopen!=NULL)
  47                 if(byfile) *a->inopen=(p!=NULL);
  48                 else *a->inopen=(p!=NULL && p->ufd!=NULL);
  49         if(a->innum!=NULL) *a->innum= p-units;
  50         if(a->innamed!=NULL)
  51                 if(byfile || p!=NULL && p->ufnm!=NULL)
  52                         *a->innamed=1;
  53                 else    *a->innamed=0;
  54         if(a->inname!=NULL)
  55                 if(byfile)
  56                         b_char(buf,a->inname,a->innamlen);
  57                 else if(p!=NULL && p->ufnm!=NULL)
  58                         b_char(p->ufnm,a->inname,a->innamlen);
  59         if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL)
  60                 if(p->url)
  61                         b_char("DIRECT",a->inacc,a->inacclen);
  62                 else    b_char("SEQUENTIAL",a->inacc,a->inacclen);
  63         if(a->inseq!=NULL)
  64                 if(p!=NULL && p->url)
  65                         b_char("NO",a->inseq,a->inseqlen);
  66                 else    b_char("YES",a->inseq,a->inseqlen);
  67         if(a->indir!=NULL)
  68                 if(p==NULL || p->url)
  69                         b_char("YES",a->indir,a->indirlen);
  70                 else    b_char("NO",a->indir,a->indirlen);
  71         if(a->infmt!=NULL)
  72                 if(p!=NULL && p->ufmt==0)
  73                         b_char("UNFORMATTED",a->infmt,a->infmtlen);
  74                 else    b_char("FORMATTED",a->infmt,a->infmtlen);
  75         if(a->inform!=NULL)
  76                 if(p!=NULL && p->ufmt==0)
  77                 b_char("NO",a->inform,a->informlen);
  78                 else b_char("YES",a->inform,a->informlen);
  79         if(a->inunf)
  80                 if(p!=NULL && p->ufmt==0)
  81                         b_char("YES",a->inunf,a->inunflen);
  82                 else if (p!=NULL) b_char("NO",a->inunf,a->inunflen);
  83                 else b_char("UNKNOWN",a->inunf,a->inunflen);
  84         if(a->inrecl!=NULL && p!=NULL)
  85                 *a->inrecl=p->url;
  86         if(a->innrec!=NULL && p!=NULL && p->url>0)
  87                 *a->innrec=ftell(p->ufd)/p->url+1;
  88         if(a->inblank && p!=NULL && p->ufmt)
  89                 if(p->ublnk)
  90                         b_char("ZERO",a->inblank,a->inblanklen);
  91                 else    b_char("NULL",a->inblank,a->inblanklen);
  92         return(0);
  93 }