Return to lio.c CVS log

Up to [CSRG BSD Unix] / 40BSD / lib / libI77

Annotation of 40BSD/lib/libI77/lio.c, revision 1.1.1.1

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

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