extern char *f__icvt(long, int*, int*, int);
mv_cur(Void
) /* shouldn't use fseek because it insists on calling fflush */
/* instead we know too much about stdio */
if(f__hiwater
< f__recpos
)
err(f__elist
->cierr
, 110, "left off");
if(f__recpos
+ f__cursor
>= f__svic
->icirlen
)
err(f__elist
->cierr
, 110, "recend");
if(f__hiwater
<= f__recpos
)
for(; f__cursor
> 0; f__cursor
--)
else if(f__hiwater
<= f__recpos
+ f__cursor
) {
f__cursor
-= f__hiwater
- f__recpos
;
f__icptr
+= f__hiwater
- f__recpos
;
for(; f__cursor
> 0; f__cursor
--)
if(f__hiwater
<= f__recpos
)
for(;f__cursor
>0;f__cursor
--) (*f__putn
)(' ');
else if(f__hiwater
<= f__recpos
+ f__cursor
) {
if(f__cf
->_ptr
+ f__hiwater
- f__recpos
< buf_end(f__cf
))
f__cf
->_ptr
+= f__hiwater
- f__recpos
;
(void) fseek(f__cf
, (long) (f__hiwater
- f__recpos
), SEEK_CUR
);
f__cursor
-= f__hiwater
- f__recpos
;
for(; f__cursor
> 0; f__cursor
--)
if(f__cf
->_ptr
+ f__cursor
< buf_end(f__cf
))
f__cf
->_ptr
+= f__cursor
;
(void) fseek(f__cf
, (long)f__cursor
, SEEK_CUR
);
if(f__cursor
+f__recpos
<0) err(f__elist
->cierr
,110,"left off");
if(f__cf
->_ptr
+ f__cursor
>= f__cf
->_base
)
f__cf
->_ptr
+= f__cursor
;
if(f__curunit
&& f__curunit
->useek
)
(void) fseek(f__cf
,(long)f__cursor
,SEEK_CUR
);
err(f__elist
->cierr
,106,"fmt");
if(f__hiwater
< f__recpos
)
wrt_Z(n
,w
,minlen
,len
) Uint
*n
; int w
, minlen
; ftnlen len
;
wrt_Z(Uint
*n
, int w
, int minlen
, ftnlen len
)
static char hex
[] = "0123456789ABCDEF";
w1
= (i
*(se
-s
) << 1) + 1;
(*f__putn
)(hex
[*s
& 0xf]);
(*f__putn
)(hex
[*s
>> 4 & 0xf]);
(*f__putn
)(hex
[*s
& 0xf]);
wrt_I(n
,w
,len
, base
) Uint
*n
; ftnlen len
; register int base
;
wrt_I(Uint
*n
, int w
, ftnlen len
, register int base
)
{ int ndigit
,sign
,spare
,i
;
if(len
==sizeof(integer
)) x
=n
->il
;
else if(len
== sizeof(char)) x
= n
->ic
;
else if (len
== sizeof(longint
)) x
= n
->ili
;
ans
=f__icvt(x
,&ndigit
,&sign
, base
);
if(sign
|| f__cplus
) spare
--;
for(i
=0;i
<w
;i
++) (*f__putn
)('*');
{ for(i
=0;i
<spare
;i
++) (*f__putn
)(' ');
if(sign
) (*f__putn
)('-');
else if(f__cplus
) (*f__putn
)('+');
for(i
=0;i
<ndigit
;i
++) (*f__putn
)(*ans
++);
wrt_IM(n
,w
,m
,len
,base
) Uint
*n
; ftnlen len
; int base
;
wrt_IM(Uint
*n
, int w
, int m
, ftnlen len
, int base
)
{ int ndigit
,sign
,spare
,i
,xsign
;
if(sizeof(integer
)==len
) x
=n
->il
;
else if(len
== sizeof(char)) x
= n
->ic
;
ans
=f__icvt(x
,&ndigit
,&sign
, base
);
if(sign
|| f__cplus
) xsign
=1;
if(ndigit
+xsign
>w
|| m
+xsign
>w
)
{ for(i
=0;i
<w
;i
++) (*f__putn
)('*');
{ for(i
=0;i
<w
;i
++) (*f__putn
)(' ');
for(i
=0;i
<spare
;i
++) (*f__putn
)(' ');
if(sign
) (*f__putn
)('-');
else if(f__cplus
) (*f__putn
)('+');
for(i
=0;i
<m
-ndigit
;i
++) (*f__putn
)('0');
for(i
=0;i
<ndigit
;i
++) (*f__putn
)(*ans
++);
if(f__cursor
&& mv_cur()) return(mv_cur());
{ if(*s
!=quote
) (*f__putn
)(*s
);
else if(*++s
==quote
) (*f__putn
)(*s
);
if(f__cursor
&& mv_cur()) return(mv_cur());
while(a
--) (*f__putn
)(*s
++);
wrt_L(n
,len
, sz
) Uint
*n
; ftnlen sz
;
wrt_L(Uint
*n
, int len
, ftnlen sz
)
if(sizeof(long)==sz
) x
=n
->il
;
else if(sz
== sizeof(char)) x
= n
->ic
;
wrt_A(p
,len
) char *p
; ftnlen len
;
wrt_A(char *p
, ftnlen len
)
while(len
-- > 0) (*f__putn
)(*p
++);
wrt_AW(p
,w
,len
) char * p
; ftnlen len
;
wrt_AW(char * p
, int w
, ftnlen len
)
wrt_G(p
,w
,d
,e
,len
) ufloat
*p
; ftnlen len
;
wrt_G(ufloat
*p
, int w
, int d
, int e
, ftnlen len
)
int i
,oldscale
=f__scale
,n
,j
;
x
= len
==sizeof(real
)?p
->pf
:p
->pd
;
if(x
<.1) return(wrt_E(p
,w
,d
,e
,len
));
for(j
=0;j
<n
;j
++) (*f__putn
)(' ');
return(wrt_E(p
,w
,d
,e
,len
));
w_ed(p
,ptr
,len
) struct syl
*p
; char *ptr
; ftnlen len
;
w_ed(struct syl
*p
, char *ptr
, ftnlen len
)
if(f__cursor
&& mv_cur()) return(mv_cur());
fprintf(stderr
,"w_ed, unexpected code: %d\n", p
->op
);
case I
: return(wrt_I((Uint
*)ptr
,p
->p1
,len
, 10));
return(wrt_IM((Uint
*)ptr
,p
->p1
,p
->p2
,len
,10));
/* O and OM don't work right for character, double, complex, */
/* or doublecomplex, and they differ from Fortran 90 in */
/* showing a minus sign for negative values. */
case O
: return(wrt_I((Uint
*)ptr
, p
->p1
, len
, 8));
return(wrt_IM((Uint
*)ptr
,p
->p1
,p
->p2
,len
,8));
case L
: return(wrt_L((Uint
*)ptr
,p
->p1
, len
));
case A
: return(wrt_A(ptr
,len
));
return(wrt_AW(ptr
,p
->p1
,len
));
return(wrt_E((ufloat
*)ptr
,p
->p1
,p
->p2
,p
->p3
,len
));
return(wrt_G((ufloat
*)ptr
,p
->p1
,p
->p2
,p
->p3
,len
));
case F
: return(wrt_F((ufloat
*)ptr
,p
->p1
,p
->p2
,len
));
/* Z and ZM assume 8-bit bytes. */
case Z
: return(wrt_Z((Uint
*)ptr
,p
->p1
,0,len
));
return(wrt_Z((Uint
*)ptr
,p
->p1
,p
->p2
,len
));
default: fprintf(stderr
,"w_ned, unexpected code: %d\n", p
->op
);
return((*f__donewrec
)());
case T
: f__cursor
= p
->p1
-f__recpos
- 1;
case TL
: f__cursor
-= p
->p1
;
if(f__cursor
< -f__recpos
) /* TL1000, 1X */
return(wrt_AP(*(char **)&p
->p2
));
return(wrt_H(p
->p1
,*(char **)&p
->p2
));