1: /* 2: char id_wrtfmt[] = "@(#)wrtfmt.c 1.7"; 3: * 4: * formatted write routines 5: */ 6: 7: #include "fio.h" 8: #include "format.h" 9: 10: extern char *icvt(); 11: 12: #define abs(x) (x<0?-x:x) 13: 14: w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len; 15: { int n; 16: if(cursor && (n=wr_mvcur())) return(n); 17: switch(p->op) 18: { 19: case I: 20: case IM: 21: return(wrt_IM(ptr,p->p1,p->p2,len)); 22: case L: 23: return(wrt_L(ptr,p->p1)); 24: case A: 25: p->p1 = len; /* cheap trick */ 26: case AW: 27: return(wrt_AW(ptr,p->p1,len)); 28: case D: 29: case DE: 30: return(wrt_E(ptr,p->p1,p->p2,p->p3,len,'d')); 31: case E: 32: case EE: 33: return(wrt_E(ptr,p->p1,p->p2,p->p3,len,'e')); 34: case G: 35: case GE: 36: return(wrt_G(ptr,p->p1,p->p2,p->p3,len)); 37: case F: 38: return(wrt_F(ptr,p->p1,p->p2,len)); 39: default: 40: return(errno=F_ERFMT); 41: } 42: } 43: 44: w_ned(p,ptr) char *ptr; struct syl *p; 45: { 46: switch(p->op) 47: { 48: case SLASH: 49: return((*donewrec)()); 50: case T: 51: if(p->p1) cursor = p->p1 - recpos - 1; 52: #ifndef KOSHER 53: else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */ 54: #endif 55: tab = YES; 56: return(OK); 57: case TL: 58: cursor -= p->p1; 59: if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */ 60: tab = YES; 61: return(OK); 62: case TR: 63: case X: 64: cursor += p->p1; 65: /* tab = (p->op == TR); this would implement destructive X */ 66: tab = YES; 67: return(OK); 68: case APOS: 69: return(wrt_AP(p->p1)); 70: case H: 71: return(wrt_H(p->p1,p->p2)); 72: default: 73: return(errno=F_ERFMT); 74: } 75: } 76: 77: wr_mvcur() 78: { int n; 79: if(tab) return((*dotab)()); 80: if (cursor < 0) return(errno=F_ERSEEK); 81: while(cursor--) PUT(' ') 82: return(cursor=0); 83: } 84: 85: wrt_IM(ui,w,m,len) uint *ui; ftnlen len; 86: { int ndigit,sign,spare,i,xsign,n; 87: long x; 88: char *ans; 89: if(sizeof(short)==len) x=ui->is; 90: /* else if(len == sizeof(char)) x = ui->ic; */ 91: else x=ui->il; 92: if(x==0 && m==0) 93: { for(i=0;i<w;i++) PUT(' ') 94: return(OK); 95: } 96: ans=icvt(x,&ndigit,&sign); 97: if(sign || cplus) xsign=1; 98: else xsign=0; 99: if(ndigit+xsign>w || m+xsign>w) 100: { for(i=0;i<w;i++) PUT('*') 101: return(OK); 102: } 103: if(ndigit>=m) 104: spare=w-ndigit-xsign; 105: else 106: spare=w-m-xsign; 107: for(i=0;i<spare;i++) PUT(' ') 108: if(sign) PUT('-') 109: else if(cplus) PUT('+') 110: for(i=0;i<m-ndigit;i++) PUT('0') 111: for(i=0;i<ndigit;i++) PUT(*ans++) 112: return(OK); 113: } 114: 115: wrt_AP(p) 116: { char *s,quote; 117: int n; 118: if(cursor && (n=wr_mvcur())) return(n); 119: s=(char *)p; 120: quote = *s++; 121: for(; *s; s++) 122: { if(*s!=quote) PUT(*s) 123: else if(*++s==quote) PUT(*s) 124: else return(OK); 125: } 126: return(OK); 127: } 128: 129: wrt_H(a,b) 130: { char *s=(char *)b; 131: int n; 132: if(cursor && (n=wr_mvcur())) return(n); 133: while(a--) PUT(*s++) 134: return(OK); 135: } 136: 137: wrt_L(l,len) ftnint *l; 138: { int i,n; 139: for(i=0;i<len-1;i++) PUT(' ') 140: if(*l) PUT('t') 141: else PUT('f') 142: return(OK); 143: } 144: 145: wrt_AW(p,w,len) char * p; ftnlen len; 146: { int n; 147: while(w>len) 148: { w--; 149: PUT(' ') 150: } 151: while(w-- > 0) 152: PUT(*p++) 153: return(OK); 154: } 155: 156: wrt_E(p,w,d,e,len,expch) ufloat *p; ftnlen len; char expch; 157: { char *s,ex[4]; 158: int dd,dp,sign,i,delta,pad,n; 159: char *ecvt(); 160: 161: if((len==sizeof(float)?p->pf:p->pd)==0.0) 162: { 163: wrt_F(p,w-(e+2),d,len); 164: PUT(expch) 165: PUT('+') 166: /* for(i=0;i<(e-1);i++)PUT(' ') 167: deleted PUT('0') 168: */ 169: /* added */ for(i=0;i<e;i++) PUT('0') 170: return(OK); 171: } 172: if (scale > 0) { /* insane ANSI requirement */ 173: dd = d + 1; 174: d = dd - scale; 175: } else 176: dd = d + scale; 177: if (dd <= 0 || d < 0) goto E_badfield; 178: s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign); 179: delta = 3+e; 180: if(sign||cplus) delta++; 181: pad=w-(delta+d)-(scale>0? scale:0); 182: if(pad<0) { 183: E_badfield: 184: for(i=0;i<w;i++) PUT('*') 185: return(OK); 186: } 187: for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ') 188: if(sign) PUT('-') 189: else if(cplus) PUT('+') 190: if(scale<=0 && pad) PUT('0') 191: if(scale<0 && scale > -d) 192: { 193: PUT('.') 194: for(i=0;i<-scale;i++) 195: PUT('0') 196: for(i=0;i<d+scale;i++) 197: PUT(*s++) 198: } 199: else 200: { 201: if(scale>0) 202: for(i=0;i<scale;i++) 203: PUT(*s++) 204: PUT('.') 205: for(i=0;i<d;i++) 206: PUT(*s++) 207: } 208: dp -= scale; 209: sprintf(ex,"%d",abs(dp)); 210: if((pad=strlen(ex))>e) 211: { if(pad>(++e)) 212: { PUT(expch) 213: for(i=0;i<e;i++) PUT('*') 214: return(OK); 215: } 216: } 217: else PUT(expch) 218: PUT(dp<0?'-':'+') 219: for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */ 220: s= &ex[0]; 221: while(*s) PUT(*s++) 222: return(OK); 223: } 224: 225: wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; 226: { double uplim = 1.0, x; 227: int i,oldscale,n,j,ne; 228: x=(len==sizeof(float)?(double)p->pf:p->pd); 229: i=d; 230: if(x==0.0) goto zero; 231: x = abs(x); 232: if(x>=0.1) 233: { 234: for(i=0; i<=d; i++, uplim*=10.0) 235: { if(x>=uplim) continue; 236: zero: oldscale=scale; 237: scale=0; 238: ne = e+2; 239: if(n = wrt_F(p,w-ne,d-i,len)) return(n); 240: for(j=0; j<ne; j++) PUT(' ') 241: scale=oldscale; 242: return(OK); 243: } 244: /* falling off the bottom implies E format */ 245: } 246: return(wrt_E(p,w,d,e,len,'e')); 247: } 248: 249: wrt_F(p,w,d,len) ufloat *p; ftnlen len; 250: { int i,delta,dp,sign,n,nf; 251: double x; 252: char *s,*fcvt(); 253: x= (len==sizeof(float)?(double)p->pf:p->pd); 254: if(scale && x!=0.0) 255: { if(scale>0) 256: for(i=0;i<scale;i++) x*=10; 257: else for(i=0;i<-scale;i++) x/=10; 258: } 259: s=fcvt(x,d,&dp,&sign); 260: /* if(-dp>=d) sign=0; ?? */ 261: delta=1; 262: if(sign || cplus) delta++; 263: nf = w - (d + delta + (dp>0?dp:0)); 264: if(nf<0) 265: { 266: for(i=0;i<w;i++) PUT('*') 267: return(OK); 268: } 269: if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ') 270: if(sign) PUT('-') 271: else if(cplus) PUT('+') 272: if(dp>0) for(i=0;i<dp;i++) PUT(*s++) 273: else if(nf>0) PUT('0') 274: PUT('.') 275: for(i=0; i< -dp && i<d; i++) PUT('0') 276: for(;i<d;i++) 277: { if(x==0.0 && !cblank) PUT(' ') /* exactly zero */ 278: else if(*s) PUT(*s++) 279: else PUT('0') 280: } 281: return(OK); 282: }