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