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

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

Defined functions

Defined variables