/*

  Copyright (C) 2000, 2001, Silicon Graphics, Inc.  All Rights Reserved.

   Path64 is free software; you can redistribute it and/or modify it
   under the terms of the GNU Lesser General Public License as published by
   the Free Software Foundation version 2.1

   Path64 is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with Path64; see the file COPYING.  If not, write to the Free
   Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
   02110-1301, USA.

   Special thanks goes to SGI for their continued support to open source

*/



#pragma ident "@(#) libf/fio/rnl90to77.c	92.3	06/21/99 10:37:55"

#include <inttypes.h>
#include <stdio.h>
#include <errno.h>
#include <liberrno.h>
#include <fortran.h>
#include <stdlib.h>
#include <cray/fmtconv.h>
#include <cray/nassert.h>
#if !defined(_ABSOFT)
#include <sys/unistd.h>
#endif
#include "fio.h"
#include "namelist.h"
#include "rnl90def.h"
#include "fmt.h"
#include <inttypes.h>

/* EXTERNAL entry points */
extern int _s_scan_extensions(void *ptr, ftype_t type, unsigned elsize,
	long *field_begin, unsigned rec_chars, int *fwptr, long cmode);
extern int _nicverr(const int _Nicverror);

/* use SUBGTC when the character retrieval cannot hit an end of file until
 * the retrieval is complete.  This occurs when retrieving the characters of
 * a name.  CMTSUBGT is the same except a constant is allowed in the scan.
 * These two macros are used from functions outside the main namelist FRN
 * routine.
 */

#define SUBGTC(x) { \
	while (cup->ulinecnt == 0) {				\
		if (errn = _nlrd_fillrec(css, cup, echoptr)) {	\
			return(errn);				\
		}						\
	}							\
	x	= (char) *cup->ulineptr++;			\
	cup->ulinecnt--;					\
}

#define CMTSUBGT(x) { \
	while (cup->ulinecnt == 0) {				\
		if (errn = _nlrd_fillrec(css, cup, echoptr)) {	\
			return(errn);				\
		}						\
	}							\
	x	= (char) *cup->ulineptr++;			\
	/* An f90 input comment is now part of RNLCOMM */	\
	if (MATCH(x, _MASKS, MRNLCOMM)) {			\
		x	= ' ';					\
		cup->ulinecnt	= 1;				\
	}							\
	cup->ulinecnt--;					\
}

#define CMTSUBGTNOEOR(x) { \
	if (cup->ulinecnt == 0) {				\
		x	= ' ';					\
	} else {						\
		x	= (char) *cup->ulineptr++;		\
		cup->ulinecnt--;				\
	}							\
	/* An f90 input comment is now part of RNLCOMM */	\
	if (MATCH(x, _MASKS, MRNLCOMM)) {			\
		x	= ' ';					\
		cup->ulinecnt	= 1;				\
	}							\
}

/* use MAINGT when the character retrieval can hit an end of file before 
 * retrieval is complete.  This occurs when retrieving '=', delimiters,
 * , etc.  CMTMAINGT is the same except a comment is allowed in the scan.
 * These two macros are used from functions within the main namelist FRN
 * routine.
 */

#define MAINGT(x) { \
	while (cup->ulinecnt == 0) {					\
		if (errn = _nlrd_fillrec(css, cup, echoptr)) {		\
			if (errn < 0) {				\
				ENDD(endf, css, FERDPEOF);		\
			}						\
			else {						\
				ERROR0(errf, css, errn);		\
			}						\
		}							\
	}								\
	x	= (char) *cup->ulineptr++;				\
	cup->ulinecnt--;						\
}

#define CMTMAINGT(x) { \
	while (cup->ulinecnt == 0) {					\
		if (errn = _nlrd_fillrec(css, cup, echoptr)) {		\
			if (errn < 0) {				\
				ENDD(endf, css, FERDPEOF);		\
			}						\
			else {						\
				ERROR0(errf, css, errn);		\
			}						\
		}							\
	}								\
	x	= (char) *cup->ulineptr++;				\
	/* An f90 input comment is now part of RNLCOMM */		\
	if (MATCH(x, _MASKS, MRNLCOMM)) {				\
		x	= ' ';						\
		cup->ulinecnt	= 1;					\
	}								\
	cup->ulinecnt--;						\
}

#define GETSECTION(x) { \
		field_begin	= cup->ulineptr;			\
		field_end	= cup->ulineptr;			\
		for (j = 0; j < cup->ulinecnt; j++) {			\
			x	= (char) *field_end;			\
			if (x == ')' || x == ',' || x == ':')		\
				break;					\
			field_end++;					\
		}							\
		field_width	= j;					\
}

/*
 * Use GETSTR77 to read a character string surrounded by quotes or
 * apostrophes. Comment characters are not recognized as such inside a
 * quoted string, so SUBGTC is used.  Skip the ending blank.
 */
#define GETSTR77() {							\
	if (cup->ulinecnt <= 1) {					\
		SUBGTC(ch);						\
	}								\
	SUBGTC(ch);							\
	if (ch == enddelim) {						\
		eos	= -1; /* end of string */			\
		SUBGTC(ch); /* unless string delimiter is doubled */	\
		if (ch == enddelim)					\
		eos	= 0;						\
		else {							\
			cup->ulineptr--;				\
			cup->ulinecnt++;				\
		}							\
	}								\
}

/*
 * eunit is unit for echoing inpt.  If rnlecho is 1, always echo.
 * If rnlecho is 0, echo only if 'E' in first column.
 */

struct Echoinfo {
	unum_t	eunit;
	int	rnlecho;
};

/*
 *	This table is used to drive the f90 input conversion based on the
 *	type of the data.
 */
ic_func *ncf_tab77[] = {
	NULL,		/* DVTYPE_UNUSED */
	NULL,		/* DVTYPE_TYPELESS */
	_iu2s,		/* DVTYPE_INTEGER */
	_defgu2sd,	/* DVTYPE_REAL */
	_defgu2sd,	/* DVTYPE_COMPLEX */
	NULL,		/* DVTYPE_LOGICAL */
	NULL,		/* DVTYPE_ASCII */
};


/* MATCH(c,a,b) determines whether the bit for character 'c' is set.
 * a[b] and a[b+1] are bit masks for each ASCII character
 */
#define MATCH(c,a,b)	(a[(c >= 0x3f) ? b+1 : b] & (1 << (IND(c))))

/* IND computes the bit index of a character */
#define IND(c)	((c >= 0x3f) ? 0x7f - (unsigned)c : (unsigned)(0x40 - c - 1))

static void _nlrdecho(unum_t eunit, long *input_ptr, long nchrs, FIOSPTR css);

static int _nlrd_fillrec(FIOSPTR css, unit *cup, struct Echoinfo *echoptr);

static void _setunit(char *string, void *u);

static int _getname(FIOSPTR css, unit *cup, char *buf, char *lastc,
	struct Echoinfo *echoptr);

static void _pr_echomsg(char *string);

static void _cnvrt_toupper(char *bufr);

static int _ishol(long *hlptr, unit *cup);

static nmlist_goli_t *_findname(char *key, nmlist_goli_t *nlvar,
		unsigned countitm);

static int _getnlval(FIOSPTR css, nmlist_goli_t *nlvar, char *lastc, 
	unit *cup, struct Echoinfo *echoptr);

static int _indx_nl(FIOSPTR css, unit *cup, struct Echoinfo *echoptr,
	long *begcnt, int *ndim, long strbegend[3], int *encnt, int *icnt,
	int arryflag);

static int _nlread(FIOSPTR css, ftype_t type, void *ptr, int cnt, int inc,
	char *lastc, unit *cup, struct Echoinfo *echoptr, int elsize);

static int _nexdata(FIOSPTR css, ftype_t type, void *ptr, int cnt, int inc,
	char lastc, unit *cup, struct Echoinfo *echoptr, long *lval,
	int *lcount, int elsize, int *nullvlu);

static int _g_charstr(FIOSPTR css, unit *cup, void *p, int cnt, char c,
	struct Echoinfo *echoptr, int lcount,int elsize, int *nullvlu);

static int _g_complx(FIOSPTR css, unit *cup, ftype_t type,
	struct Echoinfo *echoptr, long *lval,int elsize);

static int _g_number(ftype_t type, unit *cup,long *lval, int elsize);

static int _gocthex(FIOSPTR css, unit *cup, ftype_t type,
	struct Echoinfo *echoptr, long *lval, int base, int elsize,
	int *nullvlu);

static int _get_holl(FIOSPTR css, unit *cup, char holltype, int count,
	ftype_t type, struct Echoinfo *echoptr, long *lval, int elsize);

static int _get_quoholl(FIOSPTR css, unit *cup, char cdelim, ftype_t type,
	struct Echoinfo *echoptr, long *lval, int elsize);

/*
 *	_rnl90to77 - called by wnl90.c to process a cf77 namelist input
 *		file.
 *	Synopsis
 *		int _rnl90to77(FIOSPTR css,
 *				unit *cup,
 *				nmlist_group *namlist,
 *				void *stck,
 *				int errf);
 *		Where
 *			css	- pointer to css
 *			cup	- pointer to unit information
 *			namlist - pointer to the namelist table.
 *			stck	- pointer to stack space which is passed
 *				  to each call to _FRU for a particular
 *				  statement.  This is used by the library.
 *			errf	- error processing flag.
 *			endf	- end processing flag.
 *	Return value
 *		errn
 */

int
_rnl90to77(
	FIOSPTR		css,
	unit		*cup,
	nmlist_group	*namlist,
	void		*stck,
	int		errf,
	int		endf)
{
	long		stat;
	long		*hlptr;
	int		ret;
	int		ss;
	char		buf[MAXNAML + 5], c;
	char		skipmsg[sizeof(SKIPMSG) + sizeof(UNITSTR) +
				MAXNAML + 8 + 2];
	char		tmpbuf[MXUNITSZ];/* Unit number buffer for warn msgs */
	int		errn;		/* Error number			*/
	long		flag;		/* Error flag			*/
	unum_t		unum;		/* Actual unit number		*/
	unsigned	rlen;		/* group name length		*/
	unsigned	rcount;		/* count of namelist items	*/
	char		*rptr;		/* pointer to group name	*/
	char		*varptr;	/* ptr to group_obj_list item	*/
	unsigned	varlen;		/* len of group_obj_list name	*/
	nmlist_goli_t	*nlvar;		/* ptr to next variable entry	*/
	nmlist_goli_t	*fdvar;		/* ptr to next variable entry	*/
	ftype_t		type;
	struct Echoinfo echoinfo;
	struct Echoinfo *echoptr;
	type		= DVTYPE_UNUSED;
	varptr		= NULL;

/* **************************************************************************
 *	Data Transfer Section
 ************************************************************************* */

	unum	= cup->uid;
	echoptr	= &echoinfo;

	/* set up extended record. */
	if (cup->ulinecnt == 0)
		cup->ulinecnt	= 1;
	*(cup->ulinebuf + cup->ulinecnt)	= (_f_int) BLANK;
	(void) strcpy(skipmsg, SKIPMSG);

	/* Set up the unit used for echoing input lines */
	if (_OUT_UNIT < 0) {
		echoinfo.eunit	= 101; /* default = stdout */
		echoinfo.rnlecho = 0; /* no echo til 'E' in col 1 */
	}
	else {
		echoinfo.eunit	= _OUT_UNIT;
		echoinfo.rnlecho = 1;	/* always echo, ignore col1 */
	}
	/* Input record preREAD before this point.  Check for echoing. */
	if ((echoptr->rnlecho) ||
	    (MATCH(*cup->ulinebuf, _MASKS, MRNLFLAG))) {
		/* Begin echoing input */
		echoptr->rnlecho	= 1;
		_nlrdecho(echoptr->eunit, cup->ulinebuf, cup->ulinecnt, css);
	}
	cup->ulineptr	= cup->ulinebuf + 1;
fill:
	while (cup->ulinecnt == 0) {
		errn	= _nlrd_fillrec(css, cup, &echoinfo);
		if (errn != 0)
			goto err_eof;
	}
fill1:
	do {
		CMTMAINGT(c)
	} while (ISBLANK(c));
	if (!(MATCH(c, _MASKS, MRNLDELIM))) {
		/* irix f77 and cft77 skip the input record when the
		 * first nonblank character is not a dollar sign or
		 * an ampersand which delimits a namelist group name.
		 */
		cup->ulinecnt	= 0;
		goto fill;	/* Comment statement */
	}

	/* get first character of namelist group name from input record */
	MAINGT(c);
	/* and get namelist group name from input record */
	errn	= _getname(css, cup, buf, &c, &echoinfo);
	if (errn != 0)
		goto err_eof;
	/* convert group name to uppercase */
	_cnvrt_toupper(buf);

	assert ( (cup != NULL));
	rcount	= namlist->icount;	/* number of name table entries	*/
	rptr	= _fcdtocp(namlist->group_name);/* ptr to groupname */
	rlen	= _fcdlen(namlist->group_name);	/* len of groupname */
	nlvar	= namlist->goli;		/* group object ptr	*/

	if (strncmp(rptr,buf,rlen)) {
		int i;
		/* do not put out skipped record message for assign -f
		 * irixf77 or irixf90 option, or 'assign -Y on' option.
		 */
		if ((cup->ufnl_skip != 0) ||
		    (cup->ufcompat == AS_IRIX_F77) ||
		    (cup->ufcompat == AS_IRIX_F90))
			goto get_delim;
		if (_SKP_MESS > 0) {
			/* Skip record and issue a logfile message */
			(void) strcpy(&skipmsg[sizeof(SKIPMSG)-1], buf);
			(void) strcat(skipmsg, UNITSTR);
			_setunit(tmpbuf, &unum);
			/*
			 * The following truncates the file name/unit number
			 * to seven characters, which will result in a loss
			 * of information when the unit number is larger than
			 * 9,999,999.
			 */
			(void) strncat(skipmsg, tmpbuf, sizeof(long) - 1);
			(void) strcat(skipmsg, "\n");
			_pr_echomsg(skipmsg);
		}
		else if (_SKP_MESS < 0) {
			/* Abort job or go to optional ERR= branch */
			errn	= FENLIVGP;
			ERROR1(errf, css, errn, buf);
		}
get_delim:
		/* the name is not the namelist group name needed,
		 * read until delimiter found.
		 */
		while (!MATCH(c, _MASKS, MRNLDELIM) && c != '/') {
			if (c == '\'' || c == '"') {
				char	qchar;
				qchar	= c;
rquote:
				do {
					MAINGT(c);
				} while (c != qchar);
				MAINGT(c);
				/* check for double quote */
				if (c == qchar)
					goto rquote;
			}
			else {
				CMTMAINGT(c);
			}
		}
		/*
		 * Try to determine whether delimiter is part of a
		 * Hollerith string by looking back in record.  If it
		 * is part of a Hollerith string, it's not really an
		 * end delimiter.
		 */
		hlptr	= cup->ulineptr - 2;
		/*
		 * Search for nH, nh, nl, nL, nr, nR where n = digit.
		 * Only look back the number of characters in a default
		 * integer or to the beginning of this line of input
		 */
		for (i = 0; i < (sizeof(_f_int)) &&
		   hlptr > &cup->ulinebuf[2]; i++, hlptr--) {
			switch((char) *hlptr) {
				case 'h':
				case 'H':
				case 'l':
				case 'L':
				case 'r':
				case 'R':
					if (_ishol(hlptr, cup)) {
						CMTMAINGT(c);
						goto get_delim;
					}
					break;
				default:
					break;
			} /* switch */
		}
		goto fill1;
	}
	/*
	 *	This is the correct namelist group name.  Process the
	 *	input record. Read until the input record or records
	 *	until the terminating character is found.  This is a
	 *	slash or ampersand or MRNLDELIM.
 	 */
	while (c != '/') { 
		int	sepcnt;
		if (MATCH(c, _MASKS, MRNLDELIM))
			goto finalization;
		/* get group_object_name from input record */
		errn	= _getname(css, cup, buf, &c, &echoinfo);
		if (errn != 0)
			goto err_eof;
		_cnvrt_toupper(buf);
		/* find matching group_object_name from namelist table */
		if (!(fdvar = _findname(buf, nlvar, rcount))) {
			if (strlen(buf) > 0) {
				/* An objectlistname in input record */
				errn	= FENLNREC;
				ERROR1(errf, css, errn, buf);
			}
			else {
				/* No object list name in input record */
				errn	= 0; /* empty variable entry */
				goto finalization;
			}
		}
		/* we're positioned just after the object name
		 * so get following value(s)
		 */
		errn	= _getnlval(css, fdvar, &c, cup, &echoinfo);
		if (errn != 0)
			goto err_eof;
		sepcnt	= 0;
		for ( ; ; ) {
			if (!(ISBLANK(c))) {
				if ((MATCH(c, _MASKS, MRNLSEP)) &&
				    (sepcnt == 0)) {
					/* skip separator */
					sepcnt++;
				}
				else
					break;
			}
			CMTMAINGT(c);
		}
	}

/***************************************************************************
 *	Statement Finalization Section
 ***************************************************************************/
finalization:
	return(errn);
err_eof:
	/* err and eof handling */
	if(errn < 0) {
		ENDD(endf, css, FERDPEOF);
	} else if (errn == FENLSTRN || errn == FENLSTRG ||
		   errn == FENLSUBD || errn == FENLSUBN ||
		   errn == FENLSUBS || errn == FENLIVIT ||
		   errn == FENLARSC || errn == FENLLGNM ||
		   errn == FENLUNKI || errn == FENLUNKN) {
			ERROR1(errf, css, errn, buf);
	} else {
		ERROR0(errf, css, errn);
	}
	goto finalization;
}

/* _nlrd_fillrec - namelist read of one record from a file
 *	returns		0 - successful
 *			EOF - end of file
 *			ERR - error was encountered
 *			cup->uend is set if EOF encountered
 */

static int
_nlrd_fillrec(FIOSPTR css, unit *cup, struct Echoinfo *echoptr)
{
	register int	errn;

	errn	= css->u.fmt.endrec(css, cup, 1);

	if (errn != 0) {
		return(errn);
	} else {
		if (cup->ulinecnt == 0)
			cup->ulinecnt	= 1; /* Assume it has 1 blank */
		/* Add a blank character to end of record */
		*(cup->ulinebuf + cup->ulinecnt)	= (long) BLANK;
		if ((echoptr->rnlecho) ||
		    (MATCH(*cup->ulinebuf, _MASKS, MRNLFLAG))) {
			/* Begin echoing input */
			echoptr->rnlecho	= 1;
			_nlrdecho(echoptr->eunit, cup->ulinebuf,
				cup->ulinecnt, css);
		}
		/* Always skip the first character in a record.
		 * Don't adjust ulinecnt because blank added at the end.
		 */
		cup->ulineptr++;
	}
	return(errn);
}

/*
 *	_getname - Get variable name or group name
 *
 *	On entry:
 *		- Positioned to a name possibly preceded by blanks
 *	On exit:
 *		- 0 if successful
 *		  EOF if end of file read
 *		  > 0 if other error (errno will be set)
 *		- *cup->ulineptr is record position after the name.
 *		- *lastc contains the last character read.
 *	In looking for the name, we stop when we see a space, '=', or
 *	'(', or delimiter ('&'), or the replacement character for '='.
 */

static int
_getname(FIOSPTR css, unit *cup, char *s, char *lastc, struct Echoinfo *echoptr)
{
	char	*p, c;
	int	n, errn;
	errn 	= 0;
	n	= MAXNAML + 5; /* real*16 input can be 34 characters long */
	p	= s;
	c	= *lastc;
	/*
	 * Names cannot have embedded blanks.  In cf77 compatibility mode,
	 * a comment can immediately follow the name and will terminate it.
	 */
	while (ISBLANK(c))
		CMTSUBGT(c);

	while (!(ISBLANK(c)) && (c != '(') && !(MATCH(c, _MASKS, MRNLREP)) &&
	       !(MATCH(c, _MASKS, MRNLDELIM)) && (c != '/')) {
		*p++	= c;
		CMTSUBGTNOEOR(c);
		if (n-- == 0) {
			errn	= FENLLGNM;	/* name too long */
			p--;
			break;
		}
	}
	*lastc	= c;
	*p	= '\0';
	return (errn);
}

/*
 * _findname - find variable name in list of nmlist_goli_t entries
 *		of namelist table
 * On entry:
 *	- lastc points to character following name in input buffer.
 * Returns:
 *	pointer to matching object list entry
 *	NULL if variable name was not found.
 */

static nmlist_goli_t
*_findname(char *key, nmlist_goli_t *nlvar, unsigned countitm)
{
	char		*varptr;
	unsigned	varlen;
	nmlist_goli_t	*newitem;
	int		cnt, lcnt;

	newitem	= nlvar;
	cnt	= countitm;
	lcnt	= strlen(key);

	while (cnt--) {
		varptr	= _fcdtocp(newitem->goli_name);
		varlen	= _fcdlen(newitem->goli_name);
		if ((varlen == lcnt) && (!strncmp(key, varptr, lcnt)))
			return (newitem);
		else
#if defined(__mips) && (_MIPS_SZLONG == 32)
			newitem	= (nmlist_goli_t*)((long *)newitem +
				3 + (sizeof(_fcd))/(sizeof(long)));
#else
			newitem	= (nmlist_goli_t*)((long *)newitem +
				2 + (sizeof(_fcd))/(sizeof(long)));
#endif
	}
	return (NULL);
}

/* _getnlval - get values for namelist io
 *
 * On entry:
 *	- positioned after variable name
 *	- lastc contains the character following the name
 * On exit:
 *	- *lastc contains the character following the value
 *	- cup->ulineptr is pointing to the character following lastc
 * 	- returns: 0 if successful
 *		-value if EOF detected
 *		> 0 if error detected
 */

static int
_getnlval(FIOSPTR css, nmlist_goli_t *nlvar, char *lastc, unit *cup,
	struct Echoinfo *echoptr)
{
	long		ss, cntp;
	long		stat;
	int		ndim = 0;
	int		i;
	int		encnt = 0;
	int		icnt = 0;
	long		begcnt[MAXDIM];
	long		strbegend[3];
	char		*cp;
	char		c;
	long		vaddr;
	long		errn = 0;
	/* clear array element and substring information */
	for (i=0; i < MAXDIM; i++) {
		begcnt[i]	= 0;
	}
	strbegend[0]	= -1;
	strbegend[1]	= -1;
	strbegend[2]	= -1;

	switch (nlvar->valtype) {
	case IO_SCALAR:
	{
		nmlist_scalar_t *nlscalar; /* nmlist scalar entry */
		unsigned	elsize;
		unsigned	int_len;
		void		*vaddr;
		ftype_t		type;	/* fortran data type */

		nlscalar	= nlvar->goli_addr.ptr; /* ptr to scalar */
		type	= nlscalar->tinfo.type;
		int_len	= nlscalar->tinfo.int_len;
		/* Assertions */
		assert (type >= DVTYPE_TYPELESS && type <= DVTYPE_ASCII);
		assert(nlscalar->tinfo.int_len > 0 );
		if ((type != DVTYPE_ASCII) && (*lastc == '(')) {
			errn	= FENLUNKI;
			break;
		}
		if (type == DVTYPE_ASCII)
			strbegend[0]	= 0;
		/* find offset if indexed array */
		if (*lastc == '(') {
			errn	= _indx_nl(css, cup, echoptr, begcnt, &ndim,
					strbegend, &encnt, &icnt, 0);
			if (errn != 0) {
				if (errn == FENLSUBS)
					errn	= FENLSTRG;
				else if (errn == FENLSUBN)
					errn	= FENLSTRN;
				break;
			}
		}
		else {
			while (ISBLANK(*lastc)) {
				CMTSUBGT(*lastc);
			}
			if (MATCH(*lastc, _MASKS, MRNLDELIM) ||
			    (*lastc == '/')) {
				errn	= 0;
				break;
			}
			/* match '=' or special character */
			if (!(MATCH(*lastc, _MASKS, MRNLREP))) {
				errn	= FENLNOVL;
				break;
			}
		}
		CMTSUBGT(*lastc);

		/* Currently positioned after the '=' sign, but lastc is
		 * pointing at the '=' sign.  Update lastc for nlread and
		 * compute:
	 	 * cntp = number of array elements to be read
	 	 *	(1 if not an array).
	 	 * elsize = size of a variable or array element
	 	 *	(words for nonchar, bytes for char).
	 	 * vaddr = target address for the input value.  For
	 	 *	character, a Fortran character descriptor.
	 	 */
		if (type == DVTYPE_ASCII) {
			char	*wptr;
			const int bytesperchar = 1;
			int 	begt	= strbegend[1];
			int 	endt	= strbegend[2];
			wptr	= _fcdtocp(nlscalar->scal_addr.charptr);
			elsize	= _fcdlen(nlscalar->scal_addr.charptr);
			elsize	= elsize * bytesperchar;
			/* check for character substrings in input record */
			if (strbegend[0] > 0) {
				if (begt < 1 )
					begt	= 1;
				else if (begt > elsize) {
					errn	= FENLUNKN;
					break;
				}
				if (endt < 1 )
					endt	= elsize;
				else if ((endt > elsize) || (endt < begt)) {
					errn	= FENLUNKN;
					break;
				}
				wptr	= wptr + (begt - 1);
				elsize	= (endt - begt) + 1;
			}
			vaddr	= wptr;
		}
		else {
			vaddr	= nlscalar->scal_addr.ptr;
			elsize	= int_len >> 3;
		}
		c	= *lastc;
		cntp	= 1;
		errn	= _nlread(css, type, vaddr, cntp, 0, &c, cup, echoptr,
				elsize);
		*lastc	= c;
		break;
	}
	case IO_DOPEVEC:
	{
		struct DvDimen	*dvdimn;
		struct DvDimen	dimen[MAXDIM];
		DopeVectorType	*nldv;
		unsigned	elsize;
		unsigned	extent = 1;
		unsigned	int_len;
		void		*vaddr;
		int		nc, mult, offs;
		ftype_t		type;	/* fortran data type */
		nldv	= nlvar->goli_addr.dv; /* ptr to dope vector */
		mult	= 1;
		offs	= 0;

		/* Assertions */
		assert ( nldv != NULL );
		assert ( nldv->type_lens.int_len > 0 );
		type	= nldv->type_lens.type;
		if (type == DVTYPE_ASCII)
			strbegend[0]	= 0;
		for (i=0; i < nldv->n_dim; i++) {
			begcnt[i]	= nldv->dimension[i].low_bound;
		}

		/* find offset if indexed array */
		if (*lastc == '(') {
			errn	= _indx_nl(css, cup, echoptr, begcnt, &ndim,
					strbegend, &encnt, &icnt, 1);
			if (errn != 0)
				break;
		}
		else {
			while (ISBLANK(*lastc)) {
				CMTSUBGT(*lastc);
			}
			/* match '=' or special character */
			if (!(MATCH(*lastc, _MASKS, MRNLREP))) {
				return(FENLNOVL);
			}
		}
		CMTSUBGT(*lastc);

		/* Currently positioned after the '=' sign, but lastc is
		 * pointing at the '=' sign.  Update lastc for nlread and
		 * compute:
	 	 * cntp = number of array elements to be read
	 	 *	(1 if not an array).
	 	 * elsize = size of a variable or array element
	 	 *	(words for nonchar, bytes for char).
	 	 * vaddr = target address for the input value.  For
	 	 *	character, a Fortran character descriptor.
	 	 */
		int_len	= nldv->type_lens.int_len;
		if ((ndim != 0) && (ndim != nldv->n_dim)) {
			errn	= FENLBNDY;
			break;
		}
		for (nc = 0; nc < nldv->n_dim; nc++) {
			extent *= nldv->dimension[nc].extent;
		}
		if (ndim > 0) {
			offs	= begcnt[0] - (nldv->dimension[0].low_bound);
			for (nc = 1; nc < ndim; nc++) {
				mult	= mult * (nldv->dimension[nc-1].extent);
				offs	= offs + ((begcnt[nc] -
				   nldv->dimension[nc].low_bound) * mult);
			}
			extent	= extent - offs;
		}
		if (type == DVTYPE_ASCII) {
			char	*wptr;
			const int bytesperchar = 1;
			int	begt = strbegend[1];
			int	endt = strbegend[2];
			wptr	= _fcdtocp(nldv->base_addr.charptr);
			elsize	= _fcdlen(nldv->base_addr.charptr);
			elsize	= elsize * bytesperchar;
			/* check for character substrings in input record */
			wptr += offs * elsize;
			if (strbegend[0] > 0) {
				if (begt < 1 )
					begt	= 1;
				else if (begt > elsize) {
					errn	= FENLUNKN;
					return(errn);
				}
				if (endt < 1 )
					endt	= elsize;
				else if ((endt > elsize) || (endt < begt)) {
					errn	= FENLUNKN;
					break;
				}
				wptr	= wptr + (begt - 1);
				elsize	= (endt - begt) + 1;
			}
			vaddr	= wptr;
		}
		else {
			bcont	*iwptr;
			iwptr	= (bcont*)nldv->base_addr.a.ptr;
			elsize	= int_len >> 3;
			iwptr  += offs * (elsize / (sizeof(bcont)));
			vaddr	= iwptr;
		}
		/* Assertions */
		assert ( elsize > 0 && extent > 0 );
		c	= *lastc;
		cntp	= extent;
		errn	= _nlread(css, type, vaddr, cntp, 1, &c, cup, echoptr,
				elsize);
		*lastc	= c;
		break;
	}
	case IO_STRUC_A:
	case IO_STRUC_S:
	{
		/* do not allow structures in cf77 files. */
		errn	= FENLSTCT;
		break;
	}
	default:
		 errn	= FEINTUNK;
	}
	return(errn);
}

/*	_nlread - calls _nexdata to get the next value and stores the
 *		result in the namelist object entry.
 *	On Entry - cup_ulineptr points to the first character following the
 *		value.
 *	On Exit - lastc will contain the first nonblank, nonseparator
 * 		character following the value.
 */

static int
_nlread(FIOSPTR css, ftype_t type, void *ptr, int cntp, int incrm,
	char *lastc, unit *cup, struct Echoinfo *echoptr, int elsize)
{
	long		ss, ncntp;
	long		stat;
	char		c;
	void		*vaddr;
	long		errn = 0;
	int		lcount;		/* repeat count for values */
	long		lval[9];	/* convert space */
	bcont		*sval;
	int		nullvlu;
	c	= *lastc;
	ncntp	= cntp;
	vaddr	= ptr;
	nullvlu	= 0;

	while (ncntp > 0) {
		errn	= _nexdata(css, type, vaddr, ncntp, 1, c, cup, echoptr,
				lval, &lcount, elsize, &nullvlu);
		if (errn != 0)
			return(errn);
		else {
			if (nullvlu == 2) {
				lcount	= 0;
				ncntp	= 0;
			}
		}
		if (lcount > ncntp) {
			errn	= FENLTOOM;
			return(errn);
		}
		if (type == DVTYPE_ASCII) {
			char	*wptr;
			wptr	= vaddr;
			/* character data already stored, adjust
			 * ptr and count only.
			 */
			ncntp	= ncntp - lcount;
			wptr	= wptr + (lcount * elsize);
			vaddr	= wptr;
		}
		else {
			int move;
			int *iptr;
			int ix, lim;
			bcont *siptr;
			move	= MIN(ncntp,lcount);
			lim	= elsize/(sizeof(bcont));
			siptr	= (bcont*) vaddr;
			/* move what's needed from data group */
			while (move != 0) {
				sval	= (bcont*) lval;
				/* do not move null values */
				if (!nullvlu) {
				 	for (ix=0; ix < lim; ix++) {
						*siptr	= *sval;
						siptr++;
						sval++;
					}
				} else
					siptr	= siptr + lim;
				vaddr	= siptr;
				move--;
				ncntp--;
				lcount--;
			}
		}
		/* get separator following value */
		do {
			CMTSUBGT(*lastc);
		} while (ISBLANK(*lastc));
		/* if separator, get next nonblank character on the
		 * same line or on a new line.
		 */

		if (MATCH(*lastc, _MASKS, MRNLSEP)) {
			do {
				CMTSUBGT(*lastc);
			} while (ISBLANK(*lastc));
		}
	c	= *lastc;
	}
	return(0);
}

/*	_indx_nl	- compute the dimension information of an
 *			indexed array in the input record.
 *	On entry:
 *		_ positioned just after the '('
 *	On exit:
 *		- returns:	0 on success
 *				-value on eof
 *		- positioned just after the '='
 *		- the lastc argument is not changed
 */

static int
_indx_nl(
	FIOSPTR css, unit *cup, struct Echoinfo *echoptr,
	long *begcnt, int *ndima, long strbegend[3],
	int *encnt, int *icnt, int arryflag)
{
	long	*oldp, *newp;
	long	mode, ss;
	long	offs, mult;
	char	c;
	int	i, j, ir1, en1;
	long	dummy;
	int	errn = 0;
	long	stat;
	long	field_width;
	long	*field_begin;
	long	*field_end;
	long	tempbuf[2];
	en1	= 0;
	ir1	= 0;
	if (arryflag) {
		for (i = 0; i < MAXDIMS; ) {
			long	dummy;
			/* no comments in namelist input here and
			 * skip leading blanks here only.
			 */
			do {
				SUBGTC(c);
			} while (ISBLANK(c));

			/* Was end of subscripts reached in input record */
			if (c == ')')
				break;
			cup->ulinecnt++;
			cup->ulineptr--;

			/* Get the low_bound subscript information first */
			GETSECTION(c);
			if (field_width == 0)
				goto indxgetext;
			/* pass field_end + 1 */
			field_end++;
			tempbuf[0]	= 0;
			tempbuf[1]	= 0;
			mode		= 0;
			(void) _iu2s(field_begin, &field_width,
				&field_end, &mode, tempbuf, &stat,
				&dummy, &dummy);
			if(stat < 0) {
				errn	= FENLSUBS;
				return(errn);
			}
			begcnt[i]	= *((_f_int8 *)tempbuf);
indxgetext:
			/* point beyond subscript. */
			cup->ulineptr	= field_begin + field_width;
			cup->ulinecnt	= cup->ulinecnt - field_width;

			/* Get the extent subscript information */
			if (c == ':')
				return(FENLARSC);
			
			/* increment the number of subscripts */
			i++;
			do {
				SUBGTC(c);	/* get to ',' or ')' */
			} while (ISBLANK(c));	/* NO EOR here */
			/* check for end of subscripts */
			if (c == ')')
				break;
			if (c != ',') {
				errn	= FENLSUBD;	/* not a comma */
				return(errn);
			}
		}
		*ndima	= i;
		*encnt	= en1;
		*icnt	= ir1;
		if (i == 0) {
			errn	= FENLSUBN;	/* null index */
			return(errn);
		}
	}
	if (strbegend[0] == 0) {
		j	= 0;
		if (arryflag) {
			SUBGTC(c);
		} else
			c	= '('; 
		/* Check for substring information after array element */
		if (c == '(') {
#if	defined(__mips) || defined(_LITTLE_ENDIAN)
			/* skip leading blanks in input here */
			do {
				SUBGTC(c);
			} while (ISBLANK(c));
			if (c == ')') {
				errn	= FENLSTRN;	/* null index */
				return(errn);
			}
			cup->ulinecnt++;
			cup->ulineptr--;
#endif
			GETSECTION(c);
			if (field_width == 0)
				goto indxstrend;
			/* pass field_end + 1 */
			field_end++;
			tempbuf[0]	= 0;
			tempbuf[1]	= 0;
			mode		= 0;
			(void) _iu2s(field_begin, &field_width, &field_end,
				&mode, tempbuf, &stat, &dummy, &dummy);
			if(stat < 0) {
				errn	= FENLSTRG;
				return(errn);
			}
			strbegend[1]	= *((_f_int8 *)tempbuf);
			j++;
indxstrend:
			/* point beyond colon. */
			cup->ulineptr	= field_begin + field_width;
			cup->ulinecnt	= cup->ulinecnt - field_width;
			if (c == ':') {
				/* update ulineptr */
				SUBGTC(c);
#if	defined(__mips) || defined(_LITTLE_ENDIAN)
				/* skip leading blanks in input here */
				do {
					SUBGTC(c);
				} while (ISBLANK(c) || (c == ':'));
				if (c == ')')
					goto indxstrout;
				cup->ulinecnt++;
				cup->ulineptr--;
#endif
				GETSECTION(c);
				if (field_width == 0)
					goto indxstrdon;
				/* pass field_end + 1 */
				field_end++;
				tempbuf[0]	= 0;
				tempbuf[1]	= 0;
				mode		= 0;
				(void) _iu2s(field_begin, &field_width,
					&field_end, &mode, tempbuf,
					&stat, &dummy, &dummy);
				if(stat < 0) {
					errn	= FENLSTRG;
					return(errn);
				}
				strbegend[2]	= *((_f_int8 *)tempbuf);
				j++;
indxstrdon:
				/* point to right paren? */
				cup->ulineptr	= field_begin + field_width;
				cup->ulinecnt	= cup->ulinecnt - field_width;
			}
#if	!defined(__mips) && !defined(_LITTLE_ENDIAN)
			else {
				errn	= FENLSTRN;	/* null index */
				return(errn);
			}
#endif
indxstrout:
			strbegend[0]	= j;
		}
	}
	/*
	 * Look for the equal sign or the replacement character for that
	 * character
	 */
	while (!(MATCH(c, _MASKS, MRNLREP))) {
		SUBGTC(c);
	}
	return(errn);
}

/*
 * Set echo unit and Echo the line in input_ptr of length ncrs for cft77
 * with RNLECHO. 
 */

static void
_nlrdecho(
	unum_t		eunit,
	long		*input_ptr,
	long		ncrs,
	FIOSPTR css)
{
	long	stat;
	unit	*echoup;
	long	blk = BLANK;
	echoup	= _get_cup(eunit);	/* lock the unit */
	if (echoup == NULL) {
		unit	*cupsave;
		cupsave	= css->f_cu;	/* Save for _imp_open() */
		echoup	= _imp_open77(css, SEQ, FMT, eunit, 1, NULL);
		css->f_cu	= cupsave;
		if (echoup == NULL)	/* If OPEN failed */
			return;
	}
	else {
		if (echoup->ufmt == 0)		/* If unformatted file */
			_ferr(css, FEFMTTIV);
		if (echoup->useq == 0)		/* If direct access file */
			_ferr(css, FESEQTIV);
	}
	/*
	 * Output the blank that precedes the buffer for carriage control
	 * Add one to cup->ulinecnt, so that the preceding blank is counted.
	 */
	(void) _fwch(echoup, &blk, 1, PARTIAL);
	(void) _fwch(echoup, input_ptr, ncrs, FULL);
	(void) _release_cup(echoup);	/* unlock the unit */
	return;
}

/* _setunit - setup
 * Format the unit number or file name and copies to 'string'
 * for warning messages and echo of input lines for RNLECHO for cf77
 * compatibility.
 */

static void
_setunit(
	char	*string,
	void	*u)
{
	register unum_t	unum;

	if (_is_file_name(*((long *)u)))
		(void) strncpy(string, (char *)u, sizeof(long) - 1);
	else {
		unum	= *((unum_t *)u);
		(void) sprintf(string, "%"PRId64, unum);
	}

	return;
}

static void
_pr_echomsg(char *string)
{
	(void) write(fileno(errfile), string, strlen(string));

	return;
}

/* Converts the string in buf to upper case letters */

static void
_cnvrt_toupper(char *buf)
{
	register char	c;

	while ((c = *buf) != '\0')
		*buf++	= toupper(c);

	return;
}

/*
 * ishol is only called by cf77 compatible entry
 * ENTRY: 	hlptr is a pointer to a possible Hollerith character
 * Returns:	0 if delimiter is not part of hollerith string
 *		1 if delimiter is part of hollerith string
 */

static int
_ishol(long *hlptr, unit *cup)
{
	char	hlval;

	hlval	= (char) *(hlptr - 1);
	if (isdigit(hlval) && ((hlval - '0') <= (sizeof(_f_int))) && ((hlval - '0') > 0)) {
		/*
	 	 * We have digit followed by Hollerith designator, check
	 	 * the preceding character.
		 */
		if (((hlval - '0') + hlptr) >= ((cup->ulineptr) - 1)) {
		 	/* Column 1 of ulinebuf[1] and is ignored */
			if (hlptr > &cup->ulinebuf[3]) {
				hlval	= (char) *(hlptr - 2);
			 	if (!ISBLANK(hlval) && hlval != '*' &&
				    !MATCH(hlval, _MASKS, MRNLREP) &&
				    !MATCH(hlval, _MASKS, MRNLSEP) )
					return(0);
			}
			return(1);
		}
		return(0);	/* Delimiter is beyond Hollerith string */
	}
	return(0);
}

/*	_nexdata - get the next data group - position at the first character
 *		following the value or values.
 *	On return, lval will contain the value and lcount the repeat count
 *	Outptr will point to character immediately following value
 *
 *	The return value is:	-value for EOF
 *				0 for ok
 *				>0 if an error
 *		nullvlu =	1 for null value read
 *				2 for null value, followed by possible
 *				  variable name
 */
static int
_nexdata(
	FIOSPTR		css,
	ftype_t 	type,	/* Type of data item */
	void		*ptr,	/* Address of data item */
	int		cnt,	/* Number of values to look for */
	int		inc,
	char		lastc,	/* First character of value, may be blank */
	unit		*cup,	/* Input unit */
	struct Echoinfo *echoptr,
	long		*lval,	/* Value is placed here */
	int		*lcount, /* Repeat count is returned here */
	int		elsize,
	int		*nullvlu) /* indicate if any nulls returned */
{
	char	c, oc;
	int	ocnt, ss;
	long	*optr;
	int	holcnt;		/* Length of hollerith string */
	long	stat;
	char	newc;
	int	errn;
	*nullvlu	= 0;
	c	= lastc;
	while (ISBLANK(c)) {
		CMTSUBGT(c);
	}
	*lcount	= 1;	/* set repeat count */
	if (isdigit((int) c)) {
		/* Look for repeat count.  We can have a repeat count
		 * for any type of data, including character.
		 */
		*lcount	= c - '0';
		ocnt	= cup->ulinecnt; /* save count and pointer, in case */
		optr	= cup->ulineptr; /* this isn't repeat count */
		oc	= c;
		for (;;) {
			if (cup->ulinecnt > 0) {
				SUBGTC(c); /* Ignore comments */
			} else
				break;
			if (isdigit((int) c))
				*lcount	= (*lcount * 10) + c - '0';
			else
				break;
		}
		/*
		 * Could have r*c, rH, rL, or rR, where r is the number just
		 * read.  No embedded blanks allowed in r*c, rH, rL, or rR.
		 */
		switch (c) {
		case '*':
			/* get next character with comment */
			CMTSUBGT(c);
			if (isdigit((int) c)) {
				/* See if we have a repeat count followed
				 * by hollerith, like 3*4Habcd
				 */
				holcnt	= c - '0';
				ocnt	= cup->ulinecnt;
				optr	= cup->ulineptr;
				oc	= c;
				for (;;) {
					SUBGTC(c);
					if (isdigit((int) c))
						holcnt	= (holcnt * 10) +
							c - '0';
					else
						break;
				}
				switch (c) {
				case 'H':
				case 'h':
				case 'R':
				case 'r':
				case 'L':
				case 'l':
					return(_get_holl(css, cup, c, holcnt,
						type, echoptr, lval, elsize));
				default:
					/* backup restore */
					cup->ulineptr	= optr;
					/* cnt and ptr */
					cup->ulinecnt	= ocnt;
					c	= oc;
					ocnt	= 1;
					break;
				} /* switch */
			}
			break;	/* Ordinary repeat count */
		case 'H':
		case 'h':
		case 'R':
		case 'r':
		case 'L':
		case 'l':
		/* Assume it is a Hollerith string, like 3Habc */
			holcnt	= *lcount;
			*lcount	= 1;	/* No repeats */
			return(_get_holl(css, cup, c, holcnt, type, echoptr,
				lval, elsize));
		default:
			/* No repeat count, backup restore, cnt & ptr */
			cup->ulineptr	= optr;
			cup->ulinecnt	= ocnt;
			c		= oc;
			ocnt		= 1;
			*lcount		= 1;
			break;
		} /* switch */
	}
	/* END of isdigit()
	 * Looking for a value.  When we get here we are at a nonblank
	 * character, unless we had the form r*, in which case it may
	 * be followed by a blank (NULL).
	 */
	if (MATCH(c, _MASKS, MRNLSEP)) {
		cup->ulineptr--; /* reset cnt and ptr so */
		cup->ulinecnt++; /* we can read separator again */
		*nullvlu	= 1;
		return(0);	/* return null value */
	}
	else if (ISBLANK(c)) {
		*nullvlu	= 1;
		return(0);	/* return null value */
	}
	else {
		if (MATCH(c, _MASKS, MRNLCOMM)) {
			/* Use this path with input like:
			 * A = 5*; 
			 */
			*lval	= *(lval+1)	= 0;
			/* reset cnt and ptr so rest in record is read as
			 * as null values
			 */
			cup->ulinecnt++;
			cup->ulineptr--;
			*nullvlu	= 1;
			return(0);	/* return null value */
		}
		else
			if (MATCH(c, _MASKS, MRNLDELIM) || (c == '/')) {
				/* treated terminating slash or ampersand
				 * the same for f90 to allow simpler
				 * non-f90 compatibility.
				 */
				cup->ulineptr--; /* reset cnt and ptr so */
				cup->ulinecnt++; /* read delimiter again */
				*nullvlu	= 2;
				return(0);	/* Return null value */
			}
	}
	/*
	 * It is important that we handle the special cases of types logical
	 * and character first, because the format of their data is treated
	 * differently.
	 */
	if (type == DVTYPE_LOGICAL) {
		bcont	*slval;
		slval	= (bcont*)lval;
		/* Looking for a logical value.  Logical values must be of
		 * the form: optional decimal point, followed by a 'T' for
		 * true or an 'F' for false, optionally followed by one
		 * or more additional characters.  Those additional
		 * characters cannot include '=', ',', ':', ';', '(', '$'
		 * or '&'.
		 */
		if (c == '.') {
			SUBGTC(c);
			/* .T or .t assumed to be a logical value */
			if ((c == 'T') || (c == 't')) {
				switch (elsize) {
#ifdef _F_REAL4
				case 4:
					*(_f_log4 *)slval	= _btol(1);
					break;
#endif
				case 8:
					*(_f_log8 *)slval	= _btol(1);
					break;
				default:
					return(FEKNTSUP); /* kind not supported */
				}

			/* F and .f are assumed to be a logical value */
			} else if ((c == 'F') || (c == 'f')) {
				switch (elsize) {
#ifdef _F_REAL4
				case 4:
					*(_f_log4 *)slval	= _btol(0);
					break;
#endif
				case 8:
					*(_f_log8 *)slval	= _btol(0);
					break;
				default:
					return(FEKNTSUP); /* kind not supported */
				}
			} else {
				errn	= FENLIVLG;	/* Invalid logical */
				return(errn);
			}
		}
		else {
			/* If the string does not start with a '.', it could
			 * be a logical value or a variable name.  Try to
			 * determine which by seeing if it is followed by a
			 * replacement character or '('.  Save count and
			 * pointer in case this isn't a value.
			 */
			ocnt	= cup->ulinecnt;
			optr	= cup->ulineptr;
			newc	= *optr++;
			ocnt--;
			while (!(ISBLANK(newc))) {
				if (MATCH(newc, _MASKS, MRNLSEP) ||
				    MATCH(newc, _MASKS, MRNLDELIM) ||
				   (newc == '/'))
					break; /* Assume value */
				if (MATCH(newc, _MASKS, MRNLREP) ||
				   (newc == '(')) {
					/* Reset, this MAY be the first
					 * letter of a variable name
					 */
					cup->ulineptr--;
					cup->ulinecnt++;
					*nullvlu	= 2;
					return(0); /* Null value */
				}
				newc	= *optr++;
				ocnt--;
			}
			while ((ISBLANK(newc)) && ocnt-- > 0)
				newc	= *optr++;
			if (MATCH(newc, _MASKS, MRNLREP)) {
				/*
				 * Reset, because this MAY have been
				 * the first letter of a variable name
				 */
				cup->ulineptr--;
				cup->ulinecnt++;
				*nullvlu	= 2;
				return(0);	/* Null value */
			}
			if ((c == 'T') || (c == 't')) {
				switch (elsize) {
#ifdef _F_REAL4
				case 4:
					*(_f_log4 *)slval	= _btol(1);
					break;
#endif
				case 8:
					*(_f_log8 *)slval	= _btol(1);
					break;
				default:
					return(FEKNTSUP); /* kind not supported */
				}
			}
			else if ((c == 'F') || (c == 'f')) {
				switch (elsize) {
#ifdef _F_REAL4
				case 4:
					*(_f_log4 *)slval	= _btol(0);
					break;
#endif
				case 8:
					*(_f_log8 *)slval	= _btol(0);
					break;
				default:
					return(FEKNTSUP); /* kind not supported */
				}
			}
			else if (MATCH(c, _MASKS, MRNLSEP) ||
				 ISBLANK(c) || (c == ',')) {
				*nullvlu	= 1;
				return(0);	/* Indicate null value */
			}
			else {
				errn	= FENLIVLG;	/* Invalid logical */
				return(errn);
			}
		}
		/* We assume we're reading a logical value.
		 * Skip to the end of this value.
		 */
		while ( !(ISBLANK(c))) {
			CMTSUBGT(c);
			/* check for separator or terminating character */
			if (MATCH(c, _MASKS, MRNLDELIM) || c == '/' ||
			    MATCH(c, _MASKS, MRNLSEP)) {
				/* Reset cnt and ptr for conversion routine */
				cup->ulineptr--;
				cup->ulinecnt++;
				return(0); /* return logical value */
			}
		}
		return(0);	/* return logical value */
	} /* End of type logical */
	/* if type character, read character data */
	if (type == DVTYPE_ASCII)
		return (_g_charstr(css, cup, ptr, cnt, c, echoptr, *lcount,
			elsize, nullvlu));
	/* Get value for variable that is not type LOGICAL or CHARACTER */
	if (isdigit((int) c) || c == '+' || c == '-' || c == '.') {
		if (type == DVTYPE_COMPLEX) {
			errn	= FENLIVCX;
			return(errn);
		}
		return(_g_number(type, cup, lval, elsize));
	}
	/* When we get here we are looking for a VALUE.  We are at a
	 * nonblank character which is not a digit, +, or -, separator,
	 * comment or delimiter.
	 * A left parenthesis indicates complex data
	 * An apostrophe or quote indicates hollerith data
	 * A letter o indicates octal data
	 * A letter z indicates hexadecimal data
	 */
	if (c == '(') {
		return(_g_complx(css, cup, type, echoptr, lval, elsize));
	}
	else if ((c == '\'') || (c == '"')) {
		return(_get_quoholl(css, cup, c, type, echoptr, lval, elsize));
	}
	else if (c == 'O' || c == 'o') {
		return(_gocthex(css, cup, type, echoptr, lval, OCTAL, elsize,
			nullvlu));
	}
	else if (c == 'Z' || c == 'z') {
		return(_gocthex(css, cup, type, echoptr, lval, HEX, elsize,
			nullvlu));
	}
	else {
		/* No valid value.
		 * Reset cup->ulineptr, because this MAY have been the first
		 * character of a variable name.  For example, if we have:
		 * integer var1(3),var2, with input: var1=2, var2 = 5
		 * then when we try to read the value for var1(2), we will
		 * see 'var2'
		 */
		cup->ulineptr--;
		cup->ulinecnt++;
		*nullvlu	= 2;
		return(0);	/* Return null value */
	}
}

/* _g_complx - get the value for a complex number.
 * On entry:
 *		positioned at '(' for a complex number.
 * Returns:	0 if OK,
 *		-value if EOF
 *		> 0 with valid error number if an error
 */

static int
_g_complx(
	FIOSPTR css, unit*cup, ftype_t type, struct Echoinfo *echoptr,
	long *lval, int	elsize)
{
	char	c;
	long	*oldp;
	long	mode, stat;
	long	zero = 0;
	long 	field_width;
	long	*field_begin;
	long	*field_end;
	int	ss, i, errn;
	int	nc;
	long	*lptr;
	ic_func *ngcf;
	int	inc;
	int	ptrfw;
	bcont	*slval;
	/*
	 * IN reading the complex number, assume
	 * intervening EOR is OK
	 */
	if (type != DVTYPE_COMPLEX) {
		errn	= FENLIVCX;	/* type not complex */
		return(errn);
	}
	/*
	 * Call the function from the ncf_tab77 table.
	 */

	ngcf	= ncf_tab77[type];
	mode	= 0;

	switch (elsize) {
#ifdef _F_REAL4
	case 8:
		mode	= MODEHP;
		break;
#endif
	case 16:
		break;
	case 32:
		mode	= MODEDP;
		break;
	default:
		return(FEKNTSUP);	/* kind not supported */
	}
	inc	= (elsize / 2) / (sizeof(bcont));
	slval	= (bcont*)lval;
	/*
	 * If the user had turned off blanks as separator, tell
	 * conversion to ignore them.  Otherwise, blanks are significant.
	 */
	if (_BLNKSEP == 0)
		mode   |= MODEBN;
	/* loop and get both real and imaginary */
	for (i = 0; i < 2; i++) {
		do {
			SUBGTC(c);	/* skip the '(' */
		} while (ISBLANK(c));	/* skip blanks */
		cup->ulinecnt++;	/* backup 1 character */
		cup->ulineptr--;	/* backup 1 character */
		field_begin	= cup->ulineptr;
		field_end	= cup->ulineptr;
		field_width	= cup->ulinecnt;
		nc		= 0;
		/* while not MRNLSEP (comma),
		 *	MRNLDELM (ampersand, dollarsign, or slash),
		 *	blank if a separator, or left parenthesis
		 */
		while (nc < cup->ulinecnt && !(*field_end == ')' ||
		   MATCH(*field_end, _MASKS, MRNLSEP) ||
		   MATCH(*field_end, _MASKS, MRNLDELIM) ||
		   (*field_end == '/') ||
		   (isspace(*field_end) && (_BLNKSEP != 0)) ) ) {
			field_end++;
			nc++;
		}
		/* pass field_end + 1 */
		field_end++;
		field_width	= nc;
		/* convert both the real and imaginary parts */
		errn	= ngcf(field_begin, &field_width, &field_end,
			&mode, slval + (i * inc), &stat, &zero, &zero);

		/* If the scan failed, the input data might be
		 * Hollerith or hex or octal.  Allow _s_scan_extensions
		 * _s_scan_extensions to rescan the input and
		 * recompute the field width.
		 */
		if (errn < 0) {
			errn	= _nicverr(stat);
		} else
			errn	= 0;

		/* if (errn == EX_ILLCHAR) */
		if (errn == FENICVIC) {
			int errn2;
			int new_elsize;
			ftype_t new_type;
			new_type	= DVTYPE_INTEGER;
			/* complex(kind=16) not allowed in cft77 */
			if (elsize == 32) {
				return(errn);
			}
			new_elsize	= elsize >> 1;
			/* store into float without conversion. */
			errn2	= _s_scan_extensions((slval + (i * inc)),
				new_type, new_elsize, field_begin,
				field_width, &ptrfw, mode);

			cup->ulineptr += ptrfw;
			cup->ulinecnt -= ptrfw;
			if (errn2 <= 0)
				errn	= 0;
			else
				/* errors FELDUNKI and FELDSTRL
				 * are currently returned.
				 */
				return(FENLIVCX);
		} else {
			cup->ulineptr	= field_begin + field_width;
			cup->ulinecnt  -= cup->ulineptr - field_begin;
			if (errn != 0)
				return(errn);
		}
		do {
			SUBGTC(c);
		} while (ISBLANK(c));
		if ((c != ',') && (i == 0))
			return(FENLIVCX); /* err in complex number format */
	}
	if ( c != ')')
		return(FENLIVCX); /* err in complex number format */
	return(0);
}

/*
 * _g_number - Read a number.
 * Returns:	0 if ok
 *		-value if EOF
 *		> 0 if error
 */

static int
_g_number(
	ftype_t 	type,
	unit		*cup,
	long		*lval,
	int		elsize)
{
	long	*oldp;
	long	mode, stat;
	long	zero = 0;
	long 	field_width;
	long	*field_begin;
	long	*field_end;
	long	*s_field_end;
	int	ss;
	int	errn = 0;
	int	nc;
	long	*lptr;
	ic_func *ngcf;
	int	ptrfw;
	bcont	*slval;

	mode	= 0;

	switch (type) {
	case DVTYPE_REAL:
		switch (elsize) {
#ifdef _F_REAL4
		case 4:
			mode	= MODEHP;
			break;
#endif
		case 8:
			break;
		case 16:
			mode	= MODEDP;
			break;
		default:
			return(FEKNTSUP);
		}
		break;
	case DVTYPE_INTEGER:
		switch (elsize) {
#ifdef _F_INT4
		case 4:
			mode	= MODEHP;
			break;
#endif
		case 8:
			break;
		default:
			return(FEKNTSUP);
		}
		break;
	}
	/*
	 * Call the function from the ncf_tab77 table.
	 */

	ngcf	= ncf_tab77[type];

	/*
	 * If the user had turned off blanks as separator, tell NICONV
	 * to ignore them.  Otherwise, blanks are significant.
	 */
	if (_BLNKSEP == 0)
		mode   |= MODEBN;
	cup->ulinecnt++;	/* backup 1 character */
	cup->ulineptr--;	/* backup 1 character */
	field_begin	= cup->ulineptr;
	field_end	= cup->ulineptr;
	field_width	= cup->ulinecnt;
	slval		= (bcont*)lval;
	nc		= 0;
	/* while not MRNLSEP (comma)
	 *	MRNLDELM (ampersand, dollarsign, or slash)
	 *	or blank if a separator
	 */
	while (nc < cup->ulinecnt &&
	   !(MATCH(*field_end, _MASKS, MRNLSEP) ||
	     MATCH(*field_end, _MASKS, MRNLDELIM) || (*field_end == '/') ||
	   (isspace(*field_end) && (_BLNKSEP != 0)) ) ) {
		field_end++;
		nc++;
	}
	/* pass field_end + 1 */
	field_end++;
	field_width	= nc;
	s_field_end	= field_end;
	errn	= ngcf(field_begin, &field_width, &field_end,
			&mode, slval, &stat, &zero, &zero);

	/* If the scan failed, the input data might be
	 * Hollerith or hex or octal.  Allow _s_scan_extensions
	 * _s_scan_extensions to rescan the input and
	 * recompute the field width.
	 */
	if (errn < 0) {
		errn	= _nicverr(stat);
	} else
		errn	= 0;

	/* if (errn == EX_ILLCHAR) */
	if (errn == FENICVIC) {
		int	errn2;
		switch (type) {
		case DVTYPE_REAL:
			{
			long cmode;
			int new_elsize;
			int new_inc = 0;
			ftype_t new_type;
			new_type	= DVTYPE_INTEGER;
			cmode		= mode;
			new_elsize	= elsize;
			if (elsize == 16) {
				new_elsize	= 8;
				cmode		= 0;
				new_inc		= new_elsize / (sizeof(bcont));
			}
			/* store into float without conversion. */
			errn2	= _s_scan_extensions((slval + new_inc),
				new_type, new_elsize, field_begin,
				field_width, &ptrfw, cmode);

			/* store zero in first part of real 16 */
			if ((elsize == 16) && (errn2 == 0))
				*(_f_int8 *)slval	= 0;
			if (errn2 >= 0)
				errn	= 0;
			else
				errn	= FENLUNKI;
			break;
			}
		case DVTYPE_INTEGER:
			errn2	= _s_scan_extensions(slval, type, elsize,
				field_begin, field_width, &ptrfw, mode);

			/* errors FELDUNKI and FELDSTRL are
			 * currently returned.
			 */
			if (errn2 >= 0) {
				errn	= 0;
			} else if (errn == FENICVIC) {
				errn2	= 0;
				ngcf	= ncf_tab77[DVTYPE_REAL];
				field_end	= s_field_end;
				errn2	= ngcf(field_begin, &field_width,
				   	&field_end, &mode, slval, &stat,
				   	&zero, &zero);
				if (errn2 < 0)
					errn	= FENLUNKI;
				else {
					errn	= 0;
					switch (errn2) {
#ifdef _F_REAL4
					case EX_REAL32:
						{
						_f_real4 val4;
						union {
							_f_int4		n;
							_f_real4	f;
						} uval32;
						if (!_TYP_CONV) {
							errn	= FENLIVIT;
							break;
						}
						uval32.n	= *(_f_int4 *)slval;
						val4		= uval32.f;
						*(_f_int4 *)slval = (_f_int4) val4;
						break;
						}
#endif
					case EX_REAL64:
						{
						_f_real8 val8;
						union {
							_f_int8		n;
							_f_real8	f;
						} uval64;
						if (!_TYP_CONV) {
							errn	= FENLIVIT;
							break;
						}
						uval64.n	= *(_f_int8 *)slval;
						val8	= uval64.f;
						*(_f_int8 *)slval =
						   (_f_int8) val8;
						break;
						}
#if _F_REAL16 == 1
					case EX_REAL128:
						{
						_f_real16 val16;
						_f_int8 *int8ptr;
						union {
							_f_int8		n[2];
							_f_real16	f;
						} uval128;
						if (!_TYP_CONV) {
							errn	= FENLIVIT;
							break;
						}
						int8ptr	= (_f_int8 *)slval;
						uval128.n[0]	= int8ptr[0];
						uval128.n[1]	= int8ptr[1];
						val16		= uval128.f;
						*(_f_int8 *)slval = (_f_int8) val16;
						break;
						}
#endif
					default:
						errn	= FENLUNKI;
					}
				}

			} else
				errn	= FENLUNKI;
			break;
		}
	}
	cup->ulineptr	= field_begin + field_width;
	cup->ulinecnt  -= cup->ulineptr - field_begin;
	return(errn);
}

/* _g_charstr - read a character string
 *
 * Input: cup_ulineptr will point one past the first character of the string.
 *	"c" will contain the first character of the string.
 * Returns:	0 if ok,
 *		-value if EOF
 *		> 0 if error
 */

static int
_g_charstr(
	FIOSPTR		css,
	unit		*cup,
	void		*p,	/* Address of variable being read */
	int		cnt,	/* Number of strings we expect to read */
	char		c,	/* First character of string. */
	struct Echoinfo *echoptr,
	int		lcount, /* Repeat count */
	int		elsize,
	int		*nullvlu)
{
	int	eos;		/* eos == -1 if end or beginning of string */
	int	i, ch;
	unsigned int	len77;
	char	*cp;
	long	stat;
	char	enddelim;
	char	c1;
	int	repcount;
	char	*cpold;
	int	ss;
	int	errn = 0;
	long	*optr;
	int	ocnt;
	void	*fchp;
	*nullvlu	= 0;
	/*
	 * Character data may be enclosed in apostrophes or quotation marks.
	 * Each apostrophe within a character constant delimited by
	 * apostrophes must be represented by 2 consecutive apostrophes
	 * without an intervening blank or end of record. The same holds
	 * true for quotation marks. Character constants may be continued
	 * from the end of one record to the beginning of the next record.
	 * The end of the record does not cause a blank or any other
	 * character to become part of the constant.
	 * Blank characters, separator characters, comment characters, and
	 * delimiter characters may appear in character constants.
	 *
	 * For cf77 only (F90 does not allow undelimited character on input):
	 * If the character constant has the following properties:
	 * 1. It does not contain blank characters,
	 *    separator characters, comment characters, left parenthesis
	 *    or delimiter characters.
	 * 2. It does not cross a record boundary,
	 * 3. the first nonblank character is not a quotation mark or
	 *    apostrophe,
	 * 4. the leading characters are not numeric followed by asterisk,
	 * 5. the leading characters are not numeric followed by R, H, or L
	 * then the enclosing apostrophes or quotation marks are not required
	 * and apostrophes or quotation marks within the character constant
	 * are not to be doubled.
	 *
	 * Let len be the length of the list item, and let w be the length
	 * of the character constant. If len is less than or equal to w,
	 * the leftmost len characters of the constant are transmitted to the
	 * variable. If len is greater than w, the constant is transmitted to
	 * the leftmost w characters of the variable and the remaining len-w
	 * characters of the list item are filled with blanks.
	 *
	 * f90 allows zero-length character and it uses one input data item
	 * from the input record.  It does not store the value to the
	 * the zero-sized character entity.  cf77 does not allow this feature.
	 */
	eos	= 0;
	fchp	= p;
	len77	= elsize;	/* Get character length */
	/* cf77 does not allow zero-length character entities */
	if (len77 != 0) {
		cp		= fchp;
		repcount	= MIN(lcount,cnt);
		/*
		 * If the first character is a quote or apostrophe, we expect
		 * that character to delimit the end of the string.
		 */
		if ((c == '\'') || (c == '"')) {
			enddelim	= c;
			/* find characters in string */
			for (i = 0; i < len77 && eos == 0; i++) {
				GETSTR77();
				if (eos == 0)
					*cp++	= ch;
			}
			if (eos == -1)
				i--;
			i	= len77 - i; /* If declared len > read len */
			if ( i > 0 )
				(void) memset(cp, BLANK, i);	/* blank fill */
			cp	= cp + i;
			while (eos != -1) {
				/*
				 * We didn't hit the end of the string yet.
				 * Search for it.
				 */
				GETSTR77();
			}
			while (--repcount) {
				/* We have a repeat count.
				 * cp will point to the next element.
				 * Copy len77 characters to the next
				 * element.
				 */
				cpold	= fchp;
				(void) memcpy(cp, cpold, len77);
				cp	= cp + len77;	/* Next element */
			}
		}
		else {
			/*
			 * We have a character string that's not surrounded
			 * by quotes (or apostrophes).  Read until we see a
			 * blank, separator, comment, or EOR (which looks
			 * like a blank to us).  Store as many of them as
			 * we have room for.  We cannot have a repeat count
			 * unless we're surrounded by quotes or apostrophes.
			 */
			if (lcount > 1) {
				return(FENLNOVL);	/* invalid char data */
			}
			/*
			 * Determine if this is a value or a variable name.
			 * Save count and pointer in case this isn't a value.
			 */
			ocnt	= cup->ulinecnt;
			optr	= cup->ulineptr;
			c1	= *optr++;
			ocnt--;

			while (!(ISBLANK(c1))) {
				/* check for separator or 
				 * terminating character
				 */
				if (MATCH(c1, _MASKS, MRNLSEP) ||
				    MATCH(c1, _MASKS, MRNLDELIM))
					break; /* Assume value */
				if (MATCH(c1, _MASKS, MRNLREP) ||
				   c1 == '(') {
					/* Reset, this MAY be the first
					 * letter of a variable name.
					 */
					cup->ulineptr--;
					cup->ulinecnt++;
					*nullvlu	= 2;
					return(0); /* Null value */
				}
				c1	= *optr++;
				ocnt--;
			}
			while ((ISBLANK(c1)) && ocnt-- > 0)
				c1	= *optr++;
			if (MATCH(c1, _MASKS, MRNLREP) || c1 == '(') {
				/*
				 * Reset, this MAY be the first letter
				 * of a variable name.
				 */
				cup->ulineptr--;
				cup->ulinecnt++;
				*nullvlu	= 2;
				return(0);	/* Null value */
			}
			i	= 0;
			c1	= c;
			while (!(ISBLANK(c1))) {
				if (i < len77) {
					*cp++	= c1;
					i++;
				}
				SUBGTC(c1);
				if (MATCH(c1, _MASKS, MRNLSEP) ||
				    MATCH(c1, _MASKS, MRNLCOMM)) {
					/* reset to handle next time */
					cup->ulineptr--;
					cup->ulinecnt++;
					break;
				}
			}
			/* If declared length > amount read, blank fill */
			i	= len77 - i;
			(void) memset(cp, BLANK, i);
			cp	= cp + i;
		}
	}
	else {
		/* cf77 does not have zero-length character entities */
		return(FENLIOER);
	}
	return(errn);
}

/* _get_holl - Read a hollerith string.
 *
 * Returns:	0 if a value was found,
 *		-value if EOF
 *		> 0 if an error occurred
 */

static int
_get_holl(
	FIOSPTR		css,
	unit		*cup,
	char		holltype,
	int		count,	/* Number of characters in string */
	ftype_t		type,	/* Type of data item */
	struct Echoinfo *echoptr,
	long		*lval,
	int		elsize)
{
	int	i;
	char	*holbufptr;
	char	c;
	long	stat;
	int	ss;
	int	errn = 0;
	int	fill;
	/*
	 * Read 'count' characters from the current word, packing them
	 * left justified into lval[0].
	 *
	 * Can't have hollerith input for DOUBLE, COMPLEX or CHARACTER data.
	 * Hollerith input is supported for compatibility with
	 * old versions of namelist.
	 *
	 * Because we don't allow CHARACTER data, we can make the
	 * simplifying assumption that we start on a word boundary.
	 * Also, we are going to assume that whatever we read in will
	 * need to fit in a word the size of a default integer.  Repeat
	 * counts are allowed. If it becomes necessary to allow hollerith
	 * strings of > the sizeof the number of characters in a default
	 * integer, some thought will need to be given as to how to
	 * handle repeat counts.
	 */
	if (type == DVTYPE_COMPLEX || type == DVTYPE_ASCII ||
	   ((type == DVTYPE_REAL) && elsize == sizeof(_f_real16))) {
		return(FENLUNKI);
	}
	if (count > elsize) {
		return(FENLIOER);
	}
	fill		= BLANK;
	holbufptr	= (char *)lval;
	if (holltype == 'R' || holltype == 'r') {
		/* right justified */
		fill		= NULLC;
		holbufptr	= holbufptr + (elsize - count);
	}
	else
		if (holltype == 'L' || holltype == 'l')
			fill	= NULLC;
	/* Last character in buffer is the EOR character,
	 * that's why we check for cup->ulinecnt > 1
	 */
	for (i = 0; i < count && (cup->ulinecnt > 1) ; i++) {
		SUBGTC(c); /* comment characters are not special
			    * within hollerith string */
		*holbufptr++	= c;
	}
	if (i == count) {
		/* Do we need to fill the last word? */
		if (holltype == 'R' || holltype == 'r') /* right justified? */
			holbufptr	= (char *)lval;
		(void) memset(holbufptr, fill, elsize - count);
	}
	else {
		/*
		 * We hit EOR before we read enough characters _or_ we had
		 * too many characters.
		 */
		return(FENLIOER);
	}
	return(errn);
}

/* _get_quoholl
 * Get a hollerith string that is surrounded by quotes or apostrophes
 * Legal syntax is '----'L, '----'R, or '----'H
 *
 * Returns:	0 if a value was found,
 *		-value if EOF
 *		> 0 if an error occurred
 */

static int
_get_quoholl(
	FIOSPTR		css,
	unit		*cup,
	char		cdelim, /* Quote or apostrophe (to end hollerith) */
	ftype_t		type,	/* Type of data */
	struct Echoinfo *echoptr,
	long		*lval,	/* Value is placed here */
	int		elsize)	/* size */
{
	int	numchar;	/* character counter */
	int	j;
	int	fill;		/* Fill character is either ' ' or '\0' */
	long	holbuf;		/* Data is stored here until we know whether
				   it is right or left justified. */
	char	*holbufptr;	/* pointer into holbuf */
	char	c;		/* Character read */
	long	stat;
	char	*lvalcharptr;	/* Pointer to value */
	int	ss;
	int	errn = 0;
	/*
	 * Can't have hollerith input for DOUBLE, COMPLEX or CHARACTER data.
	 * Hollerith input is supported for compatibility with
	 * old versions of namelist.
	 *
	 * Because we don't allow CHARACTER data, we can make the
	 * simplifying assumption that we start on a word boundary.
	 * Also, we are going to assume that whatever we read in will
	 * need to fit in one word. Repeat counts are allowed. If it
	 * becomes necessary to allow hollerith strings of greater than
	 * the number of characters in a default integer, some thought
	 * will need to be given as to how to handle repeat counts.
	 */
	if (type == DVTYPE_COMPLEX || type == DVTYPE_ASCII ||
	   (type == DVTYPE_REAL && elsize == sizeof(_f_real16))) {
		return(FENLUNKI);
	}
	lvalcharptr	= (char *)lval;
	holbufptr	= (char *) &holbuf;
	/* Do not allow quoted strings to be continued on another record. */
	numchar	= 0;
	for (;;) {
		SUBGTC(c);
		if (c == cdelim) {
			/* Allow Comment characters within quoted string */
			SUBGTC(c);
			if (c != cdelim)
				break;	/* That was the end of the quoted
					 * string.  Otherwise, we saw two
					 * quotes in a row, which means
					 * we store one.
					 */
		}
		if (++numchar > elsize) {
			return(FENLIOER);
		}
		*holbufptr++	= c;	/* Save the character */
		/*
		 * Last character in the input buffer is the EOR character, 
		 * that's why we check for cup->ulinecnt <= 1
		 */
		if (cup->ulinecnt <= 1) {
			return(FENLIOER);
		}
	} /* On exit from this loop, numchar = number of chars. stored */
	if (c == 'L' || c == 'l')
		fill	= NULLC;
	else if (c == 'R' || c == 'r') {
		/* Right justify and store the value just read */
		holbufptr	= holbufptr - 1;	/* Last character */
		lvalcharptr	= lvalcharptr + (elsize - 1);
		j		= elsize - numchar;
		while (numchar-- > 0)
			*lvalcharptr--	= *holbufptr--;

		/* Fill word with 0's if necessary */
		while (j-- > 0)
			*lvalcharptr--	= '\0';
		return(0);
	}
	else {
		/* H format */
		fill	= BLANK;
		if (c != 'H' && c != 'h') {
			/* Reset pointers since the character does */
			/* not belong to this value */
			cup->ulineptr--;
			cup->ulinecnt++;
		}
	}
	/* Do we need to fill the last word? */
	(void) memset(holbufptr, fill, elsize - numchar);
	*lval	= holbuf;
	return(errn);
}

/* _gocthex - provides octal or hex editing for compatibility with old
 * versions of namelist.
 *	Legal formats: O'123 or O'123'. Octal number may not contain blanks,
 *	and this is a difference with the old version of namelist.
 *	Legal formats: Z'1a3 or Z'1a3'.
 *
 * On input:
 * 	cup_ulineptr should point to the character immediately following the O
 * Returns:	0 if a value was found,
 *		-value if EOF
 *		> 0 if an error occurred
 * nullvlu =	1 if a null value was found
 *		2 if a null value was found, and it is not followed
 *		  by another value
 */

static int
_gocthex(
	FIOSPTR 	css,
	unit		*cup,
	ftype_t		type,
	struct Echoinfo *echoptr,
	long		*lval,
	int		base,
	int		elsize,
	int		*nullvlu)
{
	char	c;
	long	stat;
	char	strbuf[2];
	int	ss;
	int	errn = 0;
	int	octshift = OCTSHFT;
	int	hexshift = HEXSHFT;
	/* check size in bytes of incoming variable. */
#if defined(_F_REAL4) && defined(_F_INT4)
	if (elsize <= 4) {
		octshift	= OCTSHFT4;
		hexshift	= HEXSHFT4;
	}
#endif
	*nullvlu	= 0;
	if (*cup->ulineptr != '\'') {
		/* Can't be a value, might be a variable name */
		cup->ulineptr--;
		cup->ulinecnt++;
		*nullvlu	= 2;
		return(0);	/* NULL value */
	}
	/* This type of format won't work for complex or double precision */
	if (type == DVTYPE_COMPLEX || (type == DVTYPE_REAL &&
		elsize == sizeof(_f_real16))) {
		return(FENLUNKI);	/* type mismatch */
	}
	SUBGTC(c);	/* Skip the apostrophe */
	SUBGTC(c);	/* and get the next character */
	*lval		= 0;
	strbuf[1]	= '\0';
	while (!(ISBLANK(c)) && c != '\'') {
		if (base == OCTAL) {
			if ((!isdigit((int) c)) || (c == '9') ||
				(*lval >> octshift)) {
					return(FENICVIC); /* NICV type err */
			}
			*lval	= (*lval * (sizeof(_f_int))) + c - '0';
		}
		else { /* Check for hex digit or overflow */
			if ((!isxdigit(c)) || (*lval >> hexshift)) {
				return(FENICVIC);	/* NICV type err */
			}
			strbuf[0]	= c;
			*lval	= (*lval * 16) +
				(int) strtol(strbuf, (char **)NULL, 16);
		}
		CMTSUBGT(c); /* Check for comment after value */
		if (MATCH(c, _MASKS, MRNLSEP)) {
			cup->ulineptr--;
			cup->ulinecnt++; /* to read separator after */
			break;	/* return from this routine */
		}
	}
	return(errn);	/* indicate value */
}
