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

Last change on this file was 2, checked in by bird, 22 years ago

Initial revision

  • Property cvs2svn:cvs-rev set to 1.1
  • 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
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.