00001 #include "f2c.h" 00002 #include "fio.h" 00003 #include "lio.h" 00004 #include "fmt.h" 00005 00006 extern int f__Aquote; 00007 00008 static VOID 00009 nl_donewrec(Void) 00010 { 00011 (*f__donewrec)(); 00012 PUT(' '); 00013 } 00014 00015 #ifdef KR_headers 00016 x_wsne(a) cilist *a; 00017 #else 00018 #include "string.h" 00019 #ifdef __cplusplus 00020 extern "C" { 00021 #endif 00022 00023 VOID 00024 x_wsne(cilist *a) 00025 #endif 00026 { 00027 Namelist *nl; 00028 char *s; 00029 Vardesc *v, **vd, **vde; 00030 ftnint number, type; 00031 ftnlen *dims; 00032 ftnlen size; 00033 extern ftnlen f__typesize[]; 00034 00035 nl = (Namelist *)a->cifmt; 00036 PUT('&'); 00037 for(s = nl->name; *s; s++) 00038 PUT(*s); 00039 PUT(' '); 00040 f__Aquote = 1; 00041 vd = nl->vars; 00042 vde = vd + nl->nvars; 00043 while(vd < vde) { 00044 v = *vd++; 00045 s = v->name; 00046 #ifdef No_Extra_Namelist_Newlines 00047 if (f__recpos+strlen(s)+2 >= L_len) 00048 #endif 00049 nl_donewrec(); 00050 while(*s) 00051 PUT(*s++); 00052 PUT(' '); 00053 PUT('='); 00054 number = (dims = v->dims) ? dims[1] : 1; 00055 type = v->type; 00056 if (type < 0) { 00057 size = -type; 00058 type = TYCHAR; 00059 } 00060 else 00061 size = f__typesize[type]; 00062 l_write(&number, v->addr, size, type); 00063 if (vd < vde) { 00064 if (f__recpos+2 >= L_len) 00065 nl_donewrec(); 00066 PUT(','); 00067 PUT(' '); 00068 } 00069 else if (f__recpos+1 >= L_len) 00070 nl_donewrec(); 00071 } 00072 f__Aquote = 0; 00073 PUT('/'); 00074 } 00075 #ifdef __cplusplus 00076 } 00077 #endif