lang/fortran/lib/libI77/sue.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 extern int reclen;
   4 long recloc;
   5
   6 integer s_rsue(a) cilist *a;
   7 {
   8         int n;
   9         if(!init) f_init();
  10         reading=1;
  11         if(n=c_sue(a)) return(n);
  12         recpos=0;
  13         if(curunit->uwrt && nowreading(curunit))
  14                 err(a->cierr, errno, "read start");
  15         if(fread((char *)&reclen,sizeof(int),1,cf)
  16                 != 1)
  17         {       if(feof(cf))
  18                 {       curunit->uend = 1;
  19                         err(a->ciend, EOF, "start");
  20                 }
  21                 clearerr(cf);
  22                 err(a->cierr, errno, "start");
  23         }
  24         return(0);
  25 }
  26 integer s_wsue(a) cilist *a;
  27 {
  28         int n;
  29         if(!init) f_init();
  30         if(n=c_sue(a)) return(n);
  31         reading=0;
  32         reclen=0;
  33         if(curunit->uwrt != 1 && nowwriting(curunit))
  34                 err(a->cierr, errno, "write start");
  35         recloc=ftell(cf);
  36         (void) fseek(cf,(long)sizeof(int),SEEK_CUR);
  37         return(0);
  38 }
  39 c_sue(a) cilist *a;
  40 {
  41         if(a->ciunit >= MXUNIT || a->ciunit < 0)
  42                 err(a->cierr,101,"startio");
  43         external=sequential=1;
  44         formatted=0;
  45         curunit = &units[a->ciunit];
  46         elist=a;
  47         if(curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit))
  48                 err(a->cierr,114,"sue");
  49         cf=curunit->ufd;
  50         if(curunit->ufmt) err(a->cierr,103,"sue")
  51         if(!curunit->useek) err(a->cierr,103,"sue")
  52         return(0);
  53 }
  54 integer e_wsue()
  55 {       long loc;
  56         (void) fwrite((char *)&reclen,sizeof(int),1,cf);
  57         loc=ftell(cf);
  58         (void) fseek(cf,recloc,SEEK_SET);
  59         (void) fwrite((char *)&reclen,sizeof(int),1,cf);
  60         (void) fseek(cf,loc,SEEK_SET);
  61         return(0);
  62 }
  63 integer e_rsue()
  64 {
  65         (void) fseek(cf,(long)(reclen-recpos+sizeof(int)),SEEK_CUR);
  66         return(0);
  67 }