Return to lwrite.c CVS log

Up to [CSRG BSD Unix] / 43BSD / usr.lib / libI77

Annotation of 43BSD/usr.lib/libI77/lwrite.c, revision 1.1

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

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