toolchain/gcc/libf2c/libI77/inquire.c

   1 #include "config.h"
   2 #include "f2c.h"
   3 #include "fio.h"
   4 #include <string.h>
   5 #if defined (MSDOS) && !defined (GO32)
   6 #undef abs
   7 #undef min
   8 #undef max
   9 #include "io.h"
  10 #endif
  11 integer
  12 f_inqu (inlist * a)
  13 {
  14   flag byfile;
  15   int i, n;
  16   unit *p;
  17   char buf[256];
  18   long x;
  19   if (f__init & 2)
  20     f__fatal (131, "I/O recursion");
  21   if (a->infile != NULL)
  22     {
  23       byfile = 1;
  24       g_char (a->infile, a->infilen, buf);
  25 #ifdef NON_UNIX_STDIO
  26       x = access (buf, 0) ? -1 : 0;
  27       for (i = 0, p = NULL; i < MXUNIT; i++)
  28         if (f__units[i].ufd != NULL
  29             && f__units[i].ufnm != NULL && !strcmp (f__units[i].ufnm, buf))
  30           {
  31             p = &f__units[i];
  32             break;
  33           }
  34 #else
  35       x = f__inode (buf, &n);
  36       for (i = 0, p = NULL; i < MXUNIT; i++)
  37         if (f__units[i].uinode == x
  38             && f__units[i].ufd != NULL && f__units[i].udev == n)
  39           {
  40             p = &f__units[i];
  41             break;
  42           }
  43 #endif
  44     }
  45   else
  46     {
  47       byfile = 0;
  48       if (a->inunit < MXUNIT && a->inunit >= 0)
  49         {
  50           p = &f__units[a->inunit];
  51         }
  52       else
  53         {
  54           p = NULL;
  55         }
  56     }
  57   if (a->inex != NULL)
  58     {
  59       if ((byfile && x != -1) || (!byfile && p != NULL))
  60         *a->inex = 1;
  61       else
  62         *a->inex = 0;
  63     }
  64   if (a->inopen != NULL)
  65     {
  66       if (byfile)
  67         *a->inopen = (p != NULL);
  68       else
  69         *a->inopen = (p != NULL && p->ufd != NULL);
  70     }
  71   if (a->innum != NULL)
  72     *a->innum = p - f__units;
  73   if (a->innamed != NULL)
  74     {
  75       if (byfile || (p != NULL && p->ufnm != NULL))
  76         *a->innamed = 1;
  77       else
  78         *a->innamed = 0;
  79     }
  80   if (a->inname != NULL)
  81     {
  82       if (byfile)
  83         b_char (buf, a->inname, a->innamlen);
  84       else if (p != NULL && p->ufnm != NULL)
  85         b_char (p->ufnm, a->inname, a->innamlen);
  86     }
  87   if (a->inacc != NULL && p != NULL && p->ufd != NULL)
  88     {
  89       if (p->url)
  90         b_char ("DIRECT", a->inacc, a->inacclen);
  91       else
  92         b_char ("SEQUENTIAL", a->inacc, a->inacclen);
  93     }
  94   if (a->inseq != NULL)
  95     {
  96       if (p != NULL && p->url)
  97         b_char ("NO", a->inseq, a->inseqlen);
  98       else
  99         b_char ("YES", a->inseq, a->inseqlen);
 100     }
 101   if (a->indir != NULL)
 102     {
 103       if (p == NULL || p->url)
 104         b_char ("YES", a->indir, a->indirlen);
 105       else
 106         b_char ("NO", a->indir, a->indirlen);
 107     }
 108   if (a->infmt != NULL)
 109     {
 110       if (p != NULL && p->ufmt == 0)
 111         b_char ("UNFORMATTED", a->infmt, a->infmtlen);
 112       else
 113         b_char ("FORMATTED", a->infmt, a->infmtlen);
 114     }
 115   if (a->inform != NULL)
 116     {
 117       if (p != NULL && p->ufmt == 0)
 118         b_char ("NO", a->inform, a->informlen);
 119       else
 120         b_char ("YES", a->inform, a->informlen);
 121     }
 122   if (a->inunf)
 123     {
 124       if (p != NULL && p->ufmt == 0)
 125         b_char ("YES", a->inunf, a->inunflen);
 126       else if (p != NULL)
 127         b_char ("NO", a->inunf, a->inunflen);
 128       else
 129         b_char ("UNKNOWN", a->inunf, a->inunflen);
 130     }
 131   if (a->inrecl != NULL && p != NULL)
 132     *a->inrecl = p->url;
 133   if (a->innrec != NULL && p != NULL && p->url > 0)
 134     *a->innrec = FTELL (p->ufd) / p->url + 1;
 135   if (a->inblank && p != NULL && p->ufmt)
 136     {
 137       if (p->ublnk)
 138         b_char ("ZERO", a->inblank, a->inblanklen);
 139       else
 140         b_char ("NULL", a->inblank, a->inblanklen);
 141     }
 142   return (0);
 143 }