xwsne.c   [plain text]

#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "lio.h"
#include "fmt.h"

extern int f__Aquote;

static void
nl_donewrec (void)
{
  (*f__donewrec) ();
  PUT (' ');
}

#include <string.h>

void
x_wsne (cilist * a)
{
  Namelist *nl;
  char *s;
  Vardesc *v, **vd, **vde;
  ftnint number, type;
  ftnlen *dims;
  ftnlen size;
  extern ftnlen f__typesize[];

  nl = (Namelist *) a->cifmt;
  PUT ('&');
  for (s = nl->name; *s; s++)
    PUT (*s);
  PUT (' ');
  f__Aquote = 1;
  vd = nl->vars;
  vde = vd + nl->nvars;
  while (vd < vde)
    {
      v = *vd++;
      s = v->name;
#ifdef No_Extra_Namelist_Newlines
      if (f__recpos + strlen (s) + 2 >= L_len)
#endif
	nl_donewrec ();
      while (*s)
	PUT (*s++);
      PUT (' ');
      PUT ('=');
      number = (dims = v->dims) ? dims[1] : 1;
      type = v->type;
      if (type < 0)
	{
	  size = -type;
	  type = TYCHAR;
	}
      else
	size = f__typesize[type];
      l_write (&number, v->addr, size, type);
      if (vd < vde)
	{
	  if (f__recpos + 2 >= L_len)
	    nl_donewrec ();
	  PUT (',');
	  PUT (' ');
	}
      else if (f__recpos + 1 >= L_len)
	nl_donewrec ();
    }
  f__Aquote = 0;
  PUT ('/');
}