lang/fortran/lib/libI77/iio.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #include "fmt.h"
   4 extern char *icptr;
   5 char *icend;
   6 extern icilist *svic;
   7 extern int rd_ed(),rd_ned(),w_ed(),w_ned(),y_ierr();
   8 extern int z_wnew();
   9 int icnum;
  10 extern int hiwater;
  11 z_getc()
  12 {
  13         if(icptr >= icend) err(svic->iciend,(EOF),"endfile");
  14         if(recpos++ < svic->icirlen)
  15                 return(*icptr++);
  16         else    err(svic->icierr,110,"recend");
  17 }
  18 z_putc(c)
  19 {
  20         if(icptr >= icend) err(svic->icierr,110,"inwrite");
  21         if(recpos++ < svic->icirlen)
  22                 *icptr++ = c;
  23         else    err(svic->icierr,110,"recend");
  24         return 0;
  25 }
  26 z_rnew()
  27 {
  28         icptr = svic->iciunit + (++icnum)*svic->icirlen;
  29         recpos = 0;
  30         cursor = 0;
  31         hiwater = 0;
  32         return 1;
  33 }
  34
  35  static int
  36 z_endp(a) icilist *a;
  37 {
  38         (*donewrec)();
  39         return 0;
  40         }
  41
  42 integer s_rsfi(a) icilist *a;
  43 {       int n;
  44         if(n=c_si(a)) return(n);
  45         reading=1;
  46         doed=rd_ed;
  47         doned=rd_ned;
  48         getn=z_getc;
  49         dorevert = y_ierr;
  50         donewrec = z_rnew;
  51         doend = z_endp;
  52         return(0);
  53 }
  54
  55 integer s_wsfi(a) icilist *a;
  56 {       int n;
  57         if(n=c_si(a)) return(n);
  58         reading=0;
  59         doed=w_ed;
  60         doned=w_ned;
  61         putn=z_putc;
  62         dorevert = y_ierr;
  63         donewrec = z_wnew;
  64         doend = z_endp;
  65         return(0);
  66 }
  67 c_si(a) icilist *a;
  68 {
  69         elist = (cilist *)a;
  70         fmtbuf=a->icifmt;
  71         if(pars_f(fmtbuf)<0)
  72                 err(a->icierr,100,"startint");
  73         fmt_bg();
  74         sequential=formatted=1;
  75         external=0;
  76         cblank=cplus=scale=0;
  77         svic=a;
  78         icnum=recpos=0;
  79         cursor = 0;
  80         hiwater = 0;
  81         icptr = a->iciunit;
  82         icend = icptr + a->icirlen*a->icirnum;
  83         curunit = 0;
  84         return(0);
  85 }
  86 z_wnew()
  87 {
  88         while(recpos++ < svic->icirlen)
  89                 *icptr++ = ' ';
  90         recpos = 0;
  91         cursor = 0;
  92         hiwater = 0;
  93         icnum++;
  94         return 1;
  95 }
  96 integer e_rsfi()
  97 {       int n;
  98         n = en_fio();
  99         fmtbuf = NULL;
 100         return(n);
 101 }
 102 integer e_wsfi()
 103 {
 104         int n;
 105         n = en_fio();
 106         fmtbuf = NULL;
 107         if(icnum >= svic->icirnum)
 108                 return(n);
 109         while(recpos++ < svic->icirlen)
 110                 *icptr++ = ' ';
 111         return(n);
 112 }
 113 y_ierr()
 114 {
 115         err(elist->cierr, 110, "iio");
 116 }