projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| 8662e665 PW |
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 | } |