source: vendor/gcc/current/libf2c/libI77/xwsne.c

Last change on this file was 1391, checked in by bird, 21 years ago

GCC v3.3.3 sources.

  • Property cvs2svn:cvs-rev set to 1.1.1.2
  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 1.1 KB
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
9static void
10nl_donewrec (void)
11{
12 (*f__donewrec) ();
13 PUT (' ');
14}
15
16#include <string.h>
17
18void
19x_wsne (cilist * a)
20{
21 Namelist *nl;
22 char *s;
23 Vardesc *v, **vd, **vde;
24 ftnint number, type;
25 ftnlen *dims;
26 ftnlen size;
27 extern ftnlen f__typesize[];
28
29 nl = (Namelist *) a->cifmt;
30 PUT ('&');
31 for (s = nl->name; *s; s++)
32 PUT (*s);
33 PUT (' ');
34 f__Aquote = 1;
35 vd = nl->vars;
36 vde = vd + nl->nvars;
37 while (vd < vde)
38 {
39 v = *vd++;
40 s = v->name;
41#ifdef No_Extra_Namelist_Newlines
42 if (f__recpos + strlen (s) + 2 >= L_len)
43#endif
44 nl_donewrec ();
45 while (*s)
46 PUT (*s++);
47 PUT (' ');
48 PUT ('=');
49 number = (dims = v->dims) ? dims[1] : 1;
50 type = v->type;
51 if (type < 0)
52 {
53 size = -type;
54 type = TYCHAR;
55 }
56 else
57 size = f__typesize[type];
58 l_write (&number, v->addr, size, type);
59 if (vd < vde)
60 {
61 if (f__recpos + 2 >= L_len)
62 nl_donewrec ();
63 PUT (',');
64 PUT (' ');
65 }
66 else if (f__recpos + 1 >= L_len)
67 nl_donewrec ();
68 }
69 f__Aquote = 0;
70 PUT ('/');
71}
Note: See TracBrowser for help on using the repository browser.