home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / f2csrc.zip / f2csrc / libI77 / xwsne.c < prev   
C/C++ Source or Header  |  1994-07-28  |  1KB  |  69 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "lio.h"
  4. #include "fmt.h"
  5.  
  6.  static VOID
  7. nl_donewrec(Void)
  8. {
  9.     (*f__donewrec)();
  10.     PUT(' ');
  11.     }
  12.  
  13. #ifdef KR_headers
  14. x_wsne(a) cilist *a;
  15. #else
  16. #include "string.h"
  17.  
  18.  VOID
  19. x_wsne(cilist *a)
  20. #endif
  21. {
  22.     Namelist *nl;
  23.     char *s;
  24.     Vardesc *v, **vd, **vde;
  25.     ftnint *number, type;
  26.     ftnlen *dims;
  27.     ftnlen size;
  28.     static ftnint one = 1;
  29.     extern ftnlen f__typesize[];
  30.  
  31.     nl = (Namelist *)a->cifmt;
  32.     PUT('&');
  33.     for(s = nl->name; *s; s++)
  34.         PUT(*s);
  35.     PUT(' ');
  36.     vd = nl->vars;
  37.     vde = vd + nl->nvars;
  38.     while(vd < vde) {
  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 : &one;
  50.         type = v->type;
  51.         if (type < 0) {
  52.             size = -type;
  53.             type = TYCHAR;
  54.             }
  55.         else
  56.             size = f__typesize[type];
  57.         l_write(number, v->addr, size, type);
  58.         if (vd < vde) {
  59.             if (f__recpos+2 >= L_len)
  60.                 nl_donewrec();
  61.             PUT(',');
  62.             PUT(' ');
  63.             }
  64.         else if (f__recpos+1 >= L_len)
  65.             nl_donewrec();
  66.         }
  67.     PUT('/');
  68.     }
  69.