home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / f2c / i77lib / xwsne.c < prev   
C/C++ Source or Header  |  2000-06-22  |  981b  |  60 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "lio.h"
  4. #include "fmt.h"
  5.  
  6. #ifdef KR_headers
  7. x_wsne(a) cilist *a;
  8. #else
  9. #include "string.h"
  10.  
  11.  VOID
  12. x_wsne(cilist *a)
  13. #endif
  14. {
  15.     Namelist *nl;
  16.     char *s;
  17.     Vardesc *v, **vd, **vde;
  18.     ftnint *number, type;
  19.     ftnlen *dims;
  20.     ftnlen size;
  21.     static ftnint one = 1;
  22.     extern ftnlen f__typesize[];
  23.  
  24.     nl = (Namelist *)a->cifmt;
  25.     PUT('&');
  26.     for(s = nl->name; *s; s++)
  27.         PUT(*s);
  28.     PUT(' ');
  29.     vd = nl->vars;
  30.     vde = vd + nl->nvars;
  31.     while(vd < vde) {
  32.         v = *vd++;
  33.         s = v->name;
  34.         if (f__recpos+strlen(s)+2 >= L_len)
  35.             (*f__donewrec)();
  36.         while(*s)
  37.             PUT(*s++);
  38.         PUT(' ');
  39.         PUT('=');
  40.         number = (dims = v->dims) ? dims + 1 : &one;
  41.         type = v->type;
  42.         if (type < 0) {
  43.             size = -type;
  44.             type = TYCHAR;
  45.             }
  46.         else
  47.             size = f__typesize[type];
  48.         l_write(number, v->addr, size, type);
  49.         if (vd < vde) {
  50.             if (f__recpos+2 >= L_len)
  51.                 (*f__donewrec)();
  52.             PUT(',');
  53.             PUT(' ');
  54.             }
  55.         else if (f__recpos+1 >= L_len)
  56.             (*f__donewrec)();
  57.         }
  58.     PUT('/');
  59.     }
  60.