1: #include "fio.h"
   2: #include "lio.h"
   3: extern int l_write();
   4: int t_putc();
   5: s_wsle(a) cilist *a;
   6: {
   7:     int n;
   8:     if(!init) f_init();
   9:     if(n=c_le(a,WRITE)) return(n);
  10:     reading=0;
  11:     external=1;
  12:     formatted=1;
  13:     putn = t_putc;
  14:     lioproc = l_write;
  15:     if(!curunit->uwrt)
  16:         return(nowwriting(curunit));
  17:     else    return(0);
  18: }
  19: e_wsle()
  20: {
  21:     t_putc('\n');
  22:     recpos=0;
  23:     return(0);
  24: }
  25: t_putc(c)
  26: {
  27:     recpos++;
  28:     putc(c,cf);
  29: }
  30: lwrt_I(n) ftnint n;
  31: {
  32:     char buf[LINTW],*p;
  33:     sprintf(buf," %ld",(long)n);
  34:     if(recpos+strlen(buf)>=LINE)
  35:     {   t_putc('\n');
  36:         recpos=0;
  37:     }
  38:     for(p=buf;*p;t_putc(*p++));
  39: }
  40: lwrt_L(n) ftnint n;
  41: {
  42:     if(recpos+LLOGW>=LINE)
  43:     {   t_putc('\n');
  44:         recpos=0;
  45:     }
  46:     wrt_L(&n,LLOGW);
  47: }
  48: lwrt_A(p,len) char *p; ftnlen len;
  49: {
  50:     int i;
  51:     if(recpos+len>=LINE)
  52:     {
  53:         t_putc('\n');
  54:         recpos=0;
  55:     }
  56:     t_putc(' ');
  57:     for(i=0;i<len;i++) t_putc(*p++);
  58: }
  59: lwrt_F(n) double n;
  60: {
  61:     if(LLOW<=n && n<LHIGH)
  62:     {
  63:         if(recpos+LFW>=LINE)
  64:         {
  65:             t_putc('\n');
  66:             recpos=0;
  67:         }
  68:         scale=0;
  69:         wrt_F(&n,LFW,LFD,(ftnlen)sizeof(n));
  70:     }
  71:     else
  72:     {
  73:         if(recpos+LEW>=LINE)
  74:         {   t_putc('\n');
  75:             recpos=0;
  76:         }
  77:         wrt_E(&n,LEW,LED,LEE,(ftnlen)sizeof(n));
  78:     }
  79: }
  80: lwrt_C(a,b) double a,b;
  81: {
  82:     if(recpos+2*LFW+3>=LINE)
  83:     {   t_putc('\n');
  84:         recpos=0;
  85:     }
  86:     t_putc(' ');
  87:     t_putc('(');
  88:     lwrt_F(a);
  89:     lwrt_F(b);
  90:     t_putc(')');
  91: }
  92: l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
  93: {
  94:     int i;
  95:     ftnint x;
  96:     double y,z;
  97:     float *xx;
  98:     double *yy;
  99:     for(i=0;i< *number; i++)
 100:     {
 101:         switch((int)type)
 102:         {
 103:         default: fatal(204,"unknown type in lio");
 104:         case TYSHORT: x=ptr->flshort;
 105:             goto xint;
 106:         case TYLONG: x=ptr->flint;
 107:         xint: lwrt_I(x);
 108:             break;
 109:         case TYREAL: y=ptr->flreal;
 110:             goto xfloat;
 111:         case TYDREAL: y=ptr->fldouble;
 112:         xfloat: lwrt_F(y);
 113:             break;
 114:         case TYCOMPLEX: xx= &(ptr->flreal);
 115:             y = *xx++;
 116:             z = *xx;
 117:             goto xcomplex;
 118:         case TYDCOMPLEX: yy = &(ptr->fldouble);
 119:             y= *yy++;
 120:             z = *yy;
 121:         xcomplex: lwrt_C(y,z);
 122:             break;
 123:         case TYLOGICAL: lwrt_L(ptr->flint);
 124:             break;
 125:         case TYCHAR: lwrt_A((char *)ptr,len);
 126:             break;
 127:         }
 128:         ptr = (char *)ptr + len;
 129:     }
 130:     return(0);
 131: }

Defined functions

e_wsle defined in line 19; never used
l_write defined in line 92; used 2 times
  • in line 3, 14
lwrt_A defined in line 48; used 1 times
lwrt_C defined in line 80; used 1 times
lwrt_F defined in line 59; used 3 times
lwrt_I defined in line 30; used 1 times
lwrt_L defined in line 40; used 1 times
s_wsle defined in line 5; never used
t_putc defined in line 25; used 15 times
Last modified: 1979-01-10
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 599
Valid CSS Valid XHTML 1.0 Strict