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     ! 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.