6 extern icilist *f__svic;
10 mv_cur (void) /* shouldn't use fseek because it insists on calling fflush */
11 /* instead we know too much about stdio */
13 int cursor = f__cursor;
19 if (f__hiwater < f__recpos)
20 f__hiwater = f__recpos;
24 err (f__elist->cierr, 110, "left off");
28 if (f__recpos + cursor >= f__svic->icirlen)
29 err (f__elist->cierr, 110, "recend");
30 if (f__hiwater <= f__recpos)
31 for (; cursor > 0; cursor--)
33 else if (f__hiwater <= f__recpos + cursor)
35 cursor -= f__hiwater - f__recpos;
36 f__icptr += f__hiwater - f__recpos;
37 f__recpos = f__hiwater;
38 for (; cursor > 0; cursor--)
51 if (f__hiwater <= f__recpos)
52 for (; cursor > 0; cursor--)
54 else if (f__hiwater <= f__recpos + cursor)
56 cursor -= f__hiwater - f__recpos;
57 f__recpos = f__hiwater;
58 for (; cursor > 0; cursor--)
68 if (cursor + f__recpos < 0)
69 err (f__elist->cierr, 110, "left off");
70 if (f__hiwater < f__recpos)
71 f__hiwater = f__recpos;
78 wrt_Z (Uint * n, int w, int minlen, ftnlen len)
80 register char *s, *se;
83 static char hex[] = "0123456789ABCDEF";
101 w1 = (i * (se - s) << 1) + 1;
105 for (i = 0; i < w; i++)
109 if ((minlen -= w1) > 0)
113 while (--minlen >= 0)
117 (*f__putn) (hex[*s & 0xf]);
124 (*f__putn) (hex[*s >> 4 & 0xf]);
125 (*f__putn) (hex[*s & 0xf]);
134 wrt_I (Uint * n, int w, ftnlen len, register int base)
136 int ndigit, sign, spare, i;
139 if (len == sizeof (integer))
141 else if (len == sizeof (char))
144 else if (len == sizeof (longint))
149 ans = f__icvt (x, &ndigit, &sign, base);
151 if (sign || f__cplus)
154 for (i = 0; i < w; i++)
158 for (i = 0; i < spare; i++)
164 for (i = 0; i < ndigit; i++)
170 wrt_IM (Uint * n, int w, int m, ftnlen len, int base)
172 int ndigit, sign, spare, i, xsign;
175 if (sizeof (integer) == len)
177 else if (len == sizeof (char))
180 else if (len == sizeof (longint))
185 ans = f__icvt (x, &ndigit, &sign, base);
186 if (sign || f__cplus)
190 if (ndigit + xsign > w || m + xsign > w)
192 for (i = 0; i < w; i++)
196 if (x == 0 && m == 0)
198 for (i = 0; i < w; i++)
203 spare = w - ndigit - xsign;
205 spare = w - m - xsign;
206 for (i = 0; i < spare; i++)
212 for (i = 0; i < m - ndigit; i++)
214 for (i = 0; i < ndigit; i++)
224 if (f__cursor && (i = mv_cur ()))
231 else if (*++s == quote)
239 wrt_H (int a, char *s)
243 if (f__cursor && (i = mv_cur ()))
251 wrt_L (Uint * n, int len, ftnlen sz)
256 if (sizeof (longint) == sz)
260 if (sizeof (short ) == sz)
262 else if (sizeof (char) == sz)
264 else if (sizeof (integer) == sz)
267 for (i = 0; i < len - 1; i++)
276 wrt_A (char *p, ftnlen len)
283 wrt_AW (char *p, int w, ftnlen len)
296 wrt_G (ufloat * p, int w, int d, int e, ftnlen len)
299 int i = 0, oldscale, n, j;
300 x = len == sizeof (real) ? p->pf : p->pd;
306 return (wrt_E (p, w, d, e, len));
310 for (; i <= d; i++, up *= 10)
321 i = wrt_F (p, w - n, d - i, len);
322 for (j = 0; j < n; j++)
327 return (wrt_E (p, w, d, e, len));
331 w_ed (struct syl * p, char *ptr, ftnlen len)
335 if (f__cursor && (i = mv_cur ()))
340 fprintf (stderr, "w_ed, unexpected code: %d\n", p->op);
341 sig_die (f__fmtbuf, 1);
343 return (wrt_I ((Uint *) ptr, p->p1, len, 10));
345 return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 10));
347 /* O and OM don't work right for character, double, complex, */
348 /* or doublecomplex, and they differ from Fortran 90 in */
349 /* showing a minus sign for negative values. */
352 return (wrt_I ((Uint *) ptr, p->p1, len, 8));
354 return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 8));
356 return (wrt_L ((Uint *) ptr, p->p1, len));
358 return (wrt_A (ptr, len));
360 return (wrt_AW (ptr, p->p1, len));
364 return (wrt_E ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len));
367 return (wrt_G ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len));
369 return (wrt_F ((ufloat *) ptr, p->p1, p->p2.i[0], len));
371 /* Z and ZM assume 8-bit bytes. */
374 return (wrt_Z ((Uint *) ptr, p->p1, 0, len));
376 return (wrt_Z ((Uint *) ptr, p->p1, p->p2.i[0], len));
381 w_ned (struct syl * p)
386 fprintf (stderr, "w_ned, unexpected code: %d\n", p->op);
387 sig_die (f__fmtbuf, 1);
389 return ((*f__donewrec) ());
391 f__cursor = p->p1 - f__recpos - 1;
395 if (f__cursor < -f__recpos) /* TL1000, 1X */
396 f__cursor = -f__recpos;
403 return (wrt_AP (p->p2.s));
405 return (wrt_H (p->p1, p->p2.s));