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