contrib/gcc-3.4/libf2c/libI77/sue.c

   1 #include "config.h"
   2 #include "f2c.h"
   3 #include "fio.h"
   4 extern uiolen f__reclen;
   5 off_t f__recloc;
   6
   7 int
   8 c_sue (cilist * a)
   9 {
  10   f__external = f__sequential = 1;
  11   f__formatted = 0;
  12   f__curunit = &f__units[a->ciunit];
  13   if (a->ciunit >= MXUNIT || a->ciunit < 0)
  14     err (a->cierr, 101, "startio");
  15   f__elist = a;
  16   if (f__curunit->ufd == NULL && fk_open (SEQ, UNF, a->ciunit))
  17     err (a->cierr, 114, "sue");
  18   f__cf = f__curunit->ufd;
  19   if (f__curunit->ufmt)
  20     err (a->cierr, 103, "sue");
  21   if (!f__curunit->useek)
  22     err (a->cierr, 103, "sue");
  23   return (0);
  24 }
  25
  26 integer
  27 s_rsue (cilist * a)
  28 {
  29   int n;
  30   if (f__init != 1)
  31     f_init ();
  32   f__init = 3;
  33   f__reading = 1;
  34   if ((n = c_sue (a)))
  35     return (n);
  36   f__recpos = 0;
  37   if (f__curunit->uwrt && f__nowreading (f__curunit))
  38     err (a->cierr, errno, "read start");
  39   if (fread ((char *) &f__reclen, sizeof (uiolen), 1, f__cf) != 1)
  40     {
  41       if (feof (f__cf))
  42         {
  43           f__curunit->uend = 1;
  44           err (a->ciend, EOF, "start");
  45         }
  46       clearerr (f__cf);
  47       err (a->cierr, errno, "start");
  48     }
  49   return (0);
  50 }
  51
  52 integer
  53 s_wsue (cilist * a)
  54 {
  55   int n;
  56   if (f__init != 1)
  57     f_init ();
  58   f__init = 3;
  59   if ((n = c_sue (a)))
  60     return (n);
  61   f__reading = 0;
  62   f__reclen = 0;
  63   if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
  64     err (a->cierr, errno, "write start");
  65   f__recloc = FTELL (f__cf);
  66   FSEEK (f__cf, (off_t) sizeof (uiolen), SEEK_CUR);
  67   return (0);
  68 }
  69
  70 integer
  71 e_wsue (void)
  72 {
  73   off_t loc;
  74   f__init = 1;
  75   fwrite ((char *) &f__reclen, sizeof (uiolen), 1, f__cf);
  76 #ifdef ALWAYS_FLUSH
  77   if (fflush (f__cf))
  78     err (f__elist->cierr, errno, "write end");
  79 #endif
  80   loc = FTELL (f__cf);
  81   FSEEK (f__cf, f__recloc, SEEK_SET);
  82   fwrite ((char *) &f__reclen, sizeof (uiolen), 1, f__cf);
  83   FSEEK (f__cf, loc, SEEK_SET);
  84   return (0);
  85 }
  86
  87 integer
  88 e_rsue (void)
  89 {
  90   f__init = 1;
  91   FSEEK (f__cf, (off_t) (f__reclen - f__recpos + sizeof (uiolen)), SEEK_CUR);
  92   return (0);
  93 }