Annotation of cci/usr/src/usr.lib/libsI77/lwrite.c, revision 1.1.1.1

1.1       root        1: /*
                      2: char id_lwrite[] = "@(#)lwrite.c       1.2";
                      3:  *
                      4:  * list directed write
                      5:  */
                      6: 
                      7: #include "fio.h"
                      8: #include "lio.h"
                      9: 
                     10: int l_write(), t_putc();
                     11: 
                     12: s_wsle(a) cilist *a;
                     13: {
                     14:        int n;
                     15:        reading = NO;
                     16:        if(n=c_le(a,WRITE)) return(n);
                     17:        putn = t_putc;
                     18:        lioproc = l_write;
                     19:        line_len = LINE;
                     20:        curunit->uend = NO;
                     21:        leof = NO;
                     22:        if(!curunit->uwrt) nowwriting(curunit);
                     23:        return(OK);
                     24: }
                     25: 
                     26: t_putc(c) char c;
                     27: {
                     28:        if(c=='\n') recpos=0;
                     29:        else recpos++;
                     30:        putc(c,cf);
                     31:        return(OK);
                     32: }
                     33: 
                     34: e_wsle()
                     35: {      int n;
                     36:        PUT('\n')
                     37:        return(OK);
                     38: }
                     39: 
                     40: l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
                     41: {
                     42:        int i,n;
                     43:        ftnint x;
                     44:        float y,z;
                     45:        double yd,zd;
                     46:        float *xx;
                     47:        double *yy;
                     48:        for(i=0;i< *number; i++)
                     49:        {
                     50:                switch((int)type)
                     51:                {
                     52:                case TYSHORT:
                     53:                        x=ptr->flshort;
                     54:                        goto xint;
                     55:                case TYLONG:
                     56:                        x=ptr->flint;
                     57:        xint:           ERR(lwrt_I(x));
                     58:                        break;
                     59:                case TYREAL:
                     60:                        ERR(lwrt_F(ptr->flreal));
                     61:                        break;
                     62:                case TYDREAL:
                     63:                        ERR(lwrt_D(ptr->fldouble));
                     64:                        break;
                     65:                case TYCOMPLEX:
                     66:                        xx= &(ptr->flreal);
                     67:                        y = *xx++;
                     68:                        z = *xx;
                     69:                        ERR(lwrt_C(y,z));
                     70:                        break;
                     71:                case TYDCOMPLEX:
                     72:                        yy = &(ptr->fldouble);
                     73:                        yd= *yy++;
                     74:                        zd = *yy;
                     75:                        ERR(lwrt_DC(yd,zd));
                     76:                        break;
                     77:                case TYLOGICAL:
                     78:                        ERR(lwrt_L(ptr->flint));
                     79:                        break;
                     80:                case TYCHAR:
                     81:                        ERR(lwrt_A((char *)ptr,len));
                     82:                        break;
                     83:                default:
                     84:                        fatal(F_ERSYS,"unknown type in lwrite");
                     85:                }
                     86:                ptr = (char *)ptr + len;
                     87:        }
                     88:        return(OK);
                     89: }
                     90: 
                     91: lwrt_I(in) ftnint in;
                     92: {      int n;
                     93:        char buf[16],*p;
                     94:        sprintf(buf,"  %ld",(long)in);
                     95:        if(n=chk_len(LINTW)) return(n);
                     96:        for(p=buf;*p;) PUT(*p++)
                     97:        return(OK);
                     98: }
                     99: 
                    100: lwrt_L(ln) ftnint ln;
                    101: {      int n;
                    102:        if(n=chk_len(LLOGW)) return(n);
                    103:        return(wrt_L(&ln,LLOGW));
                    104: }
                    105: 
                    106: lwrt_A(p,len) char *p; ftnlen len;
                    107: {      int i,n;
                    108:        if(n=chk_len(LSTRW)) return(n);
                    109:        PUT(' ')
                    110:        PUT(' ')
                    111:        for(i=0;i<len;i++) PUT(*p++)
                    112:        return(OK);
                    113: }
                    114: 
                    115: lwrt_F(fn) float fn;
                    116: {      int d,n; float x; ufloat f;
                    117:        if(fn==0.0) return(lwrt_0());
                    118:        f.pf = fn;
                    119:        d = width(fn);
                    120:        if(n=chk_len(d)) return(n);
                    121:        if(d==LFW)
                    122:        {
                    123:                scale = 0;
                    124:                for(d=LFD,x=abs(fn);x>=1.0;x/=10.0,d--);
                    125:                return(wrt_F(&f,LFW,d,(ftnlen)sizeof(float)));
                    126:        }
                    127:        else
                    128:        {
                    129:                scale = 1;
                    130:                return(wrt_E(&f,LEW,LED-scale,LEE,(ftnlen)sizeof(float)));
                    131:        }
                    132: }
                    133: 
                    134: lwrt_D(dn) double dn;
                    135: {      int d,n; double x; ufloat f;
                    136:        if(dn==0.0) return(lwrt_0());
                    137:        f.pd = dn;
                    138:        d = dwidth(dn);
                    139:        if(n=chk_len(d)) return(n);
                    140:        if(d==LDFW)
                    141:        {
                    142:                scale = 0;
                    143:                for(d=LDFD,x=abs(dn);x>=1.0;x/=10.0,d--);
                    144:                return(wrt_F(&f,LDFW,d,(ftnlen)sizeof(double)));
                    145:        }
                    146:        else
                    147:        {
                    148:                scale = 1;
                    149:                return(wrt_E(&f,LDEW,LDED-scale,LDEE,(ftnlen)sizeof(double)));
                    150:        }
                    151: }
                    152: 
                    153: lwrt_C(a,b) float a,b;
                    154: {      int n;
                    155:        if(n=chk_len(LCW)) return(n);
                    156:        PUT(' ')
                    157:        PUT(' ')
                    158:        PUT('(')
                    159:        if(n=lwrt_F(a)) return(n);
                    160:        PUT(',')
                    161:        if(n=lwrt_F(b)) return(n);
                    162:        PUT(')')
                    163:        return(OK);
                    164: }
                    165: 
                    166: lwrt_DC(a,b) double a,b;
                    167: {      int n;
                    168:        if(n=chk_len(LDCW)) return(n);
                    169:        PUT(' ')
                    170:        PUT(' ')
                    171:        PUT('(')
                    172:        if(n=lwrt_D(a)) return(n);
                    173:        PUT(',')
                    174:        if(n=lwrt_D(b)) return(n);
                    175:        PUT(')')
                    176:        return(OK);
                    177: }
                    178: 
                    179: lwrt_0()
                    180: {      int n; char *z = "  0.";
                    181:        if(n=chk_len(4)) return(n);
                    182:        while(*z) PUT(*z++)
                    183:        return(OK);
                    184: }
                    185: 
                    186: chk_len(w)
                    187: {      int n;
                    188:        if(recpos+w > line_len) PUT('\n')
                    189:        return(OK);
                    190: }

unix.superglobalmegacorp.com

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