lang/fortran/lib/libI77/dfe.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #include "fmt.h"
   4 extern int rd_ed(),rd_ned(),y_getc(),y_putc(),y_err();
   5 extern int y_rev(), y_rsk(), y_newrec();
   6 extern int w_ed(),w_ned();
   7 integer s_rdfe(a) cilist *a;
   8 {
   9         int n;
  10         if(!init) f_init();
  11         if(n=c_dfe(a))return(n);
  12         reading=1;
  13         if(curunit->uwrt && nowreading(curunit))
  14                 err(a->cierr,errno,"read start");
  15         getn = y_getc;
  16         doed = rd_ed;
  17         doned = rd_ned;
  18         dorevert = donewrec = y_err;
  19         doend = y_rsk;
  20         if(pars_f(fmtbuf)<0)
  21                 err(a->cierr,100,"read start");
  22         fmt_bg();
  23         return(0);
  24 }
  25 integer s_wdfe(a) cilist *a;
  26 {
  27         int n;
  28         if(!init) f_init();
  29         if(n=c_dfe(a)) return(n);
  30         reading=0;
  31         if(curunit->uwrt != 1 && nowwriting(curunit))
  32                 err(a->cierr,errno,"startwrt");
  33         putn = y_putc;
  34         doed = w_ed;
  35         doned= w_ned;
  36         dorevert = y_err;
  37         donewrec = y_newrec;
  38         doend = y_rev;
  39         if(pars_f(fmtbuf)<0)
  40                 err(a->cierr,100,"startwrt");
  41         fmt_bg();
  42         return(0);
  43 }
  44 integer e_rdfe()
  45 {
  46         (void) en_fio();
  47         return(0);
  48 }
  49 integer e_wdfe()
  50 {
  51         (void) en_fio();
  52         return(0);
  53 }
  54 c_dfe(a) cilist *a;
  55 {
  56         sequential=0;
  57         formatted=external=1;
  58         elist=a;
  59         cursor=scale=recpos=0;
  60         if(a->ciunit>MXUNIT || a->ciunit<0)
  61                 err(a->cierr,101,"startchk");
  62         curunit = &units[a->ciunit];
  63         if(curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit))
  64                 err(a->cierr,104,"dfe");
  65         cf=curunit->ufd;
  66         if(!curunit->ufmt) err(a->cierr,102,"dfe")
  67         if(!curunit->useek) err(a->cierr,104,"dfe")
  68         fmtbuf=a->cifmt;
  69         (void) fseek(cf,(long)curunit->url * (a->cirec-1),SEEK_SET);
  70         curunit->uend = 0;
  71         return(0);
  72 }
  73 y_rsk()
  74 {
  75         if(curunit->uend || curunit->url <= recpos
  76                 || curunit->url == 1) return 0;
  77         do {
  78                 getc(cf);
  79         } while(++recpos < curunit->url);
  80         return 0;
  81 }
  82 y_getc()
  83 {
  84         int ch;
  85         if(curunit->uend) return(-1);
  86         if((ch=getc(cf))!=EOF)
  87         {
  88                 recpos++;
  89                 if(curunit->url>=recpos ||
  90                         curunit->url==1)
  91                         return(ch);
  92                 else    return(' ');
  93         }
  94         if(feof(cf))
  95         {
  96                 curunit->uend=1;
  97                 errno=0;
  98                 return(-1);
  99         }
 100         err(elist->cierr,errno,"readingd");
 101 }
 102 y_putc(c)
 103 {
 104         recpos++;
 105         if(recpos <= curunit->url || curunit->url==1)
 106                 putc(c,cf);
 107         else
 108                 err(elist->cierr,110,"dout");
 109         return(0);
 110 }
 111 y_rev()
 112 {       /*what about work done?*/
 113         if(curunit->url==1 || recpos==curunit->url)
 114                 return(0);
 115         while(recpos<curunit->url)
 116                 (*putn)(' ');
 117         recpos=0;
 118         return(0);
 119 }
 120 y_err()
 121 {
 122         err(elist->cierr, 110, "dfe");
 123 }
 124
 125 y_newrec()
 126 {
 127         if(curunit->url == 1 || recpos == curunit->url) {
 128                 hiwater = recpos = cursor = 0;
 129                 return(1);
 130         }
 131         if(hiwater > recpos)
 132                 recpos = hiwater;
 133         y_rev();
 134         hiwater = cursor = 0;
 135         return(1);
 136 }