uClibc now has a math library. muahahahaha!

 -Erik

1 files changed, 1484 insertions, 0 deletions

diff --git a/libm/ldouble/lcalc.c b/libm/ldouble/lcalc.c
new file mode 100644
index 000000000..87250952f
--- /dev/null
+++ b/libm/ldouble/lcalc.c
@@ -0,0 +1,1484 @@
+/* calc.c */
+/* Keyboard command interpreter	*/
+/* by Stephen L. Moshier */
+
+/* Include functions for IEEE special values */
+#define NANS 1
+
+/* length of command line: */
+#define LINLEN 128
+
+#define XON 0x11
+#define XOFF 0x13
+
+#define SALONE 1
+#define DECPDP 0
+#define INTLOGIN 0
+#define INTHELP 1
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+/* Initialize squirrel printf: */
+#define INIPRINTF 0
+
+#if DECPDP
+#define TRUE 1
+#endif
+
+#include <stdio.h>
+#include <string.h>
+static char idterp[] = {
+"\n\nSteve Moshier's command interpreter V1.3\n"};
+#define ISLOWER(c) ((c >= 'a') && (c <= 'z'))
+#define ISUPPER(c) ((c >= 'A') && (c <= 'Z'))
+#define ISALPHA(c) (ISLOWER(c) || ISUPPER(c))
+#define ISDIGIT(c) ((c >= '0') && (c <= '9'))
+#define ISATF(c) (((c >= 'a')&&(c <= 'f')) || ((c >= 'A')&&(c <= 'F')))
+#define ISXDIGIT(c) (ISDIGIT(c) || ISATF(c))
+#define ISOCTAL(c) ((c >= '0') && (c < '8'))
+#define ISALNUM(c) (ISALPHA(c) || (ISDIGIT(c))
+FILE *fopen();
+
+#include "lcalc.h"
+#include "ehead.h"
+
+/* space for working precision numbers */
+static long double vs[22];
+
+/*	the symbol table of temporary variables: */
+
+#define NTEMP 4
+struct varent temp[NTEMP] = {
+{"T",	OPR | TEMP, &vs[14]},
+{"T",	OPR | TEMP, &vs[15]},
+{"T",	OPR | TEMP, &vs[16]},
+{"\0",	OPR | TEMP, &vs[17]}
+};
+
+/*	the symbol table of operators		*/
+/* EOL is interpreted on null, newline, or ;	*/
+struct symbol oprtbl[] = {
+{"BOL",		OPR | BOL,	0},
+{"EOL",		OPR | EOL,	0},
+{"-",		OPR | UMINUS,	8},
+/*"~",		OPR | COMP,	8,*/
+{",",		OPR | EOE,	1},
+{"=",		OPR | EQU,	2},
+/*"|",		OPR | LOR,	3,*/
+/*"^",		OPR | LXOR,	4,*/
+/*"&",		OPR | LAND,	5,*/
+{"+",		OPR | PLUS,	6},
+{"-",		OPR | MINUS, 6},
+{"*",		OPR | MULT,	7},
+{"/",		OPR | DIV,	7},
+/*"%",		OPR | MOD,	7,*/
+{"(",		OPR | LPAREN,	11},
+{")",		OPR | RPAREN,	11},
+{"\0",		ILLEG, 0}
+};
+
+#define NOPR 8
+
+/*	the symbol table of indirect variables: */
+extern long double PIL;
+struct varent indtbl[] = {
+{"t",		VAR | IND,	&vs[21]},
+{"u",		VAR | IND,	&vs[20]},	
+{"v",		VAR | IND,	&vs[19]},
+{"w",		VAR | IND,	&vs[18]},	
+{"x",		VAR | IND,	&vs[10]},
+{"y",		VAR | IND,	&vs[11]},
+{"z",		VAR | IND,	&vs[12]},
+{"pi",		VAR | IND,	&PIL},
+{"\0",		ILLEG,		0}
+};
+
+/*	the symbol table of constants:	*/
+
+#define NCONST 10
+struct varent contbl[NCONST] = {
+{"C",CONST,&vs[0]},
+{"C",CONST,&vs[1]},
+{"C",CONST,&vs[2]},
+{"C",CONST,&vs[3]},
+{"C",CONST,&vs[4]},
+{"C",CONST,&vs[5]},
+{"C",CONST,&vs[6]},
+{"C",CONST,&vs[7]},
+{"C",CONST,&vs[8]},
+{"\0",CONST,&vs[9]}
+};
+
+/* the symbol table of string variables: */
+
+static char strngs[160] = {0};
+
+#define NSTRNG 5
+struct strent strtbl[NSTRNG] = {
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{"\0",ILLEG,0},
+};
+
+
+/* Help messages */
+#if INTHELP
+static char *intmsg[] = {
+"?",
+"Unkown symbol",
+"Expression ends in illegal operator",
+"Precede ( by operator",
+")( is illegal",
+"Unmatched )",
+"Missing )",
+"Illegal left hand side",
+"Missing symbol",
+"Must assign to a variable",
+"Divide by zero",
+"Missing symbol",
+"Missing operator",
+"Precede quantity by operator",
+"Quantity preceded by )",
+"Function syntax",
+"Too many function args",
+"No more temps",
+"Arg list"
+};
+#endif
+
+/*	the symbol table of functions:	*/
+#if SALONE
+long double hex(), cmdh(), cmdhlp();
+long double cmddm(), cmdtm(), cmdem();
+long double take(), mxit(), exit(), bits(), csys();
+long double cmddig(), prhlst(), abmac();
+long double ifrac(), xcmpl();
+long double floorl(), logl(), powl(), sqrtl(), tanhl(), expl();
+long double ellpel(), ellpkl(), incbetl(), incbil();
+long double stdtrl(), stdtril(), zstdtrl(), zstdtril();
+long double sinl(), cosl(), tanl(), asinl(), acosl(), atanl(), atan2l();
+long double tanhl(), atanhl();
+#ifdef NANS
+int isnanl(), isfinitel(), signbitl();
+long double zisnan(), zisfinite(), zsignbit();
+#endif
+
+struct funent funtbl[] = {
+{"h",		OPR | FUNC, cmdh},
+{"help",	OPR | FUNC, cmdhlp},
+{"hex",		OPR | FUNC, hex},
+/*"view",		OPR | FUNC, view,*/
+{"exp",		OPR | FUNC, expl},
+{"floor",	OPR | FUNC, floorl},
+{"log",		OPR | FUNC, logl},
+{"pow",		OPR | FUNC, powl},
+{"sqrt",	OPR | FUNC, sqrtl},
+{"tanh",	OPR | FUNC, tanhl},
+{"sin",	OPR | FUNC, sinl},
+{"cos",	OPR | FUNC, cosl},
+{"tan",	OPR | FUNC, tanl},
+{"asin",	OPR | FUNC, asinl},
+{"acos",	OPR | FUNC, acosl},
+{"atan",	OPR | FUNC, atanl},
+{"atantwo",	OPR | FUNC, atan2l},
+{"tanh",	OPR | FUNC, tanhl},
+{"atanh",	OPR | FUNC, atanhl},
+{"ellpe",	OPR | FUNC, ellpel},
+{"ellpk",	OPR | FUNC, ellpkl},
+{"incbet",	OPR | FUNC, incbetl},
+{"incbi",	OPR | FUNC, incbil},
+{"stdtr",	OPR | FUNC, zstdtrl},
+{"stdtri",	OPR | FUNC, zstdtril},
+{"ifrac",	OPR | FUNC, ifrac},
+{"cmp",		OPR | FUNC, xcmpl},
+#ifdef NANS
+{"isnan",	OPR | FUNC, zisnan},
+{"isfinite",	OPR | FUNC, zisfinite},
+{"signbit",	OPR | FUNC, zsignbit},
+#endif
+{"bits",	OPR | FUNC, bits},
+{"digits",	OPR | FUNC, cmddig},
+{"dm",		OPR | FUNC, cmddm},
+{"tm",		OPR | FUNC, cmdtm},
+{"em",		OPR | FUNC, cmdem},
+{"take",	OPR | FUNC | COMMAN, take},
+{"system",	OPR | FUNC | COMMAN, csys},
+{"exit",	OPR | FUNC, mxit},
+/*
+"remain",	OPR | FUNC, eremain,
+*/
+{"\0",		OPR | FUNC,	0}
+};
+
+/*	the symbol table of key words */
+struct funent keytbl[] = {
+{"\0",		ILLEG,	0}
+};
+#endif
+
+void zgets(), init();
+
+/* Number of decimals to display */
+#define DEFDIS 70
+static int ndigits = DEFDIS;
+
+/* Menu stack */
+struct funent *menstk[5] = {&funtbl[0], NULL, NULL, NULL, NULL};
+int menptr = 0;
+
+/* Take file stack */
+FILE *takstk[10] = {0};
+int takptr = -1;
+
+/* size of the expression scan list: */
+#define NSCAN 20
+
+/* previous token, saved for syntax checking: */
+struct symbol *lastok = 0;
+
+/*	variables used by parser: */
+static char str[128] = {0};
+int uposs = 0;		/* possible unary operator */
+static long double qnc;
+char lc[40] = { '\n' };	/*	ASCII string of token	symbol	*/
+static char line[LINLEN] = { '\n','\0' };	/* input command line */
+static char maclin[LINLEN] = { '\n','\0' };	/* macro command */
+char *interl = line;		/* pointer into line */
+extern char *interl;
+static int maccnt = 0;	/* number of times to execute macro command */
+static int comptr = 0;	/* comma stack pointer */
+static long double comstk[5];	/* comma argument stack */
+static int narptr = 0;	/* pointer to number of args */
+static int narstk[5] = {0};	/* stack of number of function args */
+
+/*							main()		*/
+
+/*	Entire program starts here	*/
+
+int main()
+{
+
+/*	the scan table:			*/
+
+/*	array of pointers to symbols which have been parsed:	*/
+struct symbol *ascsym[NSCAN];
+
+/*	current place in ascsym:			*/
+register struct symbol **as;
+
+/*	array of attributes of operators parsed:		*/
+int ascopr[NSCAN];
+
+/*	current place in ascopr:			*/
+register int *ao;
+
+#if LARGEMEM
+/*	array of precedence levels of operators:		*/
+long asclev[NSCAN];
+/*	current place in asclev:			*/
+long *al;
+long symval;	/* value of symbol just parsed */
+#else
+int asclev[NSCAN];
+int *al;
+int symval;
+#endif
+
+long double acc;	/* the accumulator, for arithmetic */
+int accflg;	/* flags accumulator in use	*/
+long double val;	/* value to be combined into accumulator */
+register struct symbol *psym;	/* pointer to symbol just parsed */
+struct varent *pvar;	/* pointer to an indirect variable symbol */
+struct funent *pfun;	/* pointer to a function symbol */
+struct strent *pstr;	/* pointer to a string symbol */
+int att;	/* attributes of symbol just parsed */
+int i;		/* counter	*/
+int offset;	/* parenthesis level */
+int lhsflg;	/* kluge to detect illegal assignments */
+struct symbol *parser();	/* parser returns pointer to symbol */
+int errcod;	/* for syntax error printout */
+
+
+/* Perform general initialization */
+
+init();
+
+menstk[0] = &funtbl[0];
+menptr = 0;
+cmdhlp();		/* print out list of symbols */
+
+
+/*	Return here to get next command line to execute	*/
+getcmd:
+
+/* initialize registers and mutable symbols */
+
+accflg = 0;	/* Accumulator not in use				*/
+acc = 0.0L;	/* Clear the accumulator				*/
+offset = 0;	/* Parenthesis level zero				*/
+comptr = 0;	/* Start of comma stack					*/
+narptr = -1;	/* Start of function arg counter stack	*/
+
+psym = (struct symbol *)&contbl[0];
+for( i=0; i<NCONST; i++ )
+	{
+	psym->attrib = CONST;	/* clearing the busy bit */
+	++psym;
+	}
+psym = (struct symbol *)&temp[0];
+for( i=0; i<NTEMP; i++ )
+	{
+	psym->attrib = VAR | TEMP;	/* clearing the busy bit */
+	++psym;
+	}
+
+pstr = &strtbl[0];
+for( i=0; i<NSTRNG; i++ )
+	{
+	pstr->spel = &strngs[ 40*i ];
+	pstr->attrib = STRING | VAR;
+	pstr->string = &strngs[ 40*i ];
+	++pstr;
+	}
+
+/*	List of scanned symbols is empty:	*/
+as = &ascsym[0];
+*as = 0;
+--as;
+/*	First item in scan list is Beginning of Line operator	*/
+ao = &ascopr[0];
+*ao = oprtbl[0].attrib & 0xf;	/* BOL */
+/*	value of first item: */
+al = &asclev[0];
+*al = oprtbl[0].sym;
+
+lhsflg = 0;		/* illegal left hand side flag */
+psym = &oprtbl[0];	/* pointer to current token */
+
+/*	get next token from input string	*/
+
+gettok:
+lastok = psym;		/* last token = current token */
+psym = parser();	/* get a new current token */
+/*printf( "%s attrib %7o value %7o\n", psym->spel, psym->attrib & 0xffff,
+		psym->sym );*/
+
+/* Examine attributes of the symbol returned by the parser	*/
+att = psym->attrib;
+if( att == ILLEG )
+	{
+	errcod = 1;
+	goto synerr;
+	}
+
+/*	Push functions onto scan list without analyzing further */
+if( att & FUNC )
+	{
+	/* A command is a function whose argument is
+	 * a pointer to the rest of the input line.
+	 * A second argument is also passed: the address
+	 * of the last token parsed.
+	 */
+	if( att & COMMAN )
+		{
+		pfun = (struct funent *)psym;
+		( *(pfun->fun))( interl, lastok );
+		abmac();	/* scrub the input line */
+		goto getcmd;	/* and ask for more input */
+		}
+	++narptr;	/* offset to number of args */
+	narstk[narptr] = 0;
+	i = lastok->attrib & 0xffff; /* attrib=short, i=int */
+	if( ((i & OPR) == 0)
+			|| (i == (OPR | RPAREN))
+			|| (i == (OPR | FUNC)) )
+		{
+		errcod = 15;
+		goto synerr;
+		}
+
+	++lhsflg;
+	++as;
+	*as = psym;
+	++ao;
+	*ao = FUNC;
+	++al;
+	*al = offset + UMINUS;
+	goto gettok;
+	}
+
+/* deal with operators */
+if( att & OPR )
+	{
+	att &= 0xf;
+	/* expression cannot end with an operator other than
+	 * (, ), BOL, or a function
+	 */
+	if( (att == RPAREN) || (att == EOL) || (att == EOE))
+		{
+		i = lastok->attrib & 0xffff; /* attrib=short, i=int */
+		if( (i & OPR) 
+			&& (i != (OPR | RPAREN))
+			&& (i != (OPR | LPAREN))
+			&& (i != (OPR | FUNC))
+			&& (i != (OPR | BOL)) )
+				{
+				errcod = 2;
+				goto synerr;
+				}
+		}
+	++lhsflg;	/* any operator but ( and = is not a legal lhs */
+
+/*	operator processing, continued */
+
+	switch( att )
+		{
+ 	case EOE:
+		lhsflg = 0;
+		break; 
+	case LPAREN:
+		/* ( must be preceded by an operator of some sort. */
+		if( ((lastok->attrib & OPR) == 0) )
+			{
+			errcod = 3;
+			goto synerr;
+			}
+		/* also, a preceding ) is illegal */
+		if( (unsigned short )lastok->attrib == (OPR|RPAREN))
+			{
+			errcod = 4;
+			goto synerr;
+			}
+		/* Begin looking for illegal left hand sides: */
+		lhsflg = 0;
+		offset += RPAREN;	/* new parenthesis level */
+		goto gettok;
+	case RPAREN:
+		offset -= RPAREN;	/* parenthesis level */
+		if( offset < 0 )
+			{
+			errcod = 5;	/* parenthesis error */
+			goto synerr;
+			}
+		goto gettok;
+	case EOL:
+		if( offset != 0 )
+			{
+			errcod = 6;	/* parenthesis error */
+			goto synerr;
+			}
+		break;
+	case EQU:
+		if( --lhsflg )	/* was incremented before switch{} */
+			{
+			errcod = 7;
+			goto synerr;
+			}
+	case UMINUS:
+	case COMP:
+		goto pshopr;	/* evaluate right to left */
+	default:	;
+		}
+
+
+/*	evaluate expression whenever precedence is not increasing	*/
+
+symval = psym->sym + offset;
+
+while( symval <= *al )
+	{
+	/* if just starting, must fill accumulator with last
+	 * thing on the line
+	 */
+	if( (accflg == 0) && (as >= ascsym) && (((*as)->attrib & FUNC) == 0 ))
+		{
+		pvar = (struct varent *)*as;
+/*
+		if( pvar->attrib & STRING )
+			strcpy( (char *)&acc, (char *)pvar->value );
+		else
+*/
+			acc = *pvar->value;
+		--as;
+		accflg = 1;
+		}
+
+/* handle beginning of line type cases, where the symbol
+ * list ascsym[] may be empty.
+ */
+	switch( *ao )
+		{
+	case BOL:	
+/*		printf( "%.16e\n", (double )acc ); */
+#if NE == 6
+		e64toasc( &acc, str, 100 );
+#else
+		e113toasc( &acc, str, 100 );
+#endif
+		printf( "%s\n", str );
+		goto getcmd;	/* all finished */
+	case UMINUS:
+		acc = -acc;
+		goto nochg;
+/*
+	case COMP:
+		acc = ~acc;
+		goto nochg;
+*/
+	default:	;
+		}
+/* Now it is illegal for symbol list to be empty,
+ * because we are going to need a symbol below.
+ */
+	if( as < &ascsym[0] )
+		{
+		errcod = 8;
+		goto synerr;
+		}
+/* get attributes and value of current symbol */
+	att = (*as)->attrib;
+	pvar = (struct varent *)*as;
+	if( att & FUNC )
+		val = 0.0L;
+	else
+		{
+/*
+		if( att & STRING )
+			strcpy( (char *)&val, (char *)pvar->value );
+		else
+*/
+			val = *pvar->value;
+		}
+
+/* Expression evaluation, continued. */
+
+	switch( *ao )
+		{
+	case FUNC:
+		pfun = (struct funent *)*as;
+	/* Call the function with appropriate number of args */
+	i = narstk[ narptr ];
+	--narptr;
+	switch(i)
+			{
+			case 0:
+			acc = ( *(pfun->fun) )(acc);
+			break;
+			case 1:
+			acc = ( *(pfun->fun) )(acc, comstk[comptr-1]);
+			break;
+			case 2:
+			acc = ( *(pfun->fun) )(acc, comstk[comptr-2],
+				comstk[comptr-1]);
+			break;
+			case 3:
+			acc = ( *(pfun->fun) )(acc, comstk[comptr-3],
+				comstk[comptr-2], comstk[comptr-1]);
+			break;
+			default:
+			errcod = 16;
+			goto synerr;
+			}
+		comptr -= i;
+		accflg = 1;	/* in case at end of line */
+		break;
+	case EQU:
+		if( ( att & TEMP) || ((att & VAR) == 0) || (att & STRING) )
+			{
+			errcod = 9;
+			goto synerr;	/* can only assign to a variable */
+			}
+		pvar = (struct varent *)*as;
+		*pvar->value = acc;
+		break;
+	case PLUS:
+		acc = acc + val;	break;
+	case MINUS:
+		acc = val - acc;	break;
+	case MULT:
+		acc = acc * val;	break;
+	case DIV:
+		if( acc == 0.0L )
+			{
+/*
+divzer:
+*/
+			errcod = 10;
+			goto synerr;
+			}
+		acc = val / acc;	break;
+/*
+	case MOD:
+		if( acc == 0 )
+			goto divzer;
+		acc = val % acc;	break;
+	case LOR:
+		acc |= val;		break;
+	case LXOR:
+		acc ^= val;		break;
+	case LAND:
+		acc &= val;		break;
+*/
+	case EOE:
+		if( narptr < 0 )
+			{
+			errcod = 18;
+			goto synerr;
+			}
+		narstk[narptr] += 1;
+		comstk[comptr++] = acc;
+/*	printf( "\ncomptr: %d narptr: %d %d\n", comptr, narptr, acc );*/
+		acc = val;
+		break;
+		}
+
+
+/*	expression evaluation, continued		*/
+
+/* Pop evaluated tokens from scan list:		*/
+	/* make temporary variable not busy	*/
+	if( att & TEMP )
+		(*as)->attrib &= ~BUSY;
+	if( as < &ascsym[0] )	/* can this happen? */
+		{
+		errcod = 11;
+		goto synerr;
+		}
+	--as;
+nochg:
+	--ao;
+	--al;
+	if( ao < &ascopr[0] )	/* can this happen? */
+		{
+		errcod = 12;
+		goto synerr;
+		}
+/* If precedence level will now increase, then			*/
+/* save accumulator in a temporary location			*/
+	if( symval > *al )
+		{
+		/* find a free temp location */
+		pvar = &temp[0];
+		for( i=0; i<NTEMP; i++ )
+			{
+			if( (pvar->attrib & BUSY) == 0)
+				goto temfnd;
+			++pvar;
+			}
+		errcod = 17;
+		printf( "no more temps\n" );
+		pvar = &temp[0];
+		goto synerr;
+
+	temfnd:
+		pvar->attrib |= BUSY;
+		*pvar->value = acc;
+		/*printf( "temp %d\n", acc );*/
+		accflg = 0;
+		++as;	/* push the temp onto the scan list */
+		*as = (struct symbol *)pvar;
+		}
+	}	/* End of evaluation loop */
+
+
+/*	Push operator onto scan list when precedence increases	*/
+
+pshopr:
+	++ao;
+	*ao = psym->attrib & 0xf;
+	++al;
+	*al = psym->sym + offset;
+	goto gettok;
+	}	/* end of OPR processing */
+
+
+/* Token was not an operator.  Push symbol onto scan list.	*/
+if( (lastok->attrib & OPR) == 0 )
+	{
+	errcod = 13;
+	goto synerr;	/* quantities must be preceded by an operator */
+	}
+if( (unsigned short )lastok->attrib == (OPR | RPAREN) )	/* ...but not by ) */
+	{
+	errcod = 14;
+	goto synerr;
+	}
+++as;
+*as = psym;
+goto gettok;
+
+synerr:
+
+#if INTHELP
+printf( "%s ", intmsg[errcod] );
+#endif
+printf( " error %d\n", errcod );
+abmac();	/* flush the command line */
+goto getcmd;
+}	/* end of program */
+
+/*						parser()	*/
+
+/* Get token from input string and identify it.		*/
+
+
+static char number[128];
+
+struct symbol *parser( )
+{
+register struct symbol *psym;
+register char *pline;
+struct varent *pvar;
+struct strent *pstr;
+char *cp, *plc, *pn;
+long lnc;
+int i;
+long double tem;
+
+/* reference for old Whitesmiths compiler: */
+/*
+ *extern FILE *stdout;
+ */
+
+pline = interl;		/* get current location in command string	*/
+
+
+/*	If at beginning of string, must ask for more input	*/
+if( pline == line )
+	{
+
+	if( maccnt > 0 )
+		{
+		--maccnt;
+		cp = maclin;
+		plc = pline;
+		while( (*plc++ = *cp++) != 0 )
+			;
+		goto mstart;
+		}
+	if( takptr < 0 )
+		{	/* no take file active: prompt keyboard input */
+		printf("* ");
+		}
+/* 	Various ways of typing in a command line. */
+
+/*
+ * Old Whitesmiths call to print "*" immediately
+ * use RT11 .GTLIN to get command string
+ * from command file or terminal
+ */
+
+/*
+ *	fflush(stdout);
+ *	gtlin(line);
+ */
+
+ 
+	zgets( line, TRUE );	/* keyboard input for other systems: */
+
+
+mstart:
+	uposs = 1;	/* unary operators possible at start of line */
+	}
+
+ignore:
+/* Skip over spaces */
+while( *pline == ' ' )
+	++pline;
+
+/* unary minus after operator */
+if( uposs && (*pline == '-') )
+	{
+	psym = &oprtbl[2];	/* UMINUS */
+	++pline;
+	goto pdon3;
+	}
+	/* COMP */
+/*
+if( uposs && (*pline == '~') )
+	{
+	psym = &oprtbl[3];
+	++pline;
+	goto pdon3;
+	}
+*/
+if( uposs && (*pline == '+') )	/* ignore leading plus sign */
+	{
+	++pline;
+	goto ignore;
+	}
+
+/* end of null terminated input */
+if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
+	{
+	pline = line;
+	goto endlin;
+	}
+if( *pline == ';' )
+	{
+	++pline;
+endlin:
+	psym = &oprtbl[1];	/* EOL */
+	goto pdon2;
+	}
+
+
+/*						parser()	*/
+
+
+/* Test for numeric input */
+if( (ISDIGIT(*pline)) || (*pline == '.') )
+	{
+	lnc = 0;	/* initialize numeric input to zero */
+	qnc = 0.0L;
+	if( *pline == '0' )
+		{ /* leading "0" may mean octal or hex radix */
+		++pline;
+		if( *pline == '.' )
+			goto decimal; /* 0.ddd */
+		/* leading "0x" means hexadecimal radix */
+		if( (*pline == 'x') || (*pline == 'X') )
+			{
+			++pline;
+			while( ISXDIGIT(*pline) )
+				{
+				i = *pline++ & 0xff;
+				if( i >= 'a' )
+					i -= 047;
+				if( i >= 'A' )
+					i -= 07;
+				i -= 060;
+				lnc = (lnc << 4) + i;
+				qnc = lnc;
+				}
+			goto numdon;
+			}
+		else
+			{
+			while( ISOCTAL( *pline ) )
+				{
+				i = ((*pline++) & 0xff) - 060;
+				lnc = (lnc << 3) + i;
+				qnc = lnc;
+				}
+			goto numdon;
+			}
+		}
+	else
+		{
+		/* no leading "0" means decimal radix */
+/******/
+decimal:
+		pn = number;
+		while( (ISDIGIT(*pline)) || (*pline == '.') )
+			*pn++ = *pline++;
+/* get possible exponent field */
+		if( (*pline == 'e') || (*pline == 'E') )
+			*pn++ = *pline++;
+		else
+			goto numcvt;
+		if( (*pline == '-') || (*pline == '+') )
+			*pn++ = *pline++;
+		while( ISDIGIT(*pline) )
+			*pn++ = *pline++;
+numcvt:
+		*pn++ = ' ';
+		*pn++ = 0;
+#if NE == 6
+		asctoe64( number, &qnc );
+#else
+		asctoe113( number, &qnc );
+#endif
+/*		sscanf( number, "%le", &nc ); */
+		}
+/* output the number	*/
+numdon:
+	/* search the symbol table of constants 	*/
+	pvar = &contbl[0];
+	for( i=0; i<NCONST; i++ )
+		{
+		if( (pvar->attrib & BUSY) == 0 )
+			goto confnd;
+		tem = *pvar->value;
+		if( tem == qnc )
+			{
+			psym = (struct symbol *)pvar;
+			goto pdon2;
+			}
+		++pvar;
+		}
+	printf( "no room for constant\n" );
+	psym = (struct symbol *)&contbl[0];
+	goto pdon2;
+
+confnd:
+	pvar->spel= contbl[0].spel;
+	pvar->attrib = CONST | BUSY;
+	*pvar->value = qnc;
+	psym = (struct symbol *)pvar;
+	goto pdon2;
+	}
+
+/* check for operators */
+psym = &oprtbl[3];
+for( i=0; i<NOPR; i++ )
+	{
+	if( *pline == *(psym->spel) )
+		goto pdon1;
+	++psym;
+	}
+
+/* if quoted, it is a string variable */
+if( *pline == '"' )
+	{
+	/* find an empty slot for the string */
+	pstr = strtbl;	/* string table	*/
+	for( i=0; i<NSTRNG-1; i++ ) 
+		{
+		if( (pstr->attrib & BUSY) == 0 )
+			goto fndstr;
+		++pstr;
+		}
+	printf( "No room for string\n" );
+	pstr->attrib |= ILLEG;
+	psym = (struct symbol *)pstr;
+	goto pdon0;
+
+fndstr:
+	pstr->attrib |= BUSY;
+	plc = pstr->string;
+	++pline;
+	for( i=0; i<39; i++ )
+		{
+		*plc++ = *pline;
+		if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
+			{
+illstr:
+			pstr = &strtbl[NSTRNG-1];
+			pstr->attrib |= ILLEG;
+			printf( "Missing string terminator\n" );
+			psym = (struct symbol *)pstr;
+			goto pdon0;
+			}
+		if( *pline++ == '"' )
+			goto finstr;
+		}
+
+	goto illstr;	/* no terminator found */
+
+finstr:
+	--plc;
+	*plc = '\0';
+	psym = (struct symbol *)pstr;
+	goto pdon2;
+	}
+/* If none of the above, search function and symbol tables:	*/
+
+/* copy character string to array lc[] */
+plc = &lc[0];
+while( ISALPHA(*pline) )
+	{
+	/* convert to lower case characters */
+	if( ISUPPER( *pline ) )
+		*pline += 040;
+	*plc++ = *pline++;
+	}
+*plc = 0;	/* Null terminate the output string */
+
+/*						parser()	*/
+
+psym = (struct symbol *)menstk[menptr];	/* function table	*/
+plc = &lc[0];
+cp = psym->spel;
+do
+	{
+	if( strcmp( plc, cp ) == 0 )
+		goto pdon3;	/* following unary minus is possible */
+	++psym;
+	cp = psym->spel;
+	}
+while( *cp != '\0' );
+
+psym = (struct symbol *)&indtbl[0];	/* indirect symbol table */
+plc = &lc[0];
+cp = psym->spel;
+do
+	{
+	if( strcmp( plc, cp ) == 0 )
+		goto pdon2;
+	++psym;
+	cp = psym->spel;
+	}
+while( *cp != '\0' );
+
+pdon0:
+pline = line;	/* scrub line if illegal symbol */
+goto pdon2;
+
+pdon1:
+++pline;
+if( (psym->attrib & 0xf) == RPAREN )
+pdon2:	uposs = 0;
+else
+pdon3:	uposs = 1;
+
+interl = pline;
+return( psym );
+}		/* end of parser */
+
+/*	exit from current menu */
+
+long double cmdex()
+{
+
+if( menptr == 0 )
+	{
+	printf( "Main menu is active.\n" );
+	}
+else
+	--menptr;
+
+cmdh();
+return(0.0L);
+}
+
+
+/*			gets()		*/
+
+void zgets( gline, echo )
+char *gline;
+int echo;
+{
+register char *pline;
+register int i;
+
+
+scrub:
+pline = gline;
+getsl:
+	if( (pline - gline) >= LINLEN )
+		{
+		printf( "\nLine too long\n *" );
+		goto scrub;
+		}
+	if( takptr < 0 )
+		{	/* get character from keyboard */
+/*
+if DECPDP
+		gtlin( gline );
+		return(0);
+else
+*/
+		*pline = getchar();
+/*endif*/
+		}
+	else
+		{	/* get a character from take file */
+		i = fgetc( takstk[takptr] );
+		if( i == -1 )
+			{	/* end of take file */
+			if( takptr >= 0 )
+				{	/* close file and bump take stack */
+				fclose( takstk[takptr] );
+				takptr -= 1;
+				}
+			if( takptr < 0 )	/* no more take files:   */
+				printf( "*" ); /* prompt keyboard input */
+			goto scrub;	/* start a new input line */
+			}
+		*pline = i;
+		}
+
+	*pline &= 0x7f;
+	/* xon or xoff characters need filtering out. */
+	if ( *pline == XON || *pline == XOFF )
+		goto getsl;
+
+	/*	control U or control C	*/
+	if( (*pline == 025) || (*pline == 03) )
+		{
+		printf( "\n" );
+		goto scrub;
+		}
+
+	/*  Backspace or rubout */
+	if( (*pline == 010) || (*pline == 0177) )
+		{
+		pline -= 1;
+		if( pline >= gline )
+			{
+			if ( echo )
+				printf( "\010\040\010" );
+			goto getsl;
+			}
+		else
+			goto scrub;
+		}
+	if ( echo )
+		printf( "%c", *pline );
+	if( (*pline != '\n') && (*pline != '\r') )
+		{
+		++pline;
+		goto getsl;
+		}
+	*pline = 0;
+	if ( echo )
+		printf( "%c", '\n' );	/* \r already echoed */
+}
+
+
+/*		help function  */
+long double cmdhlp()
+{
+
+printf( "%s", idterp );
+printf( "\nFunctions:\n" );
+prhlst( &funtbl[0] );
+printf( "\nVariables:\n" );
+prhlst( &indtbl[0] );
+printf( "\nOperators:\n" );
+prhlst( &oprtbl[2] );
+printf("\n");
+return(0.0L);
+}
+
+
+long double cmdh()
+{
+
+prhlst( menstk[menptr] );
+printf( "\n" );
+return(0.0L);
+}
+
+/* print keyword spellings */
+
+long double prhlst(ps)
+register struct symbol *ps;
+{
+register int j, k;
+int m;
+
+j = 0;
+while( *(ps->spel) != '\0' )
+	{
+	k = strlen( ps->spel )  -  1;
+/* size of a tab field is 2**3 chars */
+	m = ((k >> 3) + 1) << 3;
+	j += m;
+	if( j > 72 )
+		{
+		printf( "\n" );
+		j = m;
+		}
+	printf( "%s\t", ps->spel );
+	++ps;
+	}
+return(0.0L);
+}
+
+
+#if SALONE
+void init(){}
+#endif
+
+
+/*	macro commands */
+
+/*	define macro */
+long double cmddm()
+{
+
+zgets( maclin, TRUE );
+return(0.0L);
+}
+
+/*	type (i.e., display) macro */
+long double cmdtm()
+{
+
+printf( "%s\n", maclin );
+return(0.0L);
+}
+
+/*	execute macro # times */
+long double cmdem( arg )
+long double arg;
+{
+long double f;
+long n;
+long double floorl();
+
+f = floorl(arg);
+n = f;
+if( n <= 0 )
+	n = 1;
+maccnt = n;
+return(0.0L);
+}
+
+
+/* open a take file */
+
+long double take( fname )
+char *fname;
+{
+FILE *f;
+
+while( *fname == ' ' )
+	fname += 1;
+f = fopen( fname, "r" );
+
+if( f == 0 )
+	{
+	printf( "Can't open take file %s\n", fname );
+	takptr = -1;	/* terminate all take file input */
+	return(0.0L);
+	}
+takptr += 1;
+takstk[ takptr ]  =  f;
+printf( "Running %s\n", fname );
+return(0.0L);
+}
+
+
+/*	abort macro execution */
+long double abmac()
+{
+
+maccnt = 0;
+interl = line;
+return(0.0L);
+}
+
+
+/* display integer part in hex, octal, and decimal
+ */
+long double hex(qx)
+long double qx;
+{
+long double f;
+long z;
+long double floorl();
+
+f = floorl(qx);
+z = f;
+printf( "0%lo  0x%lx  %ld.\n", z, z, z );
+return(qx);
+}
+
+#define NASC 16
+
+long double bits( x )
+long double x;
+{
+int i, j;
+unsigned short dd[4], ee[10];
+char strx[40];
+unsigned short *p;
+
+p = (unsigned short *) &x;
+for( i=0; i<NE; i++ )
+	ee[i] = *p++;
+
+j = 0;
+for( i=0; i<NE; i++ )
+	{
+	printf( "0x%04x,", ee[i] & 0xffff );
+	if( ++j > 7 )
+		{
+		j = 0;
+		printf( "\n" );
+		}
+	}
+printf( "\n" );
+
+/* double conversions
+ */
+*((double *)dd) = x;
+printf( "double: " );
+for( i=0; i<4; i++ )
+	printf( "0x%04x,", dd[i] & 0xffff );
+printf( "\n" );
+
+#if 1
+printf( "double -> long double: " );
+*(long double *)ee = *(double *)dd;
+for( i=0; i<6; i++ )
+	printf( "0x%04x,", ee[i] & 0xffff );
+printf( "\n" );
+e53toasc( dd, strx, NASC );
+printf( "e53toasc: %s\n", strx );
+printf( "Native printf: %.17e\n", *(double *)dd );
+
+/* float conversions
+ */
+*((float *)dd) = x;
+printf( "float: " );
+for( i=0; i<2; i++ )
+	printf( "0x%04x,", dd[i] & 0xffff );
+printf( "\n" );
+e24toe( dd, ee );
+printf( "e24toe: " );
+for( i=0; i<NE; i++ )
+	printf( "0x%04x,", ee[i] & 0xffff );
+printf( "\n" );
+e24toasc( dd, strx, NASC );
+printf( "e24toasc: %s\n", strx );
+/* printf( "Native printf: %.16e\n", (double) *(float *)dd ); */
+
+#ifdef DEC
+printf( "etodec: " );
+etodec( x, dd );
+for( i=0; i<4; i++ )
+	printf( "0x%04x,", dd[i] & 0xffff );
+printf( "\n" );
+printf( "dectoe: " );
+dectoe( dd, ee );
+for( i=0; i<NE; i++ )
+	printf( "0x%04x,", ee[i] & 0xffff );
+printf( "\n" );
+printf( "DEC printf: %.16e\n", *(double *)dd );
+#endif
+#endif /* 0 */
+return(x);
+}
+
+
+/* Exit to monitor. */
+long double mxit()
+{
+
+exit(0);
+return(0.0L);
+}
+
+
+long double cmddig( x )
+long double x;
+{
+long double f;
+long lx;
+
+f = floorl(x);
+lx = f;
+ndigits = lx;
+if( ndigits <= 0 )
+	ndigits = DEFDIS;
+return(f);
+}
+
+
+long double csys(x)
+char *x;
+{
+void system();
+
+system( x+1 );
+cmdh();
+return(0.0L);
+}
+
+
+long double ifrac(x)
+long double x;
+{
+unsigned long lx;
+long double y, z;
+
+z = floorl(x);
+lx = z;
+y = x - z;
+printf( " int = %lx\n", lx );
+return(y);
+}
+
+long double xcmpl(x,y)
+long double x,y;
+{
+long double ans;
+char str[40];
+
+#if NE == 6
+		e64toasc( &x, str, 100 );
+		printf( "x = %s\n", str );
+		e64toasc( &y, str, 100 );
+		printf( "y = %s\n", str );
+#else
+		e113toasc( &x, str, 100 );
+		printf( "x = %s\n", str );
+		e113toasc( &y, str, 100 );
+		printf( "y = %s\n", str );
+#endif
+
+ans = -2.0;
+if( x == y )
+	{
+	printf( "x == y " );
+	ans = 0.0;
+	}
+if( x < y )
+	{
+	printf( "x < y" );
+	ans = -1.0;
+	}
+if( x > y )
+	{
+	printf( "x > y" );
+	ans = 1.0;
+	}
+return( ans );
+}
+
+long double zstdtrl(k,t)
+long double k, t;
+{
+int ki;
+long double y;
+ki = k;
+y = stdtrl(ki,t);
+return(y);
+}
+
+long double zstdtril(k,t)
+long double k, t;
+{
+int ki;
+long double y;
+ki = k;
+y = stdtril(ki,t);
+return(y);
+}
+
+#ifdef NANS
+long double zisnan(x)
+long double x;
+{
+  long double y;
+  int k;
+  k = isnanl(x);
+  y = k;
+  return(y);
+}
+long double zisfinite(x)
+long double x;
+{
+  long double y;
+  int k;
+  k = isfinitel(x);
+  y = k;
+  return(y);
+}
+long double zsignbit(x)
+long double x;
+{
+  long double y;
+  int k;
+  k = signbitl(x);
+  y = k;
+  return(y);
+}
+#endif