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 | }
|
---|