contrib/libf2c/libI77/sue.c

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