xref: /csrg-svn/usr.bin/f77/libI77/wsnmle.c (revision 24100)
1*24100Sjerry /*
2*24100Sjerry  * Copyright (c) 1980 Regents of the University of California.
3*24100Sjerry  * All rights reserved.  The Berkeley software License Agreement
4*24100Sjerry  * specifies the terms and conditions for redistribution.
5*24100Sjerry  *
6*24100Sjerry  *	@(#)wsnmle.c	1.1	07/30/85
7*24100Sjerry  */
8*24100Sjerry 
9*24100Sjerry /*
10*24100Sjerry  *		name-list write
11*24100Sjerry  */
12*24100Sjerry 
13*24100Sjerry #include "fio.h"
14*24100Sjerry #include "lio.h"
15*24100Sjerry #include "nmlio.h"
16*24100Sjerry #include <strings.h>
17*24100Sjerry 
18*24100Sjerry int l_write(), t_putc();
19*24100Sjerry LOCAL char nml_wrt[] = "namelist write";
20*24100Sjerry char namelistkey_ = '&';
21*24100Sjerry 
22*24100Sjerry s_wsne(a) namelist_arglist *a;
23*24100Sjerry {
24*24100Sjerry 	int n, first;
25*24100Sjerry 	struct namelistentry *entries;
26*24100Sjerry 	int *dimptr, *spans, ndim, nelem, offset, vlen, vtype, number;
27*24100Sjerry 	char *nmlist_nm, *cptr;
28*24100Sjerry 
29*24100Sjerry 	nmlist_nm = a->namelist->namelistname;
30*24100Sjerry 	reading = NO;
31*24100Sjerry 	formatted = NAMELIST;
32*24100Sjerry 	fmtbuf = "ext namelist io";
33*24100Sjerry 	if(n=c_le(a,WRITE)) return(n);
34*24100Sjerry 	putn = t_putc;
35*24100Sjerry 	line_len = LINE-1;	/* so we can always add a comma */
36*24100Sjerry 	curunit->uend = NO;
37*24100Sjerry 	leof = NO;
38*24100Sjerry 	if(!curunit->uwrt && ! nowwriting(curunit)) err(errflag, errno, nml_wrt)
39*24100Sjerry 
40*24100Sjerry 	/* begin line with " &namelistname " */
41*24100Sjerry 	if(recpos != 0)
42*24100Sjerry 		PUT('\n')  /* PUT() adds blank */
43*24100Sjerry 	else
44*24100Sjerry 		PUT(' ');
45*24100Sjerry 	PUT(namelistkey_);
46*24100Sjerry 	while(*nmlist_nm != '\0') PUT(*nmlist_nm++);
47*24100Sjerry 	PUT(' ');
48*24100Sjerry 
49*24100Sjerry 	/* now loop through entries writing them out */
50*24100Sjerry 	entries = a->namelist->names;
51*24100Sjerry 	first = 1;
52*24100Sjerry 	while( entries->varname[0] != 0 )
53*24100Sjerry 	{
54*24100Sjerry 		/* write out variable name and '=' */
55*24100Sjerry 		cptr = entries->varname;
56*24100Sjerry 		chk_len( strlen(cptr) + 3);
57*24100Sjerry 		if(first++ != 1) PUT(',');
58*24100Sjerry 		PUT(' ');
59*24100Sjerry 		while( *cptr != '\0') PUT(*cptr++);
60*24100Sjerry 		PUT('=');
61*24100Sjerry 
62*24100Sjerry 		/* how many value are there? */
63*24100Sjerry 		if( (dimptr = entries->dimp) == NULL ) number = 1;
64*24100Sjerry 		else number = dimptr[1];
65*24100Sjerry 		/* what is element length? */
66*24100Sjerry 		vlen = entries->typelen;
67*24100Sjerry 		/* get type */
68*24100Sjerry 		vtype = entries->type;
69*24100Sjerry 
70*24100Sjerry 		if(n=l_write( &number, entries->varaddr, vlen, vtype ))
71*24100Sjerry 				err(errflag,n,nml_wrt);
72*24100Sjerry 		entries++;
73*24100Sjerry 	}
74*24100Sjerry 	PUT('\n');
75*24100Sjerry 	PUT(namelistkey_);
76*24100Sjerry 	cptr = "end\n";
77*24100Sjerry 	while(*cptr != '\0') PUT(*cptr++);
78*24100Sjerry 	return(OK);
79*24100Sjerry }
80*24100Sjerry 
81*24100Sjerry LOCAL
82*24100Sjerry t_putc(c) char c;
83*24100Sjerry {
84*24100Sjerry 	if(c=='\n') {
85*24100Sjerry 		recpos=0;
86*24100Sjerry 	} else if(recpos == 0) {
87*24100Sjerry 		putc(' ',cf);		/* for namelist,	   */
88*24100Sjerry 		recpos = 2;		/* never print in column 1 */
89*24100Sjerry 	} else {
90*24100Sjerry 		recpos++;
91*24100Sjerry 	}
92*24100Sjerry 	putc(c,cf);
93*24100Sjerry 	return(OK);
94*24100Sjerry }
95