5 extern icilist *f__svic;
9 mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */
10 /* instead we know too much about stdio */
12 int cursor = f__cursor;
14 if(f__external == 0) {
16 if(f__hiwater < f__recpos)
17 f__hiwater = f__recpos;
21 err(f__elist->cierr, 110, "left off");
24 if(f__recpos + cursor >= f__svic->icirlen)
25 err(f__elist->cierr, 110, "recend");
26 if(f__hiwater <= f__recpos)
27 for(; cursor > 0; cursor--)
29 else if(f__hiwater <= f__recpos + cursor) {
30 cursor -= f__hiwater - f__recpos;
31 f__icptr += f__hiwater - f__recpos;
32 f__recpos = f__hiwater;
33 for(; cursor > 0; cursor--)
44 if(f__hiwater <= f__recpos)
45 for(;cursor>0;cursor--) (*f__putn)(' ');
46 else if(f__hiwater <= f__recpos + cursor) {
47 #if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
48 if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
49 f__cf->_ptr += f__hiwater - f__recpos;
52 (void) fseek(f__cf, (long) (f__hiwater - f__recpos), SEEK_CUR);
53 cursor -= f__hiwater - f__recpos;
54 f__recpos = f__hiwater;
55 for(; cursor > 0; cursor--)
59 #if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
60 if(f__cf->_ptr + cursor < buf_end(f__cf))
61 f__cf->_ptr += cursor;
64 (void) fseek(f__cf, (long)cursor, SEEK_CUR);
70 if(cursor+f__recpos<0) err(f__elist->cierr,110,"left off");
71 #if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
72 if(f__cf->_ptr + cursor >= f__cf->_base)
73 f__cf->_ptr += cursor;
76 if(f__curunit && f__curunit->useek)
77 (void) fseek(f__cf,(long)cursor,SEEK_CUR);
79 err(f__elist->cierr,106,"fmt");
80 if(f__hiwater < f__recpos)
81 f__hiwater = f__recpos;
89 wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len;
91 wrt_Z(Uint *n, int w, int minlen, ftnlen len)
94 register char *s, *se;
97 static char hex[] = "0123456789ABCDEF";
113 w1 = (i*(se-s) << 1) + 1;
117 for(i = 0; i < w; i++)
120 if ((minlen -= w1) > 0)
127 (*f__putn)(hex[*s & 0xf]);
133 (*f__putn)(hex[*s >> 4 & 0xf]);
134 (*f__putn)(hex[*s & 0xf]);
144 wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base;
146 wrt_I(Uint *n, int w, ftnlen len, register int base)
148 { int ndigit,sign,spare,i;
151 if(len==sizeof(integer)) x=n->il;
152 else if(len == sizeof(char)) x = n->ic;
154 else if (len == sizeof(longint)) x = n->ili;
157 ans=f__icvt(x,&ndigit,&sign, base);
159 if(sign || f__cplus) spare--;
161 for(i=0;i<w;i++) (*f__putn)('*');
163 { for(i=0;i<spare;i++) (*f__putn)(' ');
164 if(sign) (*f__putn)('-');
165 else if(f__cplus) (*f__putn)('+');
166 for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
172 wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base;
174 wrt_IM(Uint *n, int w, int m, ftnlen len, int base)
176 { int ndigit,sign,spare,i,xsign;
179 if(sizeof(integer)==len) x=n->il;
180 else if(len == sizeof(char)) x = n->ic;
182 else if (len == sizeof(longint)) x = n->ili;
185 ans=f__icvt(x,&ndigit,&sign, base);
186 if(sign || f__cplus) xsign=1;
188 if(ndigit+xsign>w || m+xsign>w)
189 { for(i=0;i<w;i++) (*f__putn)('*');
193 { for(i=0;i<w;i++) (*f__putn)(' ');
197 spare=w-ndigit-xsign;
200 for(i=0;i<spare;i++) (*f__putn)(' ');
201 if(sign) (*f__putn)('-');
202 else if(f__cplus) (*f__putn)('+');
203 for(i=0;i<m-ndigit;i++) (*f__putn)('0');
204 for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
216 if(f__cursor && (i = mv_cur()))
220 { if(*s!=quote) (*f__putn)(*s);
221 else if(*++s==quote) (*f__putn)(*s);
230 wrt_H(int a, char *s)
235 if(f__cursor && (i = mv_cur()))
237 while(a--) (*f__putn)(*s++);
241 wrt_L(n,len, sz) Uint *n; ftnlen sz;
243 wrt_L(Uint *n, int len, ftnlen sz)
247 if(sizeof(long)==sz) x=n->il;
248 else if(sz == sizeof(char)) x = n->ic;
252 if(x) (*f__putn)('T');
253 else (*f__putn)('F');
258 wrt_A(p,len) char *p; ftnlen len;
260 wrt_A(char *p, ftnlen len)
263 while(len-- > 0) (*f__putn)(*p++);
268 wrt_AW(p,w,len) char * p; ftnlen len;
270 wrt_AW(char * p, int w, ftnlen len)
284 wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
286 wrt_G(ufloat *p, int w, int d, int e, ftnlen len)
289 int i=0,oldscale,n,j;
290 x = len==sizeof(real)?p->pf:p->pd;
294 return(wrt_E(p,w,d,e,len));
298 for(;i<=d;i++,up*=10)
299 { if(x>=up) continue;
305 i=wrt_F(p,w-n,d-i,len);
306 for(j=0;j<n;j++) (*f__putn)(' ');
310 return(wrt_E(p,w,d,e,len));
313 w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
315 w_ed(struct syl *p, char *ptr, ftnlen len)
320 if(f__cursor && (i = mv_cur()))
325 fprintf(stderr,"w_ed, unexpected code: %d\n", p->op);
326 sig_die(f__fmtbuf, 1);
327 case I: return(wrt_I((Uint *)ptr,p->p1,len, 10));
329 return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10));
331 /* O and OM don't work right for character, double, complex, */
332 /* or doublecomplex, and they differ from Fortran 90 in */
333 /* showing a minus sign for negative values. */
335 case O: return(wrt_I((Uint *)ptr, p->p1, len, 8));
337 return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8));
338 case L: return(wrt_L((Uint *)ptr,p->p1, len));
339 case A: return(wrt_A(ptr,len));
341 return(wrt_AW(ptr,p->p1,len));
345 return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
348 return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
349 case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len));
351 /* Z and ZM assume 8-bit bytes. */
353 case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len));
355 return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len));
359 w_ned(p) struct syl *p;
366 default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op);
367 sig_die(f__fmtbuf, 1);
369 return((*f__donewrec)());
370 case T: f__cursor = p->p1-f__recpos - 1;
372 case TL: f__cursor -= p->p1;
373 if(f__cursor < -f__recpos) /* TL1000, 1X */
374 f__cursor = -f__recpos;
381 return(wrt_AP(p->p2.s));
383 return(wrt_H(p->p1,p->p2.s));