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

Revision 14548, 1.1 KB checked in by ghudson, 24 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14547, which included commits to RCS files with non-trunk default branches.
Line 
1#include "f2c.h"
2#include "fio.h"
3#include "lio.h"
4#include "fmt.h"
5
6extern int f__Aquote;
7
8 static VOID
9nl_donewrec(Void)
10{
11        (*f__donewrec)();
12        PUT(' ');
13        }
14
15#ifdef KR_headers
16x_wsne(a) cilist *a;
17#else
18#include <string.h>
19
20 VOID
21x_wsne(cilist *a)
22#endif
23{
24        Namelist *nl;
25        char *s;
26        Vardesc *v, **vd, **vde;
27        ftnint *number, type;
28        ftnlen *dims;
29        ftnlen size;
30        static ftnint one = 1;
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 : &one;
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.