12504Sdlw /* 2*19985Slibs char id_wrtfmt[] = "@(#)wrtfmt.c 1.10"; 32504Sdlw * 42504Sdlw * formatted write routines 52504Sdlw */ 62504Sdlw 72504Sdlw #include "fio.h" 82603Sdlw #include "format.h" 92504Sdlw 102504Sdlw extern char *icvt(); 1117969Slibs extern char *s_init; 122504Sdlw 132504Sdlw #define abs(x) (x<0?-x:x) 142504Sdlw 152504Sdlw w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len; 162504Sdlw { int n; 172504Sdlw if(cursor && (n=wr_mvcur())) return(n); 182504Sdlw switch(p->op) 192504Sdlw { 202504Sdlw case I: 212504Sdlw case IM: 222504Sdlw return(wrt_IM(ptr,p->p1,p->p2,len)); 232504Sdlw case L: 24*19985Slibs return(wrt_L(ptr,p->p1,len)); 252504Sdlw case A: 2617969Slibs return(wrt_AW(ptr,len,len)); 272504Sdlw case AW: 282504Sdlw return(wrt_AW(ptr,p->p1,len)); 292504Sdlw case D: 3017969Slibs return(wrt_E(ptr,p->p1,p->p2,2,len,'d')); 312504Sdlw case DE: 3217969Slibs return(wrt_E(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len,'d')); 332504Sdlw case E: 3417969Slibs return(wrt_E(ptr,p->p1,p->p2,2,len,'e')); 352504Sdlw case EE: 3617969Slibs return(wrt_E(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len,'e')); 372504Sdlw case G: 3817969Slibs return(wrt_G(ptr,p->p1,p->p2,2,len)); 392504Sdlw case GE: 4017969Slibs return(wrt_G(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len)); 412504Sdlw case F: 422504Sdlw return(wrt_F(ptr,p->p1,p->p2,len)); 432504Sdlw default: 442603Sdlw return(errno=F_ERFMT); 452504Sdlw } 462504Sdlw } 472504Sdlw 482504Sdlw w_ned(p,ptr) char *ptr; struct syl *p; 492504Sdlw { 502504Sdlw switch(p->op) 512504Sdlw { 522504Sdlw case SLASH: 532504Sdlw return((*donewrec)()); 542504Sdlw case T: 552504Sdlw if(p->p1) cursor = p->p1 - recpos - 1; 562504Sdlw #ifndef KOSHER 572504Sdlw else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */ 582504Sdlw #endif 592504Sdlw tab = YES; 602504Sdlw return(OK); 612504Sdlw case TL: 622504Sdlw cursor -= p->p1; 6312371Sdlw if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */ 642504Sdlw tab = YES; 652504Sdlw return(OK); 662504Sdlw case TR: 672504Sdlw case X: 682504Sdlw cursor += p->p1; 6912371Sdlw /* tab = (p->op == TR); this would implement destructive X */ 7012371Sdlw tab = YES; 712504Sdlw return(OK); 722504Sdlw case APOS: 7317969Slibs return(wrt_AP(&s_init[p->p1])); 742504Sdlw case H: 7517969Slibs return(wrt_H(p->p1,&s_init[p->p2])); 762504Sdlw default: 772603Sdlw return(errno=F_ERFMT); 782504Sdlw } 792504Sdlw } 802504Sdlw 812504Sdlw wr_mvcur() 822504Sdlw { int n; 832504Sdlw if(tab) return((*dotab)()); 8412466Sdlw if (cursor < 0) return(errno=F_ERSEEK); 852504Sdlw while(cursor--) PUT(' ') 862504Sdlw return(cursor=0); 872504Sdlw } 882504Sdlw 892504Sdlw wrt_IM(ui,w,m,len) uint *ui; ftnlen len; 902504Sdlw { int ndigit,sign,spare,i,xsign,n; 912504Sdlw long x; 922504Sdlw char *ans; 932504Sdlw if(sizeof(short)==len) x=ui->is; 942504Sdlw /* else if(len == sizeof(char)) x = ui->ic; */ 952504Sdlw else x=ui->il; 962504Sdlw if(x==0 && m==0) 972504Sdlw { for(i=0;i<w;i++) PUT(' ') 982504Sdlw return(OK); 992504Sdlw } 1002504Sdlw ans=icvt(x,&ndigit,&sign); 1012504Sdlw if(sign || cplus) xsign=1; 1022504Sdlw else xsign=0; 1032504Sdlw if(ndigit+xsign>w || m+xsign>w) 1042504Sdlw { for(i=0;i<w;i++) PUT('*') 1052504Sdlw return(OK); 1062504Sdlw } 1072504Sdlw if(ndigit>=m) 1082504Sdlw spare=w-ndigit-xsign; 1092504Sdlw else 1102504Sdlw spare=w-m-xsign; 1112504Sdlw for(i=0;i<spare;i++) PUT(' ') 1122504Sdlw if(sign) PUT('-') 1132504Sdlw else if(cplus) PUT('+') 1142504Sdlw for(i=0;i<m-ndigit;i++) PUT('0') 1152504Sdlw for(i=0;i<ndigit;i++) PUT(*ans++) 1162504Sdlw return(OK); 1172504Sdlw } 1182504Sdlw 1192504Sdlw wrt_AP(p) 1202504Sdlw { char *s,quote; 1212504Sdlw int n; 1222504Sdlw if(cursor && (n=wr_mvcur())) return(n); 1232504Sdlw s=(char *)p; 1242504Sdlw quote = *s++; 1252504Sdlw for(; *s; s++) 1262504Sdlw { if(*s!=quote) PUT(*s) 1272504Sdlw else if(*++s==quote) PUT(*s) 1282504Sdlw else return(OK); 1292504Sdlw } 1302504Sdlw return(OK); 1312504Sdlw } 1322504Sdlw 1332504Sdlw wrt_H(a,b) 1342504Sdlw { char *s=(char *)b; 1352504Sdlw int n; 1362504Sdlw if(cursor && (n=wr_mvcur())) return(n); 1372504Sdlw while(a--) PUT(*s++) 1382504Sdlw return(OK); 1392504Sdlw } 1402504Sdlw 141*19985Slibs wrt_L(l,width,len) uint *l; ftnlen len; 1422504Sdlw { int i,n; 143*19985Slibs for(i=0;i<width-1;i++) PUT(' ') 144*19985Slibs if(len == sizeof (short)) 145*19985Slibs i = l->is; 146*19985Slibs else 147*19985Slibs i = l->il; 148*19985Slibs if(i) PUT('t') 1492504Sdlw else PUT('f') 1502504Sdlw return(OK); 1512504Sdlw } 1522504Sdlw 1532504Sdlw wrt_AW(p,w,len) char * p; ftnlen len; 1542504Sdlw { int n; 1552504Sdlw while(w>len) 1562504Sdlw { w--; 1572504Sdlw PUT(' ') 1582504Sdlw } 1592504Sdlw while(w-- > 0) 1602504Sdlw PUT(*p++) 1612504Sdlw return(OK); 1622504Sdlw } 1632504Sdlw 16412039Sdlw wrt_E(p,w,d,e,len,expch) ufloat *p; ftnlen len; char expch; 16512039Sdlw { char *s,ex[4]; 1662504Sdlw int dd,dp,sign,i,delta,pad,n; 1672504Sdlw char *ecvt(); 16812039Sdlw 1692504Sdlw if((len==sizeof(float)?p->pf:p->pd)==0.0) 1702504Sdlw { 17117229Sdlw n = cblank; 17217229Sdlw cblank = 1; /* force '0' fill */ 1732504Sdlw wrt_F(p,w-(e+2),d,len); 17417229Sdlw cblank = n; 1752504Sdlw PUT(expch) 1762504Sdlw PUT('+') 1772504Sdlw /* for(i=0;i<(e-1);i++)PUT(' ') 1782504Sdlw deleted PUT('0') 1792504Sdlw */ 1802504Sdlw /* added */ for(i=0;i<e;i++) PUT('0') 1812504Sdlw return(OK); 1822504Sdlw } 18312371Sdlw if (scale > 0) { /* insane ANSI requirement */ 18412371Sdlw dd = d + 1; 18512371Sdlw d = dd - scale; 18612371Sdlw } else 18712371Sdlw dd = d + scale; 18812371Sdlw if (dd <= 0 || d < 0) goto E_badfield; 1892504Sdlw s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign); 1902504Sdlw delta = 3+e; 1912504Sdlw if(sign||cplus) delta++; 1922504Sdlw pad=w-(delta+d)-(scale>0? scale:0); 19312371Sdlw if(pad<0) { 19412371Sdlw E_badfield: 19512371Sdlw for(i=0;i<w;i++) PUT('*') 1962504Sdlw return(OK); 1972504Sdlw } 1982504Sdlw for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ') 1992504Sdlw if(sign) PUT('-') 2002504Sdlw else if(cplus) PUT('+') 2012504Sdlw if(scale<=0 && pad) PUT('0') 2022504Sdlw if(scale<0 && scale > -d) 2032504Sdlw { 2042504Sdlw PUT('.') 2052504Sdlw for(i=0;i<-scale;i++) 2062504Sdlw PUT('0') 2072504Sdlw for(i=0;i<d+scale;i++) 2082504Sdlw PUT(*s++) 2092504Sdlw } 2102504Sdlw else 2112504Sdlw { 2122504Sdlw if(scale>0) 2132504Sdlw for(i=0;i<scale;i++) 2142504Sdlw PUT(*s++) 2152504Sdlw PUT('.') 2162504Sdlw for(i=0;i<d;i++) 2172504Sdlw PUT(*s++) 2182504Sdlw } 2192504Sdlw dp -= scale; 2202504Sdlw sprintf(ex,"%d",abs(dp)); 2212504Sdlw if((pad=strlen(ex))>e) 2222504Sdlw { if(pad>(++e)) 2232504Sdlw { PUT(expch) 2242504Sdlw for(i=0;i<e;i++) PUT('*') 2252504Sdlw return(OK); 2262504Sdlw } 2272504Sdlw } 2282504Sdlw else PUT(expch) 2292504Sdlw PUT(dp<0?'-':'+') 2302504Sdlw for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */ 2312504Sdlw s= &ex[0]; 2322504Sdlw while(*s) PUT(*s++) 2332504Sdlw return(OK); 2342504Sdlw } 2352504Sdlw 2362504Sdlw wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; 2372504Sdlw { double uplim = 1.0, x; 2382504Sdlw int i,oldscale,n,j,ne; 2392504Sdlw x=(len==sizeof(float)?(double)p->pf:p->pd); 2402504Sdlw i=d; 2412504Sdlw if(x==0.0) goto zero; 2422504Sdlw x = abs(x); 2432504Sdlw if(x>=0.1) 2442504Sdlw { 2452504Sdlw for(i=0; i<=d; i++, uplim*=10.0) 2467456Sdlw { if(x>=uplim) continue; 2472504Sdlw zero: oldscale=scale; 2482504Sdlw scale=0; 2492504Sdlw ne = e+2; 2502504Sdlw if(n = wrt_F(p,w-ne,d-i,len)) return(n); 2512504Sdlw for(j=0; j<ne; j++) PUT(' ') 2522504Sdlw scale=oldscale; 2532504Sdlw return(OK); 2542504Sdlw } 2552504Sdlw /* falling off the bottom implies E format */ 2562504Sdlw } 25712039Sdlw return(wrt_E(p,w,d,e,len,'e')); 2582504Sdlw } 2592504Sdlw 2602504Sdlw wrt_F(p,w,d,len) ufloat *p; ftnlen len; 2612504Sdlw { int i,delta,dp,sign,n,nf; 2622504Sdlw double x; 2632504Sdlw char *s,*fcvt(); 2642504Sdlw x= (len==sizeof(float)?(double)p->pf:p->pd); 2652504Sdlw if(scale && x!=0.0) 2662504Sdlw { if(scale>0) 2672504Sdlw for(i=0;i<scale;i++) x*=10; 2682504Sdlw else for(i=0;i<-scale;i++) x/=10; 2692504Sdlw } 2702504Sdlw s=fcvt(x,d,&dp,&sign); 2712504Sdlw /* if(-dp>=d) sign=0; ?? */ 2722504Sdlw delta=1; 2732504Sdlw if(sign || cplus) delta++; 2742504Sdlw nf = w - (d + delta + (dp>0?dp:0)); 2752504Sdlw if(nf<0) 2762504Sdlw { 2772504Sdlw for(i=0;i<w;i++) PUT('*') 2782504Sdlw return(OK); 2792504Sdlw } 2802504Sdlw if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ') 2812504Sdlw if(sign) PUT('-') 2822504Sdlw else if(cplus) PUT('+') 2832504Sdlw if(dp>0) for(i=0;i<dp;i++) PUT(*s++) 2842504Sdlw else if(nf>0) PUT('0') 2852504Sdlw PUT('.') 2862504Sdlw for(i=0; i< -dp && i<d; i++) PUT('0') 2872504Sdlw for(;i<d;i++) 2883561Sdlw { if(x==0.0 && !cblank) PUT(' ') /* exactly zero */ 2892504Sdlw else if(*s) PUT(*s++) 2902504Sdlw else PUT('0') 2912504Sdlw } 2922504Sdlw return(OK); 2932504Sdlw } 294