2.9BSD - /usr/src/lib/libI77/lwrite.c

   1: /*
   2: char id_lwrite[] = "@(#)lwrite.c	1.4";
   3:  *
   4:  * list directed write
   5:  */
   6: 
   7: #include "fio.h"
   8: #include "lio.h"
   9: 
  10: int l_write(), t_putc();
  11: char lwrt[] = "list write";
  12: 
  13: s_wsle(a) cilist *a;
  14: {
  15:     int n;
  16:     reading = NO;
  17:     if(n=c_le(a,WRITE)) return(n);
  18:     putn = t_putc;
  19:     lioproc = l_write;
  20:     line_len = LINE;
  21:     curunit->uend = NO;
  22:     leof = NO;
  23:     if(!curunit->uwrt && ! nowwriting(curunit)) err(errflag, errno, lwrt)
  24:     return(OK);
  25: }
  26: 
  27: t_putc(c) char c;
  28: {
  29:     if(c=='\n') recpos=0;
  30:     else recpos++;
  31:     putc(c,cf);
  32:     return(OK);
  33: }
  34: 
  35: e_wsle()
  36: {   int n;
  37:     PUT('\n')
  38:     return(OK);
  39: }
  40: 
  41: l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
  42: {
  43:     int i,n;
  44:     ftnint x;
  45:     float y,z;
  46:     double yd,zd;
  47:     float *xx;
  48:     double *yy;
  49:     for(i=0;i< *number; i++)
  50:     {
  51:         switch((int)type)
  52:         {
  53:         case TYSHORT:
  54:             x=ptr->flshort;
  55:             goto xint;
  56:         case TYLONG:
  57:             x=ptr->flint;
  58:     xint:       ERR(lwrt_I(x));
  59:             break;
  60:         case TYREAL:
  61:             ERR(lwrt_F(ptr->flreal));
  62:             break;
  63:         case TYDREAL:
  64:             ERR(lwrt_D(ptr->fldouble));
  65:             break;
  66:         case TYCOMPLEX:
  67:             xx= &(ptr->flreal);
  68:             y = *xx++;
  69:             z = *xx;
  70:             ERR(lwrt_C(y,z));
  71:             break;
  72:         case TYDCOMPLEX:
  73:             yy = &(ptr->fldouble);
  74:             yd= *yy++;
  75:             zd = *yy;
  76:             ERR(lwrt_DC(yd,zd));
  77:             break;
  78:         case TYLOGICAL:
  79:             ERR(lwrt_L(ptr->flint));
  80:             break;
  81:         case TYCHAR:
  82:             ERR(lwrt_A((char *)ptr,len));
  83:             break;
  84:         default:
  85:             fatal(F_ERSYS,"unknown type in lwrite");
  86:         }
  87:         ptr = (flex *)((char *)ptr + len);
  88:     }
  89:     return(OK);
  90: }
  91: 
  92: lwrt_I(in) ftnint in;
  93: {   int n;
  94:     char buf[16],*p;
  95:     sprintf(buf,"  %ld",(long)in);
  96:     if(n=chk_len(LINTW)) return(n);
  97:     for(p=buf;*p;) PUT(*p++)
  98:     return(OK);
  99: }
 100: 
 101: lwrt_L(ln) ftnint ln;
 102: {   int n;
 103:     if(n=chk_len(LLOGW)) return(n);
 104:     return(wrt_L(&ln,LLOGW));
 105: }
 106: 
 107: lwrt_A(p,len) char *p; ftnlen len;
 108: {   int i,n;
 109:     if(n=chk_len(LSTRW)) return(n);
 110:     PUT(' ')
 111:     PUT(' ')
 112:     for(i=0;i<len;i++) PUT(*p++)
 113:     return(OK);
 114: }
 115: 
 116: lwrt_F(fn) float fn;
 117: {   int d,n; float x; ufloat f;
 118:     if(fn==0.0) return(lwrt_0());
 119:     f.pf = fn;
 120:     d = width(fn);
 121:     if(n=chk_len(d)) return(n);
 122:     if(d==LFW)
 123:     {
 124:         scale = 0;
 125:         for(d=LFD,x=abs(fn);x>=1.0;x/=10.0,d--);
 126:         return(wrt_F(&f,LFW,d,(ftnlen)sizeof(float)));
 127:     }
 128:     else
 129:     {
 130:         scale = 1;
 131:         return(wrt_E(&f,LEW,LED-scale,LEE,(ftnlen)sizeof(float),'e'));
 132:     }
 133: }
 134: 
 135: lwrt_D(dn) double dn;
 136: {   int d,n; double x; ufloat f;
 137:     if(dn==0.0) return(lwrt_0());
 138:     f.pd = dn;
 139:     d = dwidth(dn);
 140:     if(n=chk_len(d)) return(n);
 141:     if(d==LDFW)
 142:     {
 143:         scale = 0;
 144:         for(d=LDFD,x=abs(dn);x>=1.0;x/=10.0,d--);
 145:         return(wrt_F(&f,LDFW,d,(ftnlen)sizeof(double)));
 146:     }
 147:     else
 148:     {
 149:         scale = 1;
 150:         return(wrt_E(&f,LDEW,LDED-scale,LDEE,(ftnlen)sizeof(double),'d'));
 151:     }
 152: }
 153: 
 154: lwrt_C(a,b) float a,b;
 155: {   int n;
 156:     if(n=chk_len(LCW)) return(n);
 157:     PUT(' ')
 158:     PUT(' ')
 159:     PUT('(')
 160:     if(n=lwrt_F(a)) return(n);
 161:     PUT(',')
 162:     if(n=lwrt_F(b)) return(n);
 163:     PUT(')')
 164:     return(OK);
 165: }
 166: 
 167: lwrt_DC(a,b) double a,b;
 168: {   int n;
 169:     if(n=chk_len(LDCW)) return(n);
 170:     PUT(' ')
 171:     PUT(' ')
 172:     PUT('(')
 173:     if(n=lwrt_D(a)) return(n);
 174:     PUT(',')
 175:     if(n=lwrt_D(b)) return(n);
 176:     PUT(')')
 177:     return(OK);
 178: }
 179: 
 180: lwrt_0()
 181: {   int n; char *z = "  0.";
 182:     if(n=chk_len(4)) return(n);
 183:     while(*z) PUT(*z++)
 184:     return(OK);
 185: }
 186: 
 187: chk_len(w)
 188: {   int n;
 189:     if(recpos+w > line_len) PUT('\n')
 190:     return(OK);
 191: }

Defined functions

Defined variables