home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / libI77 / lio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1979-01-10  |  2.0 KB  |  132 lines
  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. }
  132.