contrib/libf2c/libI77/iio.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #include "fmt.h"
   4 extern char *f__icptr;
   5 char *f__icend;
   6 extern icilist *f__svic;
   7 int f__icnum;
   8 extern int f__hiwater;
   9 z_getc(Void)
  10 {
  11         if(f__recpos++ < f__svic->icirlen) {
  12                 if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile");
  13                 return(*(unsigned char *)f__icptr++);
  14                 }
  15         return '\n';
  16 }
  17
  18  void
  19 #ifdef KR_headers
  20 z_putc(c)
  21 #else
  22 z_putc(int c)
  23 #endif
  24 {
  25         if (f__icptr < f__icend && f__recpos++ < f__svic->icirlen)
  26                 *f__icptr++ = c;
  27 }
  28 z_rnew(Void)
  29 {
  30         f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen;
  31         f__recpos = 0;
  32         f__cursor = 0;
  33         f__hiwater = 0;
  34         return 1;
  35 }
  36
  37  static int
  38 z_endp(Void)
  39 {
  40         (*f__donewrec)();
  41         return 0;
  42         }
  43
  44 #ifdef KR_headers
  45 c_si(a) icilist *a;
  46 #else
  47 c_si(icilist *a)
  48 #endif
  49 {
  50         if (f__init & 2)
  51                 f__fatal (131, "I/O recursion");
  52         f__init |= 2;
  53         f__elist = (cilist *)a;
  54         f__fmtbuf=a->icifmt;
  55         f__curunit = 0;
  56         f__sequential=f__formatted=1;
  57         f__external=0;
  58         if(pars_f(f__fmtbuf)<0)
  59                 err(a->icierr,100,"startint");
  60         fmt_bg();
  61         f__cblank=f__cplus=f__scale=0;
  62         f__svic=a;
  63         f__icnum=f__recpos=0;
  64         f__cursor = 0;
  65         f__hiwater = 0;
  66         f__icptr = a->iciunit;
  67         f__icend = f__icptr + a->icirlen*a->icirnum;
  68         f__cf = 0;
  69         return(0);
  70 }
  71
  72  int
  73 iw_rev(Void)
  74 {
  75         if(f__workdone)
  76                 z_endp();
  77         f__hiwater = f__recpos = f__cursor = 0;
  78         return(f__workdone=0);
  79         }
  80
  81 #ifdef KR_headers
  82 integer s_rsfi(a) icilist *a;
  83 #else
  84 integer s_rsfi(icilist *a)
  85 #endif
  86 {       int n;
  87         if(n=c_si(a)) return(n);
  88         f__reading=1;
  89         f__doed=rd_ed;
  90         f__doned=rd_ned;
  91         f__getn=z_getc;
  92         f__dorevert = z_endp;
  93         f__donewrec = z_rnew;
  94         f__doend = z_endp;
  95         return(0);
  96 }
  97
  98 z_wnew(Void)
  99 {
 100         if (f__recpos < f__hiwater) {
 101                 f__icptr += f__hiwater - f__recpos;
 102                 f__recpos = f__hiwater;
 103                 }
 104         while(f__recpos++ < f__svic->icirlen)
 105                 *f__icptr++ = ' ';
 106         f__recpos = 0;
 107         f__cursor = 0;
 108         f__hiwater = 0;
 109         f__icnum++;
 110         return 1;
 111 }
 112 #ifdef KR_headers
 113 integer s_wsfi(a) icilist *a;
 114 #else
 115 integer s_wsfi(icilist *a)
 116 #endif
 117 {       int n;
 118         if(n=c_si(a)) return(n);
 119         f__reading=0;
 120         f__doed=w_ed;
 121         f__doned=w_ned;
 122         f__putn=z_putc;
 123         f__dorevert = iw_rev;
 124         f__donewrec = z_wnew;
 125         f__doend = z_endp;
 126         return(0);
 127 }
 128 integer e_rsfi(Void)
 129 {       int n;
 130         f__init &= ~2;
 131         n = en_fio();
 132         f__fmtbuf = NULL;
 133         return(n);
 134 }
 135 integer e_wsfi(Void)
 136 {
 137         int n;
 138         f__init &= ~2;
 139         n = en_fio();
 140         f__fmtbuf = NULL;
 141         if(f__svic->icirnum != 1
 142          && (f__icnum >  f__svic->icirnum
 143          || (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater))))
 144                 err(f__svic->icierr,110,"inwrite");
 145         if (f__recpos < f__hiwater)
 146                 f__recpos = f__hiwater;
 147         if (f__recpos >= f__svic->icirlen)
 148                 err(f__svic->icierr,110,"recend");
 149         if (!f__recpos && f__icnum)
 150                 return n;
 151         while(f__recpos++ < f__svic->icirlen)
 152                 *f__icptr++ = ' ';
 153         return n;
 154 }