File:  [Research Unix] / researchv10no / cmd / basic / bite / src / evalx.c
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 17:21:35 2018 UTC (8 years, 1 month ago) by root
Branches: belllabs, MAIN
CVS tags: researchv10, HEAD
researchv10 Norman

/* Copyright Bell Telephone Laboratories Whippany, N.J.

 *	/////////////////////////////////////
 *	/////////////////////////////////////
 *	////////////// evalx.c //////////////
 *	/// J. P. Hawkins WH X4610 8C-001 ///
 *	///// Fri Aug 24 16:40:38 1979 //////
 *	/////////////////////////////////////
 *	/////////////////////////////////////

 *
 * calling format:
 *
 *	double value;
 *	double evalx();
 *	value = evalx(expstr)
 *
 *	where:	dummy is now unused
 *		expstr is the char string representing the expression
 *			to be evaluated. The string must be terminated
 *			by a character between values 0 -> 37(8).
 *			0 is the usual ascii string terminator. Values
 *			between 001(8) and 37(8) are keyword codes
 *			for secondary operations like "then" in an "if"
 *			statement or "to" in a "for" statement.
 *
 */
/*   "@(#) evalx.c:  V 1.9  4/21/81" */
/*
 * MOD,J.P.Hawkins,31-JAN-81 detects strings and string vars. mixed in
 *		numerical expressions as reject.
 */
#include	"bas.h"
#define	STKSIZ	6	/* stack size */

int strflg;
/*
#define	skip00() {while(*expptr == ' ' || *expptr == '\t') *expptr++;}
*/
#define	skip00()	{}	/* do nothing */
extern	int	stpflg;		/* stop flag for fatal error */
	double	pow();
	double	atof1();
	double	mathcall();

	char	*eoexpr;	/* pointer to end of expression */
/*
 *
 *
 */
double
evalx(exps)
char	exps[];		/* pointer to expression string */
{
	char	*expptr;	/* expression string pointer */
	char	ostack[STKSIZ];	/* operator stack */
	double	nstack[STKSIZ];	/* number stack		*/
	int	opflag;		/* set when operator encountered
				    cleared when variable or non-op
				     encountered. Used to deal with
				      unaries by forcing a 0.0 on the
					number stack */
	int	o, n;		/* indicies for ostack & nstack */

	char	field[80];	/* expression field */
	int	type;		/* field type returned by class */
	expptr = exps;	/* init expression string pointer */
	o = n = STKSIZ;	/* init operator and
			    variable stack pointer */
	opflag = 0;	/* init opflag */
/*
 *
 * The only ways out of this loop are string terminator or
 * expression terminator (null char)
 * the codes 1 through 37(8) represent encoded keywords (defined in bed.c)
 * those being:
 * goto,go to,then,to,step,<=,=<,<,>=,=>,>, =, or <>
 *
 * This "while" loop is
 * not indented so "all this stuff" fits across standard page
 */
while(!(*expptr >= '\0' && *expptr <= '\37'))
{
	if((type = class(&expptr, field)) < 0) /* get field and type */
	{
		error(inst.thing.linno, 8);	/* EXPR SYNTAX */
		error(inst.thing.linno, 15);		/* FATAL ERROR */
		stpflg = 1;
		return(0.0);/* return zero on error */
	}

	switch(type){
#ifdef	STRINGS
		case SVCLASS:
		case STCLASS:
		case SFCLASS:
		case SACLASS:
			error(inst.thing.linno, 49); /* ST. in NUM */
			stpflg = 1;
			return(0.0);
			break;
#endif
		case VRCLASS:	/* VARIABLE CLASS */
			getvar(field, &nstack[--n]);
			opflag = 0;
			break;
		case VACLASS:	/* SUBSCRIPTED VARIABLE */
			agetvar(field,&nstack[--n]);
			opflag = 0;
			break;
		case NMCLASS:	/* NUMERIC FIELD */
			nstack[--n] = atof1(field);
			opflag = 0;
			break;
		case FNCLASS:	/* FUNCTION REFERENCE */
			nstack[--n] = mathcall(field);
			opflag = 0;
			break;
		case OPCLASS:	/* OPERATOR */
			switch(*field) {
				case '(': /* begin of expres */
					nstack[--n] = evalx(expptr);
					opflag = 0;
					expptr = eoexpr; /* put pointer
							   to correct place */
					break;
				case ')': /* end of express */
					/*
					 * eval the rest of the expr
					 * between the parens
					 */
					cleanup(nstack,ostack,&n,&o);
					eoexpr = expptr;
					return(nstack[n]);
					break;
				case '+':
				case '-':
				case '*':
				case '/':
				case '^':
					/*
					 * handle unaries by forcing
					 * a 0.0 onto the nstack before
					 * stacking the operator.
					 * This occurs when two operators
					 * in a row are encountered or the
					 * variable stack is empty when
					 * an operator encountered.
					 */
					if(opflag || n == STKSIZ)
						nstack[--n] = 0.0;
					opflag = 1;
					stackop(*field,nstack,ostack,&n,&o);
					break;
				default:
					break;
			}
			break;
		default:
			printf("WHAT HAPPENED? TYPE = %d\n", type);
			break;
		}
		/*
		 * skip trailing white space so that
		 * test at top of this loop fails when
		 * it's supposed to
		 */
		skip00();
}	/* END OF WHILE LOOP */

	cleanup(nstack,ostack,&n,&o);
	eoexpr = expptr;	/* save end of expr pointer for
				    "for", "if" and other commands */
	return(nstack[n]);
}
/*
 *
 * //// STACK OPERATOR IF PRECIDENCE TEST IS PASSED ////
 */
stackop(op,nstack,ostack,n,o)
char	op;
double	nstack[];
char	ostack[];
int	*n;
int	*o;
{

	/*
	 * if precidence of current operator is
	 * HIGHER than the operator on top of the stack
	 * or the OPERATOR stack is EMPTY,
	 * the precidence test has "passed" so just push
	 * the current operator onto the operator stack.
	 */
	if(*o == STKSIZ)	/* if stack is empty */
	{
		ostack[--(*o)] = op;	/* stack operator
					    precidence done only
					     if stack NOT empty */
		return 0;
	}
	if(precid(op) > precid(ostack[*o]))
	{
		ostack[--(*o)] = op;
	}
	else
	{
		/*
		 * OTHERWISE if the current operator
		 * precidence is LESS than or EQUAL to the
		 * operator on the top of the stack
		 * "unstack" the operators from the operator
		 * stack until either the stack is empty
		 * or the precidence test passes
		 */
		while((precid(op) <= precid(ostack[*o])) && *o < STKSIZ)
			if(unstack(nstack,ostack,n,o) < 0)
			{
				return(-1); /* break loop if bad operator
						encountered */
			}

		ostack[--(*o)] = op;
	}
	return 0;
}
/*
 *
 * //// RETURN PRECIDENCE OF OPERATOR IN c ////
 */
precid(c)
char c;
{
static char olist[] = "+1-1*2/2^3"; /* list of operators & precidence */
	register int p;	/* scanning register */

	for(p=0; olist[p] != '\0'; p += 2)
	{
		if(c == olist[p])
			return(olist[p+1] - '0');
	}
	return(-1);	/* if we get here, we're in trouble! */
}




/*
 * //// CLEANUP THE REST OF THE EXPRESSION ////
 *
 * "pop and do" operations on opstack until
 * stack empty
 */
cleanup(nstack,ostack,n,o)
double	nstack[];
char	ostack[];
int	*n;
int	*o;
{
	while(*o < STKSIZ)
		if(unstack(nstack,ostack,n,o) < 0)
			return(-1);	/* break loop if bad operator
						encountered */
	return 0;
}
/*
 *
 * //// POP OPERATER OFF TOP OF OPSTACK ////
 * //// AND PERFORM THAT OPERATION ON //////
 * //// TOP TWO NUMBERS ON NSTACK //////////
 * //// NSTACK GETS POPPED AND RESULT //////
 * //// IS LEFT ON TOP /////////////////////
 * //// THOSE OPERATIONS ON TOP TWO NUMS /////
 */
unstack(nstack,ostack,n,o)
double	nstack[];
char	ostack[];
int	*n;
int	*o;
{
	switch(ostack[*o])
	{
		case '^':
			nstack[*n+1] = pow(nstack[*n+1],nstack[*n]);
			break;
		case '*':
			nstack[*n+1] = nstack[*n+1] * nstack[*n];
			break;
		case '/':
			if(nstack[*n] == 0.0) /* catch overflow */
			{
				error(inst.thing.linno, 29); /* OVERFLOW ERR */
				break;
			}
			nstack[*n+1] = nstack[*n+1] / nstack[*n];
			break;
		case '+':
			nstack[*n+1] = nstack[*n+1] + nstack[*n];
			break;
		case '-':
			nstack[*n+1] = nstack[*n+1] - nstack[*n];
			break;
		default:
			error(inst.thing.linno, 8);
			return(-1);
			break;
	}
	(*n)++;		/* pop number stack */
	(*o)++;		/* pop operator stack */
	return(0);
}
/*
 *
 * ////// CALL MATH FUNCTION ////////
 *
 *
 *
 * callin format:
 *	value = mathcall(string);
 *
 *	where: value = floating point value returned by call
 *	       string = pointer to a null terminated string containong
 *			the func text and expression within () - 
 *			i.e. "sin(EXPRESSION TEXT)"
 */

/*
 *
 * //////// BASIC INTERPRETER MATH TABLE ////////
 *
 */
#ifndef TEST
double	sin();
double	cos();
double	atan();
double	log();
double	tan();
double	fact();
#ifdef	STRINGS
double	len();
double	val();
double	asc();
#endif
#endif
/*
 * //// INSTRUMENT FUNCTIONS ////
 */
#ifdef	TEST
double	dvmr();
double	button();
double	berror();
#endif
double exp();
double _int(num)
double num;
{
	long	trunc;	
	trunc=num;
	num=trunc;
	return(num);
}
#ifndef TEST
double sqroot(num)
double num;
{
	if(num < 0.0)	
		error(inst.thing.linno, 19);
	return(pow(num, 0.5));	
}

#endif
double absolute(num)
double num;
{
	double	fabs();
	return(fabs(num));
}

double rndgen(num)
double	num;
{
	double	rndnum;
	rndnum = rand();	
	return((rndnum/32767.0) * num + 1);	
}
/*
 *
 * This is the BASIC interpreter math func strin and routine
 * dispatch table.
 *
 */

/*
 * each entry contains the text for the MATH FUNCTION
 * in question and the address of the routine which services it
 */
struct tbl
	{
		char *cmdtxt;
		double (*func)();
	};
#ifndef TEST
struct tbl mathtbl[] = {
	{"sin",		sin},
	{"cos",		cos},
	{"exp",		exp},
	{"log",		log},
	{"int",		_int},
	{"sqr",		sqroot}, 
	{"abs",		absolute},
	{"atn",		atan},
	{"rnd",		rndgen},	
	{"tan",		tan},
	{"fact",	fact},
#ifdef	STRINGS
	{(char *)1,	0},	/* String function fence */
	{"len",		len},
	{"val",		val},
	{"asc",		asc},
#endif
/* THIS STUFF NOT INCLUDED YET
	{"cot",		cotang},
	{"clg",		log10},
	{"sgn",		sign},
*/
	{0,		0}	
	};
#endif
#ifdef TEST
struct tbl mathtbl[] {
	{"abs",		absolute},
	{"rnd",		rndgen},
	{"int",		_int},
	{"exp",		exp},
	{"dvmr",	dvmr},
	{"btn",		button},
	{"error",	berror},
	{0,		0}
	};
#endif
/*
 *
 */
double
mathcall(s)
char	s[];
{
	char	funnam[10]; /* func name copied from 's'
				used for string search */
	register char *x; /* pointer to paren enclosed expression */
	double	evalx();
	double	value;	/* final value returned */
	double	exvalue; /* value of expression before being operated
			     upon by the math func */
	register  int i;		/* index reg. for expediency */
	x = s;		/* set pointer to func string */
	/*
	 * copy the func name part up to the '('
	 * to use for a string search in the table of names
	 */
	for(i=0; *x != '(' ;)
	{
		funnam[i++] = *x++;
	}
	funnam[i] = '\0';	/* null terminate */
	/*
	 * compare each string in table with funnam
	 * when match is found, call using offset code
	 * if end-of-table (null) encountered return 0
	 */
#ifdef	STRINGS
	strflg = 0;
#endif
	for(i=0; mathtbl[i].cmdtxt != 0 ; i++)
	{
#ifdef	STRINGS
		if(mathtbl[i].cmdtxt == (char *)1)
		{
			i++;
			strflg = 1;	/* its a string type */
		}
#endif
		if(!(strcmp(funnam, mathtbl[i].cmdtxt)))
		{
			x++;
#ifdef	STRINGS
			if(strflg == 0)
			{
#endif
				exvalue = evalx(x); 
				value = (*mathtbl[i].func)(exvalue);
				return(value);
#ifdef	STRINGS
			}
			else
			{
				value = (*mathtbl[i].func)(x);
				return(value);
			}
#endif
		}
	}
	error(inst.thing.linno, 17);	/* unknown math function */
	return(0.0);	/* oops not in this table, pal */
}

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.