1*f3455753Sbostic /*-
2*f3455753Sbostic * Copyright (c) 1980 The Regents of the University of California.
3*f3455753Sbostic * All rights reserved.
45e33e0caSdlw *
5*f3455753Sbostic * %sccs.include.proprietary.c%
677c0832dSkre */
777c0832dSkre
8*f3455753Sbostic #ifndef lint
9*f3455753Sbostic static char sccsid[] = "@(#)wrtfmt.c 5.2 (Berkeley) 04/12/91";
10*f3455753Sbostic #endif /* not lint */
11*f3455753Sbostic
1277c0832dSkre /*
135e33e0caSdlw * formatted write routines
145e33e0caSdlw */
155e33e0caSdlw
165e33e0caSdlw #include "fio.h"
17d10cb981Sdlw #include "format.h"
185e33e0caSdlw
195e33e0caSdlw extern char *icvt();
209936f028Slibs extern char *s_init;
215e33e0caSdlw
225e33e0caSdlw #define abs(x) (x<0?-x:x)
235e33e0caSdlw
w_ed(p,ptr,len)245e33e0caSdlw w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
255e33e0caSdlw { int n;
265e33e0caSdlw if(cursor && (n=wr_mvcur())) return(n);
275e33e0caSdlw switch(p->op)
285e33e0caSdlw {
295e33e0caSdlw case I:
305e33e0caSdlw case IM:
315e33e0caSdlw return(wrt_IM(ptr,p->p1,p->p2,len));
325e33e0caSdlw case L:
33eb4da574Slibs return(wrt_L(ptr,p->p1,len));
345e33e0caSdlw case A:
359936f028Slibs return(wrt_AW(ptr,len,len));
365e33e0caSdlw case AW:
375e33e0caSdlw return(wrt_AW(ptr,p->p1,len));
385e33e0caSdlw case D:
399936f028Slibs return(wrt_E(ptr,p->p1,p->p2,2,len,'d'));
405e33e0caSdlw case DE:
419936f028Slibs return(wrt_E(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len,'d'));
425e33e0caSdlw case E:
439936f028Slibs return(wrt_E(ptr,p->p1,p->p2,2,len,'e'));
445e33e0caSdlw case EE:
459936f028Slibs return(wrt_E(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len,'e'));
465e33e0caSdlw case G:
479936f028Slibs return(wrt_G(ptr,p->p1,p->p2,2,len));
485e33e0caSdlw case GE:
499936f028Slibs return(wrt_G(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len));
505e33e0caSdlw case F:
515e33e0caSdlw return(wrt_F(ptr,p->p1,p->p2,len));
525e33e0caSdlw default:
53d10cb981Sdlw return(errno=F_ERFMT);
545e33e0caSdlw }
555e33e0caSdlw }
565e33e0caSdlw
w_ned(p,ptr)575e33e0caSdlw w_ned(p,ptr) char *ptr; struct syl *p;
585e33e0caSdlw {
595e33e0caSdlw switch(p->op)
605e33e0caSdlw {
615e33e0caSdlw case SLASH:
625e33e0caSdlw return((*donewrec)());
635e33e0caSdlw case T:
645e33e0caSdlw if(p->p1) cursor = p->p1 - recpos - 1;
655e33e0caSdlw #ifndef KOSHER
665e33e0caSdlw else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */
675e33e0caSdlw #endif
685e33e0caSdlw tab = YES;
695e33e0caSdlw return(OK);
705e33e0caSdlw case TL:
715e33e0caSdlw cursor -= p->p1;
7249b30407Sdlw if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */
735e33e0caSdlw tab = YES;
745e33e0caSdlw return(OK);
755e33e0caSdlw case TR:
765e33e0caSdlw case X:
775e33e0caSdlw cursor += p->p1;
7849b30407Sdlw /* tab = (p->op == TR); this would implement destructive X */
7949b30407Sdlw tab = YES;
805e33e0caSdlw return(OK);
815e33e0caSdlw case APOS:
829936f028Slibs return(wrt_AP(&s_init[p->p1]));
835e33e0caSdlw case H:
849936f028Slibs return(wrt_H(p->p1,&s_init[p->p2]));
855e33e0caSdlw default:
86d10cb981Sdlw return(errno=F_ERFMT);
875e33e0caSdlw }
885e33e0caSdlw }
895e33e0caSdlw
909e4573b6Slibs LOCAL
wr_mvcur()915e33e0caSdlw wr_mvcur()
925e33e0caSdlw { int n;
935e33e0caSdlw if(tab) return((*dotab)());
9403fc8cabSdlw if (cursor < 0) return(errno=F_ERSEEK);
955e33e0caSdlw while(cursor--) PUT(' ')
965e33e0caSdlw return(cursor=0);
975e33e0caSdlw }
985e33e0caSdlw
999e4573b6Slibs LOCAL
wrt_IM(ui,w,m,len)1005e33e0caSdlw wrt_IM(ui,w,m,len) uint *ui; ftnlen len;
1015e33e0caSdlw { int ndigit,sign,spare,i,xsign,n;
1025e33e0caSdlw long x;
1035e33e0caSdlw char *ans;
1045e33e0caSdlw if(sizeof(short)==len) x=ui->is;
1055e33e0caSdlw /* else if(len == sizeof(char)) x = ui->ic; */
1065e33e0caSdlw else x=ui->il;
1075e33e0caSdlw if(x==0 && m==0)
1085e33e0caSdlw { for(i=0;i<w;i++) PUT(' ')
1095e33e0caSdlw return(OK);
1105e33e0caSdlw }
1115e33e0caSdlw ans=icvt(x,&ndigit,&sign);
1125e33e0caSdlw if(sign || cplus) xsign=1;
1135e33e0caSdlw else xsign=0;
1145e33e0caSdlw if(ndigit+xsign>w || m+xsign>w)
1155e33e0caSdlw { for(i=0;i<w;i++) PUT('*')
1165e33e0caSdlw return(OK);
1175e33e0caSdlw }
1185e33e0caSdlw if(ndigit>=m)
1195e33e0caSdlw spare=w-ndigit-xsign;
1205e33e0caSdlw else
1215e33e0caSdlw spare=w-m-xsign;
1225e33e0caSdlw for(i=0;i<spare;i++) PUT(' ')
1235e33e0caSdlw if(sign) PUT('-')
1245e33e0caSdlw else if(cplus) PUT('+')
1255e33e0caSdlw for(i=0;i<m-ndigit;i++) PUT('0')
1265e33e0caSdlw for(i=0;i<ndigit;i++) PUT(*ans++)
1275e33e0caSdlw return(OK);
1285e33e0caSdlw }
1295e33e0caSdlw
1309e4573b6Slibs LOCAL
wrt_AP(p)1315e33e0caSdlw wrt_AP(p)
1325e33e0caSdlw { char *s,quote;
1335e33e0caSdlw int n;
1345e33e0caSdlw if(cursor && (n=wr_mvcur())) return(n);
1355e33e0caSdlw s=(char *)p;
1365e33e0caSdlw quote = *s++;
1375e33e0caSdlw for(; *s; s++)
1385e33e0caSdlw { if(*s!=quote) PUT(*s)
1395e33e0caSdlw else if(*++s==quote) PUT(*s)
1405e33e0caSdlw else return(OK);
1415e33e0caSdlw }
1425e33e0caSdlw return(OK);
1435e33e0caSdlw }
1445e33e0caSdlw
1459e4573b6Slibs LOCAL
wrt_H(a,b)1465e33e0caSdlw wrt_H(a,b)
1475e33e0caSdlw { char *s=(char *)b;
1485e33e0caSdlw int n;
1495e33e0caSdlw if(cursor && (n=wr_mvcur())) return(n);
1505e33e0caSdlw while(a--) PUT(*s++)
1515e33e0caSdlw return(OK);
1525e33e0caSdlw }
1535e33e0caSdlw
wrt_L(l,width,len)154eb4da574Slibs wrt_L(l,width,len) uint *l; ftnlen len;
1555e33e0caSdlw { int i,n;
156eb4da574Slibs for(i=0;i<width-1;i++) PUT(' ')
157eb4da574Slibs if(len == sizeof (short))
158eb4da574Slibs i = l->is;
159eb4da574Slibs else
160eb4da574Slibs i = l->il;
161eb4da574Slibs if(i) PUT('t')
1625e33e0caSdlw else PUT('f')
1635e33e0caSdlw return(OK);
1645e33e0caSdlw }
1655e33e0caSdlw
1669e4573b6Slibs LOCAL
wrt_AW(p,w,len)1675e33e0caSdlw wrt_AW(p,w,len) char * p; ftnlen len;
1685e33e0caSdlw { int n;
1695e33e0caSdlw while(w>len)
1705e33e0caSdlw { w--;
1715e33e0caSdlw PUT(' ')
1725e33e0caSdlw }
1735e33e0caSdlw while(w-- > 0)
1745e33e0caSdlw PUT(*p++)
1755e33e0caSdlw return(OK);
1765e33e0caSdlw }
1775e33e0caSdlw
wrt_E(p,w,d,e,len,expch)178668b8d4dSdlw wrt_E(p,w,d,e,len,expch) ufloat *p; ftnlen len; char expch;
179668b8d4dSdlw { char *s,ex[4];
1805e33e0caSdlw int dd,dp,sign,i,delta,pad,n;
1815e33e0caSdlw char *ecvt();
182668b8d4dSdlw
1835e33e0caSdlw if((len==sizeof(float)?p->pf:p->pd)==0.0)
1845e33e0caSdlw {
18568d79389Sdlw n = cblank;
18668d79389Sdlw cblank = 1; /* force '0' fill */
1875e33e0caSdlw wrt_F(p,w-(e+2),d,len);
18868d79389Sdlw cblank = n;
1895e33e0caSdlw PUT(expch)
1905e33e0caSdlw PUT('+')
1915e33e0caSdlw /* for(i=0;i<(e-1);i++)PUT(' ')
1925e33e0caSdlw deleted PUT('0')
1935e33e0caSdlw */
1945e33e0caSdlw /* added */ for(i=0;i<e;i++) PUT('0')
1955e33e0caSdlw return(OK);
1965e33e0caSdlw }
19749b30407Sdlw if (scale > 0) { /* insane ANSI requirement */
19849b30407Sdlw dd = d + 1;
19949b30407Sdlw d = dd - scale;
20049b30407Sdlw } else
2015e33e0caSdlw dd = d + scale;
20249b30407Sdlw if (dd <= 0 || d < 0) goto E_badfield;
2035e33e0caSdlw s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign);
2045e33e0caSdlw delta = 3+e;
2055e33e0caSdlw if(sign||cplus) delta++;
2065e33e0caSdlw pad=w-(delta+d)-(scale>0? scale:0);
20749b30407Sdlw if(pad<0) {
20849b30407Sdlw E_badfield:
20949b30407Sdlw for(i=0;i<w;i++) PUT('*')
2105e33e0caSdlw return(OK);
2115e33e0caSdlw }
2125e33e0caSdlw for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ')
2135e33e0caSdlw if(sign) PUT('-')
2145e33e0caSdlw else if(cplus) PUT('+')
2155e33e0caSdlw if(scale<=0 && pad) PUT('0')
2165e33e0caSdlw if(scale<0 && scale > -d)
2175e33e0caSdlw {
2185e33e0caSdlw PUT('.')
2195e33e0caSdlw for(i=0;i<-scale;i++)
2205e33e0caSdlw PUT('0')
2215e33e0caSdlw for(i=0;i<d+scale;i++)
2225e33e0caSdlw PUT(*s++)
2235e33e0caSdlw }
2245e33e0caSdlw else
2255e33e0caSdlw {
2265e33e0caSdlw if(scale>0)
2275e33e0caSdlw for(i=0;i<scale;i++)
2285e33e0caSdlw PUT(*s++)
2295e33e0caSdlw PUT('.')
2305e33e0caSdlw for(i=0;i<d;i++)
2315e33e0caSdlw PUT(*s++)
2325e33e0caSdlw }
2335e33e0caSdlw dp -= scale;
2345e33e0caSdlw sprintf(ex,"%d",abs(dp));
2355e33e0caSdlw if((pad=strlen(ex))>e)
2365e33e0caSdlw { if(pad>(++e))
2375e33e0caSdlw { PUT(expch)
2385e33e0caSdlw for(i=0;i<e;i++) PUT('*')
2395e33e0caSdlw return(OK);
2405e33e0caSdlw }
2415e33e0caSdlw }
2425e33e0caSdlw else PUT(expch)
2435e33e0caSdlw PUT(dp<0?'-':'+')
2445e33e0caSdlw for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */
2455e33e0caSdlw s= &ex[0];
2465e33e0caSdlw while(*s) PUT(*s++)
2475e33e0caSdlw return(OK);
2485e33e0caSdlw }
2495e33e0caSdlw
2509e4573b6Slibs LOCAL
wrt_G(p,w,d,e,len)2515e33e0caSdlw wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
2525e33e0caSdlw { double uplim = 1.0, x;
2535e33e0caSdlw int i,oldscale,n,j,ne;
2545e33e0caSdlw x=(len==sizeof(float)?(double)p->pf:p->pd);
2555e33e0caSdlw i=d;
2565e33e0caSdlw if(x==0.0) goto zero;
2575e33e0caSdlw x = abs(x);
2585e33e0caSdlw if(x>=0.1)
2595e33e0caSdlw {
2605e33e0caSdlw for(i=0; i<=d; i++, uplim*=10.0)
261ee5681e5Sdlw { if(x>=uplim) continue;
2625e33e0caSdlw zero: oldscale=scale;
2635e33e0caSdlw scale=0;
2645e33e0caSdlw ne = e+2;
2655e33e0caSdlw if(n = wrt_F(p,w-ne,d-i,len)) return(n);
2665e33e0caSdlw for(j=0; j<ne; j++) PUT(' ')
2675e33e0caSdlw scale=oldscale;
2685e33e0caSdlw return(OK);
2695e33e0caSdlw }
2705e33e0caSdlw /* falling off the bottom implies E format */
2715e33e0caSdlw }
272668b8d4dSdlw return(wrt_E(p,w,d,e,len,'e'));
2735e33e0caSdlw }
2745e33e0caSdlw
wrt_F(p,w,d,len)2755e33e0caSdlw wrt_F(p,w,d,len) ufloat *p; ftnlen len;
2765e33e0caSdlw { int i,delta,dp,sign,n,nf;
2775e33e0caSdlw double x;
2785e33e0caSdlw char *s,*fcvt();
2795e33e0caSdlw x= (len==sizeof(float)?(double)p->pf:p->pd);
2805e33e0caSdlw if(scale && x!=0.0)
2815e33e0caSdlw { if(scale>0)
2825e33e0caSdlw for(i=0;i<scale;i++) x*=10;
2835e33e0caSdlw else for(i=0;i<-scale;i++) x/=10;
2845e33e0caSdlw }
2855e33e0caSdlw s=fcvt(x,d,&dp,&sign);
2865e33e0caSdlw /* if(-dp>=d) sign=0; ?? */
2875e33e0caSdlw delta=1;
2885e33e0caSdlw if(sign || cplus) delta++;
2895e33e0caSdlw nf = w - (d + delta + (dp>0?dp:0));
2905e33e0caSdlw if(nf<0)
2915e33e0caSdlw {
2925e33e0caSdlw for(i=0;i<w;i++) PUT('*')
2935e33e0caSdlw return(OK);
2945e33e0caSdlw }
2955e33e0caSdlw if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ')
2965e33e0caSdlw if(sign) PUT('-')
2975e33e0caSdlw else if(cplus) PUT('+')
2985e33e0caSdlw if(dp>0) for(i=0;i<dp;i++) PUT(*s++)
2995e33e0caSdlw else if(nf>0) PUT('0')
3005e33e0caSdlw PUT('.')
3015e33e0caSdlw for(i=0; i< -dp && i<d; i++) PUT('0')
3025e33e0caSdlw for(;i<d;i++)
30397e886ceSdlw { if(x==0.0 && !cblank) PUT(' ') /* exactly zero */
3045e33e0caSdlw else if(*s) PUT(*s++)
3055e33e0caSdlw else PUT('0')
3065e33e0caSdlw }
3075e33e0caSdlw return(OK);
3085e33e0caSdlw }
309