|
|
1.1 ! root 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,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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.