source: trunk/third/gcc/libf2c/libI77/xwsne.c @ 16960

Revision 16960, 1.1 KB checked in by ghudson, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r16959, which included commits to RCS files with non-trunk default branches.
Line 
1#include "config.h"
2#include "f2c.h"
3#include "fio.h"
4#include "lio.h"
5#include "fmt.h"
6
7extern int f__Aquote;
8
9 static VOID
10nl_donewrec(Void)
11{
12        (*f__donewrec)();
13        PUT(' ');
14        }
15
16#ifdef KR_headers
17x_wsne(a) cilist *a;
18#else
19#include <string.h>
20
21 VOID
22x_wsne(cilist *a)
23#endif
24{
25        Namelist *nl;
26        char *s;
27        Vardesc *v, **vd, **vde;
28        ftnint number, type;
29        ftnlen *dims;
30        ftnlen size;
31        extern ftnlen f__typesize[];
32
33        nl = (Namelist *)a->cifmt;
34        PUT('&');
35        for(s = nl->name; *s; s++)
36                PUT(*s);
37        PUT(' ');
38        f__Aquote = 1;
39        vd = nl->vars;
40        vde = vd + nl->nvars;
41        while(vd < vde) {
42                v = *vd++;
43                s = v->name;
44#ifdef No_Extra_Namelist_Newlines
45                if (f__recpos+strlen(s)+2 >= L_len)
46#endif
47                        nl_donewrec();
48                while(*s)
49                        PUT(*s++);
50                PUT(' ');
51                PUT('=');
52                number = (dims = v->dims) ? dims[1] : 1;
53                type = v->type;
54                if (type < 0) {
55                        size = -type;
56                        type = TYCHAR;
57                        }
58                else
59                        size = f__typesize[type];
60                l_write(&number, v->addr, size, type);
61                if (vd < vde) {
62                        if (f__recpos+2 >= L_len)
63                                nl_donewrec();
64                        PUT(',');
65                        PUT(' ');
66                        }
67                else if (f__recpos+1 >= L_len)
68                        nl_donewrec();
69                }
70        f__Aquote = 0;
71        PUT('/');
72        }
Note: See TracBrowser for help on using the repository browser.