Return to xwsne.c CVS log

Up to [Research Unix] / researchv10dc / libI77 / old1

Annotation of researchv10dc/libI77/old1/xwsne.c, revision 1.1

1.1     ! root        1: #include "f2c.h"
        !             2: #include "fio.h"
        !             3: #include "lio.h"
        !             4: #include "fmt.h"
        !             5: 
        !             6: #ifdef KR_headers
        !             7: x_wsne(a) cilist *a;
        !             8: #else
        !             9: #include "string.h"
        !            10: 
        !            11:  VOID
        !            12: x_wsne(cilist *a)
        !            13: #endif
        !            14: {
        !            15:        Namelist *nl;
        !            16:        char *s;
        !            17:        Vardesc *v, **vd, **vde;
        !            18:        ftnint *number, type;
        !            19:        ftnlen *dims;
        !            20:        ftnlen size;
        !            21:        static ftnint one = 1;
        !            22:        extern ftnlen f__typesize[];
        !            23: 
        !            24:        nl = (Namelist *)a->cifmt;
        !            25:        PUT('&');
        !            26:        for(s = nl->name; *s; s++)
        !            27:                PUT(*s);
        !            28:        PUT(' ');
        !            29:        vd = nl->vars;
        !            30:        vde = vd + nl->nvars;
        !            31:        while(vd < vde) {
        !            32:                v = *vd++;
        !            33:                s = v->name;
        !            34:                if (f__recpos+strlen(s)+2 >= L_len)
        !            35:                        (*f__donewrec)();
        !            36:                while(*s)
        !            37:                        PUT(*s++);
        !            38:                PUT(' ');
        !            39:                PUT('=');
        !            40:                number = (dims = v->dims) ? dims + 1 : &one;
        !            41:                type = v->type;
        !            42:                if (type < 0) {
        !            43:                        size = -type;
        !            44:                        type = TYCHAR;
        !            45:                        }
        !            46:                else
        !            47:                        size = f__typesize[type];
        !            48:                l_write(number, v->addr, size, type);
        !            49:                if (vd < vde) {
        !            50:                        if (f__recpos+2 >= L_len)
        !            51:                                (*f__donewrec)();
        !            52:                        PUT(',');
        !            53:                        PUT(' ');
        !            54:                        }
        !            55:                else if (f__recpos+1 >= L_len)
        !            56:                        (*f__donewrec)();
        !            57:                }
        !            58:        PUT('/');
        !            59:        }

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