2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / libf2c / libI77 / iio.c
blob940cbf82f91c56d02601aee62a0a8668064fdb8f
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 int
10 z_getc (void)
12 if (f__recpos++ < f__svic->icirlen)
14 if (f__icptr >= f__icend)
15 err (f__svic->iciend, (EOF), "endfile");
16 return (*(unsigned char *) f__icptr++);
18 return '\n';
21 void
22 z_putc (int c)
24 if (f__recpos++ < f__svic->icirlen && f__icptr < f__icend)
25 *f__icptr++ = c;
27 int
28 z_rnew (void)
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;
37 static int
38 z_endp (void)
40 (*f__donewrec) ();
41 return 0;
44 int
45 c_si (icilist * a)
47 if (f__init & 2)
48 f__fatal (131, "I/O recursion");
49 f__init |= 2;
50 f__elist = (cilist *) a;
51 f__fmtbuf = a->icifmt;
52 f__curunit = 0;
53 f__sequential = f__formatted = 1;
54 f__external = 0;
55 if (pars_f (f__fmtbuf) < 0)
56 err (a->icierr, 100, "startint");
57 fmt_bg ();
58 f__cblank = f__cplus = f__scale = 0;
59 f__svic = a;
60 f__icnum = f__recpos = 0;
61 f__cursor = 0;
62 f__hiwater = 0;
63 f__icptr = a->iciunit;
64 f__icend = f__icptr + a->icirlen * a->icirnum;
65 f__cf = 0;
66 return (0);
69 int
70 iw_rev (void)
72 if (f__workdone)
73 z_endp ();
74 f__hiwater = f__recpos = f__cursor = 0;
75 return (f__workdone = 0);
78 integer
79 s_rsfi (icilist * a)
81 int n;
82 if ((n = c_si (a)))
83 return (n);
84 f__reading = 1;
85 f__doed = rd_ed;
86 f__doned = rd_ned;
87 f__getn = z_getc;
88 f__dorevert = z_endp;
89 f__donewrec = z_rnew;
90 f__doend = z_endp;
91 return (0);
94 int
95 z_wnew (void)
97 if (f__recpos < f__hiwater)
99 f__icptr += f__hiwater - f__recpos;
100 f__recpos = f__hiwater;
102 while (f__recpos++ < f__svic->icirlen)
103 *f__icptr++ = ' ';
104 f__recpos = 0;
105 f__cursor = 0;
106 f__hiwater = 0;
107 f__icnum++;
108 return 1;
111 integer
112 s_wsfi (icilist * a)
114 int n;
115 if ((n = c_si (a)))
116 return (n);
117 f__reading = 0;
118 f__doed = w_ed;
119 f__doned = w_ned;
120 f__putn = z_putc;
121 f__dorevert = iw_rev;
122 f__donewrec = z_wnew;
123 f__doend = z_endp;
124 return (0);
127 integer
128 e_rsfi (void)
130 int n;
131 f__init &= ~2;
132 n = en_fio ();
133 f__fmtbuf = NULL;
134 return (n);
137 integer
138 e_wsfi (void)
140 int n;
141 f__init &= ~2;
142 n = en_fio ();
143 f__fmtbuf = NULL;
144 if (f__svic->icirnum != 1
145 && (f__icnum > f__svic->icirnum
146 || (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater))))
147 err (f__svic->icierr, 110, "inwrite");
148 if (f__recpos < f__hiwater)
149 f__recpos = f__hiwater;
150 if (f__recpos >= f__svic->icirlen)
151 err (f__svic->icierr, 110, "recend");
152 if (!f__recpos && f__icnum)
153 return n;
154 while (f__recpos++ < f__svic->icirlen)
155 *f__icptr++ = ' ';
156 return n;