contrib/libf2c/libI77/due.c

   1 #include "config.h"
   2 #include "f2c.h"
   3 #include "fio.h"
   4
   5 int
   6 c_due (cilist * a)
   7 {
   8   if (f__init != 1)
   9     f_init ();
  10   f__init = 3;
  11   if (a->ciunit >= MXUNIT || a->ciunit < 0)
  12     err (a->cierr, 101, "startio");
  13   f__sequential = f__formatted = f__recpos = 0;
  14   f__external = 1;
  15   f__curunit = &f__units[a->ciunit];
  16   if (a->ciunit >= MXUNIT || a->ciunit < 0)
  17     err (a->cierr, 101, "startio");
  18   f__elist = a;
  19   if (f__curunit->ufd == NULL && fk_open (DIR, UNF, a->ciunit))
  20     err (a->cierr, 104, "due");
  21   f__cf = f__curunit->ufd;
  22   if (f__curunit->ufmt)
  23     err (a->cierr, 102, "cdue");
  24   if (!f__curunit->useek)
  25     err (a->cierr, 104, "cdue");
  26   if (f__curunit->ufd == NULL)
  27     err (a->cierr, 114, "cdue");
  28   if (a->cirec <= 0)
  29     err (a->cierr, 130, "due");
  30   FSEEK (f__cf, (off_t) (a->cirec - 1) * f__curunit->url, SEEK_SET);
  31   f__curunit->uend = 0;
  32   return (0);
  33 }
  34
  35 integer
  36 s_rdue (cilist * a)
  37 {
  38   int n;
  39   f__reading = 1;
  40   if ((n = c_due (a)))
  41     return (n);
  42   if (f__curunit->uwrt && f__nowreading (f__curunit))
  43     err (a->cierr, errno, "read start");
  44   return (0);
  45 }
  46
  47 integer
  48 s_wdue (cilist * a)
  49 {
  50   int n;
  51   f__reading = 0;
  52   if ((n = c_due (a)))
  53     return (n);
  54   if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
  55     err (a->cierr, errno, "write start");
  56   return (0);
  57 }
  58
  59 integer
  60 e_rdue (void)
  61 {
  62   f__init = 1;
  63   if (f__curunit->url == 1 || f__recpos == f__curunit->url)
  64     return (0);
  65   FSEEK (f__cf, (off_t) (f__curunit->url - f__recpos), SEEK_CUR);
  66   if (FTELL (f__cf) % f__curunit->url)
  67     err (f__elist->cierr, 200, "syserr");
  68   return (0);
  69 }
  70
  71 integer
  72 e_wdue (void)
  73 {
  74   f__init = 1;
  75 #ifdef ALWAYS_FLUSH
  76   if (fflush (f__cf))
  77     err (f__elist->cierr, errno, "write end");
  78 #endif
  79   return (e_rdue ());
  80 }