lang/fortran/lib/libI77/due.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 integer s_rdue(a) cilist *a;
   4 {
   5         int n;
   6         if(n=c_due(a)) return(n);
   7         reading=1;
   8         if(curunit->uwrt && nowreading(curunit))
   9                 err(a->cierr,errno,"read start");
  10         return(0);
  11 }
  12 integer s_wdue(a) cilist *a;
  13 {
  14         int n;
  15         if(n=c_due(a)) return(n);
  16         reading=0;
  17         if(curunit->uwrt != 1 && nowwriting(curunit))
  18                 err(a->cierr,errno,"write start");
  19         return(0);
  20 }
  21 c_due(a) cilist *a;
  22 {
  23         if(!init) f_init();
  24         if(a->ciunit>=MXUNIT || a->ciunit<0)
  25                 err(a->cierr,101,"startio");
  26         recpos=sequential=formatted=0;
  27         external=1;
  28         curunit = &units[a->ciunit];
  29         elist=a;
  30         if(curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
  31         cf=curunit->ufd;
  32         if(curunit->ufmt) err(a->cierr,102,"cdue")
  33         if(!curunit->useek) err(a->cierr,104,"cdue")
  34         if(curunit->ufd==NULL) err(a->cierr,114,"cdue")
  35         (void) fseek(cf,(long)(a->cirec-1)*curunit->url,SEEK_SET);
  36         curunit->uend = 0;
  37         return(0);
  38 }
  39 integer e_rdue()
  40 {
  41         if(curunit->url==1 || recpos==curunit->url)
  42                 return(0);
  43         (void) fseek(cf,(long)(curunit->url-recpos),SEEK_CUR);
  44         if(ftell(cf)%curunit->url)
  45                 err(elist->cierr,200,"syserr");
  46         return(0);
  47 }
  48 integer e_wdue()
  49 {
  50         return(e_rdue());
  51 }