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
));