contrib/libf2c/libI77/xwsne.c

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