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: }

Defined functions

wr_mvcur defined in line 77; used 3 times
wrt_AP defined in line 115; used 1 times
  • in line 69
wrt_AW defined in line 145; used 1 times
  • in line 27
wrt_E defined in line 156; used 5 times
wrt_F defined in line 249; used 5 times
wrt_G defined in line 225; used 1 times
  • in line 36
wrt_H defined in line 129; used 1 times
  • in line 71
wrt_IM defined in line 85; used 1 times
  • in line 21
wrt_L defined in line 137; used 2 times

Defined macros

abs defined in line 12; used 2 times
Last modified: 1983-05-20
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 847
Valid CSS Valid XHTML 1.0 Strict