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

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.