lang/fortran/lib/libI77/rsli.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #include "lio.h"
   4
   5 extern flag lquit;
   6 extern int lcount;
   7 extern int l_read();
   8 extern char *icptr;
   9 extern char *icend;
  10 extern icilist *svic;
  11 extern int icnum, recpos;
  12 extern int (*l_getc)(), (*l_ungetc)();
  13
  14 int i_getc()
  15 {
  16         if(++recpos >= svic->icirlen) {
  17                 if (recpos == svic->icirlen)
  18                         return '\n';
  19                 z_rnew();
  20                 }
  21         if(icptr >= icend) err(svic->iciend,(EOF),"endfile");
  22         return(*icptr++);
  23         }
  24
  25 int i_ungetc(ch)
  26  int ch;
  27 {
  28         if (--recpos == svic->icirlen)
  29                 return '\n';
  30         if (recpos < -1)
  31                 err(svic->icierr,110,"recend");
  32         /* *--icptr == ch, and icptr may point to read-only memory */
  33         return *--icptr /* = ch */;
  34         }
  35
  36  static void
  37 c_lir(a)
  38  icilist *a;
  39 {
  40         extern int l_eof;
  41         reading = 1;
  42         external = 0;
  43         formatted = 1;
  44         svic = a;
  45         L_len = a->icirlen;
  46         recpos = -1;
  47         icnum = recpos = 0;
  48         cursor = 0;
  49         l_getc = i_getc;
  50         l_ungetc = i_ungetc;
  51         l_eof = 0;
  52         icptr = a->iciunit;
  53         icend = icptr + a->icirlen*a->icirnum;
  54         cf = 0;
  55         curunit = 0;
  56         }
  57
  58
  59 integer s_rsli(a) icilist *a;
  60 {
  61         lioproc = l_read;
  62         lquit = 0;
  63         lcount = 0;
  64         c_lir(a);
  65         return(0);
  66         }
  67
  68 integer e_rsli()
  69 { return 0; }
  70
  71 s_rsni(a)
  72  icilist *a;
  73 {
  74         cilist ca;
  75         ca.ciend = a->iciend;
  76         ca.cierr = a->icierr;
  77         ca.cifmt = a->icifmt;
  78         c_lir(a);
  79         return x_rsne(&ca);
  80         }