xref: /csrg-svn/usr.bin/f77/libI77/wsnmle.c (revision 42027)
124100Sjerry /*
224100Sjerry  * Copyright (c) 1980 Regents of the University of California.
324100Sjerry  * All rights reserved.  The Berkeley software License Agreement
424100Sjerry  * specifies the terms and conditions for redistribution.
524100Sjerry  *
6*42027Sbostic  *	@(#)wsnmle.c	5.3	05/15/90
724100Sjerry  */
824100Sjerry 
924100Sjerry /*
1024100Sjerry  *		name-list write
1124100Sjerry  */
1224100Sjerry 
1324100Sjerry #include "fio.h"
1424100Sjerry #include "lio.h"
1524100Sjerry #include "nmlio.h"
16*42027Sbostic #include <string.h>
1724100Sjerry 
1824100Sjerry int l_write(), t_putc();
1924100Sjerry LOCAL char nml_wrt[] = "namelist write";
2024100Sjerry char namelistkey_ = '&';
2124100Sjerry 
2224100Sjerry s_wsne(a) namelist_arglist *a;
2324100Sjerry {
2424100Sjerry 	int n, first;
2524100Sjerry 	struct namelistentry *entries;
2624100Sjerry 	int *dimptr, *spans, ndim, nelem, offset, vlen, vtype, number;
2724100Sjerry 	char *nmlist_nm, *cptr;
2824100Sjerry 
2924100Sjerry 	nmlist_nm = a->namelist->namelistname;
3024100Sjerry 	reading = NO;
3124100Sjerry 	formatted = NAMELIST;
3224100Sjerry 	fmtbuf = "ext namelist io";
3324100Sjerry 	if(n=c_le(a,WRITE)) return(n);
3424100Sjerry 	putn = t_putc;
3524100Sjerry 	line_len = LINE-1;	/* so we can always add a comma */
3624100Sjerry 	curunit->uend = NO;
3724100Sjerry 	leof = NO;
3824100Sjerry 	if(!curunit->uwrt && ! nowwriting(curunit)) err(errflag, errno, nml_wrt)
3924100Sjerry 
4024100Sjerry 	/* begin line with " &namelistname " */
4124100Sjerry 	if(recpos != 0)
4224145Sjerry 		PUT('\n');  /* PUT() adds blank */
4324100Sjerry 	PUT(namelistkey_);
4424100Sjerry 	while(*nmlist_nm != '\0') PUT(*nmlist_nm++);
4524100Sjerry 	PUT(' ');
4624100Sjerry 
4724100Sjerry 	/* now loop through entries writing them out */
4824100Sjerry 	entries = a->namelist->names;
4924100Sjerry 	first = 1;
5024100Sjerry 	while( entries->varname[0] != 0 )
5124100Sjerry 	{
5224100Sjerry 		/* write out variable name and '=' */
5324100Sjerry 		cptr = entries->varname;
5424100Sjerry 		chk_len( strlen(cptr) + 3);
5524100Sjerry 		if(first++ != 1) PUT(',');
5624100Sjerry 		PUT(' ');
5724100Sjerry 		while( *cptr != '\0') PUT(*cptr++);
5824100Sjerry 		PUT('=');
5924100Sjerry 
6024100Sjerry 		/* how many value are there? */
6124100Sjerry 		if( (dimptr = entries->dimp) == NULL ) number = 1;
6224100Sjerry 		else number = dimptr[1];
6324100Sjerry 		/* what is element length? */
6424100Sjerry 		vlen = entries->typelen;
6524100Sjerry 		/* get type */
6624100Sjerry 		vtype = entries->type;
6724100Sjerry 
6824100Sjerry 		if(n=l_write( &number, entries->varaddr, vlen, vtype ))
6924100Sjerry 				err(errflag,n,nml_wrt);
7024100Sjerry 		entries++;
7124100Sjerry 	}
7224100Sjerry 	PUT('\n');
7324100Sjerry 	PUT(namelistkey_);
7424100Sjerry 	cptr = "end\n";
7524100Sjerry 	while(*cptr != '\0') PUT(*cptr++);
7624100Sjerry 	return(OK);
7724100Sjerry }
7824100Sjerry 
7924100Sjerry LOCAL
8024100Sjerry t_putc(c) char c;
8124100Sjerry {
8224100Sjerry 	if(c=='\n') {
8324100Sjerry 		recpos=0;
8424100Sjerry 	} else if(recpos == 0) {
8524100Sjerry 		putc(' ',cf);		/* for namelist,	   */
8624100Sjerry 		recpos = 2;		/* never print in column 1 */
8724100Sjerry 	} else {
8824100Sjerry 		recpos++;
8924100Sjerry 	}
9024100Sjerry 	putc(c,cf);
9124100Sjerry 	return(OK);
9224100Sjerry }
93