contrib/gcc-3.4/libf2c/libI77/rsli.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #include "lio.h"
   4 #include "fmt.h"                /* for f__doend */
   5
   6 extern flag f__lquit;
   7 extern int f__lcount;
   8 extern char *f__icptr;
   9 extern char *f__icend;
  10 extern icilist *f__svic;
  11 extern int f__icnum, f__recpos;
  12
  13 static int
  14 i_getc (void)
  15 {
  16   if (f__recpos >= f__svic->icirlen)
  17     {
  18       if (f__recpos++ == f__svic->icirlen)
  19         return '\n';
  20       z_rnew ();
  21     }
  22   f__recpos++;
  23   if (f__icptr >= f__icend)
  24     return EOF;
  25   return (*f__icptr++);
  26 }
  27
  28 static int
  29 i_ungetc (int ch __attribute__ ((__unused__)),
  30           FILE * f __attribute__ ((__unused__)))
  31 {
  32   if (--f__recpos == f__svic->icirlen)
  33     return '\n';
  34   if (f__recpos < -1)
  35     err (f__svic->icierr, 110, "recend");
  36   /* *--icptr == ch, and icptr may point to read-only memory */
  37   return *--f__icptr /* = ch */ ;
  38 }
  39
  40 static void
  41 c_lir (icilist * a)
  42 {
  43   extern int l_eof;
  44   if (f__init != 1)
  45     f_init ();
  46   f__init = 3;
  47   f__reading = 1;
  48   f__external = 0;
  49   f__formatted = 1;
  50   f__svic = a;
  51   L_len = a->icirlen;
  52   f__recpos = -1;
  53   f__icnum = f__recpos = 0;
  54   f__cursor = 0;
  55   l_getc = i_getc;
  56   l_ungetc = i_ungetc;
  57   l_eof = 0;
  58   f__icptr = a->iciunit;
  59   f__icend = f__icptr + a->icirlen * a->icirnum;
  60   f__cf = 0;
  61   f__curunit = 0;
  62   f__elist = (cilist *) a;
  63 }
  64
  65
  66 integer
  67 s_rsli (icilist * a)
  68 {
  69   f__lioproc = l_read;
  70   f__lquit = 0;
  71   f__lcount = 0;
  72   c_lir (a);
  73   f__doend = 0;
  74   return (0);
  75 }
  76
  77 integer
  78 e_rsli (void)
  79 {
  80   f__init = 1;
  81   return 0;
  82 }
  83
  84 extern int x_rsne (cilist *);
  85
  86 integer
  87 s_rsni (icilist * a)
  88 {
  89   extern int nml_read;
  90   integer rv;
  91   cilist ca;
  92   ca.ciend = a->iciend;
  93   ca.cierr = a->icierr;
  94   ca.cifmt = a->icifmt;
  95   c_lir (a);
  96   rv = x_rsne (&ca);
  97   nml_read = 0;
  98   return rv;
  99 }