Return to lio.c CVS log

Up to [CSRG BSD Unix] / 3BSD / libI77

Annotation of 3BSD/libI77/lio.c, revision 1.1.1.1

1.1       root        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:        t_putc(',');
                     90:        lwrt_F(b);
                     91:        t_putc(')');
                     92: }
                     93: l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
                     94: {
                     95:        int i;
                     96:        ftnint x;
                     97:        double y,z;
                     98:        float *xx;
                     99:        double *yy;
                    100:        for(i=0;i< *number; i++)
                    101:        {
                    102:                switch((int)type)
                    103:                {
                    104:                default: fatal(204,"unknown type in lio");
                    105:                case TYSHORT: x=ptr->flshort;
                    106:                        goto xint;
                    107:                case TYLONG: x=ptr->flint;
                    108:                xint: lwrt_I(x);
                    109:                        break;
                    110:                case TYREAL: y=ptr->flreal;
                    111:                        goto xfloat;
                    112:                case TYDREAL: y=ptr->fldouble;
                    113:                xfloat: lwrt_F(y);
                    114:                        break;
                    115:                case TYCOMPLEX: xx= &(ptr->flreal);
                    116:                        y = *xx++;
                    117:                        z = *xx;
                    118:                        goto xcomplex;
                    119:                case TYDCOMPLEX: yy = &(ptr->fldouble);
                    120:                        y= *yy++;
                    121:                        z = *yy;
                    122:                xcomplex: lwrt_C(y,z);
                    123:                        break;
                    124:                case TYLOGICAL: lwrt_L(ptr->flint);
                    125:                        break;
                    126:                case TYCHAR: lwrt_A((char *)ptr,len);
                    127:                        break;
                    128:                }
                    129:                ptr = (char *)ptr + len;
                    130:        }
                    131:        return(0);
                    132: }

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