libf2c/libI77/xwsne.c

   1 #include "config.h"
   2 #include "f2c.h"
   3 #include "fio.h"
   4 #include "lio.h"
   5 #include "fmt.h"
   6
   7 extern int f__Aquote;
   8
   9  static VOID
  10 nl_donewrec(Void)
  11 {
  12         (*f__donewrec)();
  13         PUT(' ');
  14         }
  15
  16 #ifdef KR_headers
  17 x_wsne(a) cilist *a;
  18 #else
  19 #include <string.h>
  20
  21  VOID
  22 x_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         }