Return to lio.c CVS log

Up to [Research Unix] / researchv10dc / libI77 / old

Annotation of researchv10dc/libI77/old/lio.c, revision 1.1.1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.