eval.c

smallbasic for linux

/*
*	expressions (byte-code)
*
*	Nicholas Christopoulos
*
*	This program is distributed under the terms of the GPL v2.0 or later
*	Download the GNU Public License (GPL) from www.gnu.org
*/

#include "sys.h"
#include "str.h"
#include "kw.h"
#include "panic.h"
#include "var.h"
#include "blib.h"
#include "device.h"
#include "pproc.h"

extern int prog_error;
extern byte *prog_source;
extern word prog_ip;
extern word prog_line;
extern var_t **tvar;
extern lab_t *tlab;

#define	IP					prog_ip
#define	CODE(x)				prog_source[(x)]

#define	CODE_PEEK()			CODE(IP)

#define	CHECKOP1(s)			if (CODE(IP) == kwTYPE_OPR && CODE(IP+1) == (s)) { IP += 2; return (s); }
#define	CHECKOP2(s,o)		if (CODE(IP) == kwTYPE_OPR && CODE(IP+1) == (s)[0] && CODE(IP+2) == kwTYPE_OPR && CODE(IP+3) == (s)[1]) { IP += 4; return (o); }
#define	CHECKOP3(s,o)		if ( code_checkop_s((s)) ) { IP += 6; return (o); }
#define V_FREE(v)			if ( (v) ) { if ( (v)->type == V_STR ) { if ((v)->ptr) tmp_free((v)->ptr); (v)->ptr=NULL; (v)->size=0; } }

void	eval(var_t *result)				;

void	eval_rte_syntax_error(void)	SEC(TRASH);
void	eval_rte_syntax_error(void)		{ rt_raise("(EXPR): SYNTAX ERROR"); }

void	eval_rte_out_of_range(void)	SEC(TRASH);
void	eval_rte_out_of_range(void)		{ rt_raise("(EXPR): OUT OF RANGE"); }

void	eval_rte_type_mismatch(void) SEC(TRASH);
void	eval_rte_type_mismatch(void)	{ rt_raise("(EXPR): TYPE MISMATCH"); }

void	eval_rte_missing_lp(void)	SEC(TRASH);
void	eval_rte_missing_lp(void)		{ rt_raise("(EXPR): MISSING '('"); }

void	eval_rte_missing_rp(void)	SEC(TRASH);
void	eval_rte_missing_rp(void)		{ rt_raise("(EXPR): MISSING ')'"); }

void	eval_rte_missing_sep(void)	SEC(TRASH);
void	eval_rte_missing_sep(void)		{ rt_raise("(EXPR): MISSING SEPARATOR OR PARENTHESIS"); }

void	eval_rte_division_by_zero(void)	SEC(TRASH);
void	eval_rte_division_by_zero(void)	{ rt_raise("(EXPR): DIVISION BY ZERO"); }

/*
*	Convertion multi-dim index to one-dim index
*/
word	getarrayidx(var_t *array)
{
	byte	code;
	var_t	var;
	word	idx = 0, lev = 0, m = 0;
	word	idim, i;

	do	{
		v_init(&var);
		eval(&var);
		if	( prog_error )	return 0;
		idim = v_getint(&var);
		v_free(&var);

		if	( prog_error )	
			return 0;

		idim = idim - array->lbound[lev];

		m = idim;
		for ( i = lev+1; i < array->maxdim; i ++ )	
			m = m * (ABS(array->ubound[i] - array->lbound[i]) + 1);
		idx += m;

		// skip separator
		code = CODE_PEEK();
		if	( code == kwTYPE_SEP )	{
			IP ++;
			if	( code_getnext() != ',' )
				eval_rte_syntax_error();
			}

		// next
		lev ++;
		} while ( CODE_PEEK() != kwTYPE_LEVEL_END );

	if	( !prog_error )		{
		if	( array->maxdim != lev )	
			eval_rte_missing_sep();
		}
	return idx;
}

/*
*	main
*/
void	eval(var_t *r)
{
	byte	code, op;
	byte	level = 0;
	word	len;
	var_t	*var_p;
	word	array_index;
	var_t	*left = NULL, vtmp;
	// stack
	var_t	stk[24];		//
	word	sp = 0;			// stack pointer
	stknode_t	udf_rv;

	r->type = V_INT;
	r->i = 0L;

	do	{
		code = CODE(IP);	IP ++;
		
		switch ( code )	{
		case	kwTYPE_INT:
			V_FREE(r);
			r->type = V_INT;
			r->i    = code_getnext32();	// 32-bit value
			break;

		case	kwTYPE_NUM:
			V_FREE(r);
			r->type = V_NUM;
			r->n    = code_getnext64f(); // 64-bit floating-point value
			break;

		case	kwTYPE_STR:
			V_FREE(r);
			r->type = V_STR;
			len = code_getnext16();	// 16-bit value (string length)
			r->ptr = tmp_alloc(len+1);
			memcpy(r->ptr, &prog_source[prog_ip], len);
			*((char *) (r->ptr+len)) = '\0';
			r->size = len;

			IP += len;
			break;

		//////////////// variable ///////////////////
		case	kwTYPE_VAR:
			V_FREE(r);

			var_p = tvar[code_getnext16()];

			switch ( var_p->type )	{
			case	V_INT:
				r->type = V_INT;
				r->i = var_p->i;
				break;
			case	V_NUM:
				r->type = V_NUM;
				r->n = var_p->n;
				break;
			case	V_STR:
				v_set(r, var_p);
				break;
			case	V_ARRAY:
				// copy element of array

				if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
					eval_rte_missing_lp();
				else	{
					IP ++;		// '('
					array_index = getarrayidx(var_p);
					if	( !prog_error )	{
						if	( array_index < var_p->size )	{
							v_set(r, v_getelemptr(var_p, array_index));
							if	( CODE_PEEK() == kwTYPE_SEP )	
								IP ++;		// ','
							else if	( CODE_PEEK() == kwTYPE_LEVEL_END )	
								IP ++;		// ')'
							else
								eval_rte_missing_lp();
							} // idx < v->size
						else	
							eval_rte_out_of_range();
						} // !prog_err
					} // 
				break; 
				};	// switch(type)

			break;

		/////////////// STACK //////////////////
		case	kwTYPE_EVPUSH:		// PUSH RESULT
			switch ( r->type )	{
			case	V_INT:
				stk[sp].type = V_INT;
				stk[sp].i = r->i;
				break;
			case	V_NUM:
				stk[sp].type = V_NUM;
				stk[sp].n = r->n;
				break;
			case	V_STR:
				len = r->size;
				stk[sp].type = V_STR;
				stk[sp].ptr = tmp_alloc(len+1);
				strcpy(stk[sp].ptr, r->ptr);
				stk[sp].size = len;
				break;
				}
			sp ++;
			break;

		case	kwTYPE_EVPOP:		// POP LEFT
			sp --;
			left = &stk[sp];
			break;

		//////////////// ADD ///////////////////
		case kwTYPE_ADDOPR:
			op = CODE(IP);	IP ++;

			if ( r->type == V_INT && left->type == V_INT )	{
				if	( op == '+' )
					r->i += left->i;
				else
					r->i = left->i - r->i;
				}
			else if ( r->type == V_NUM && left->type == V_NUM )	{
				r->type = V_NUM;
				if	( op == '+' )
					r->n += left->n;
				else
					r->n = left->n - r->n;
				}
			else if ( r->type == V_INT && left->type == V_NUM )	{
				r->type = V_NUM;
				if	( op == '+' )
					r->n = r->i + left->n;
				else
					r->n = left->n - r->i;
				}
			else if ( r->type == V_NUM && left->type == V_INT )	{
				if	( op == '+' )
					r->n += left->i;
				else
					r->n = left->i - r->n;
				}
			else	{
				v_init(&vtmp);
				switch ( op )	{
				case	'+':
					v_add(&vtmp, left, r);
					break;
				case	'-':
					if	( vtmp.type == V_NUM )	{
						vtmp.type = V_NUM;
						vtmp.n = v_getval(left) - v_getval(r);
						}
					else	{
						vtmp.type = V_INT;
						vtmp.i = v_igetval(left) - v_igetval(r);
						}
					break;
					};
				
				V_FREE(left);
				v_set(r, &vtmp);
				V_FREE(&vtmp);
				}

			break;

		//////////////// MUL ///////////////////
		case kwTYPE_MULOPR:
			op = CODE(IP);	IP ++;

			switch ( op )	{
			case	'*':
				r->n = v_getval(left) * v_getval(r);
				break;
			case	'/':
				if	( v_getval(r) == 0 )
					eval_rte_division_by_zero();
				else	
					r->n = v_getval(left) / v_getval(r);
				break;
			case	'\\':
				if	( v_igetval(r) == 0 )
					eval_rte_division_by_zero();
				else	
					r->i = v_igetval(left) / v_igetval(r);
				break;
			case	'%':
				if	( v_igetval(r) == 0 )
					eval_rte_division_by_zero();
				else	
					r->i = v_igetval(left) % v_igetval(r);
				break;
				};

			// cleanup
			if	( r->type == V_STR )	{
				if	( r->ptr )
					tmp_free(r->ptr);
				}

			if	( op == '*' || op == '/' )
				r->type = V_NUM;	// double always
			else
				r->type = V_INT;

			V_FREE(left);
			break;

		//////////////// UNARY ///////////////////
		case kwTYPE_UNROPR:
			op = CODE(IP);	IP ++;

			switch ( op )	{
			case	'-':
				if	( r->type == V_INT )	
					r->i = -r->i;
				else if	( r->type == V_NUM )
					r->n = -r->n;
				else	{
					r->n = -v_getval(r);
					if	( r->ptr )
						tmp_free(r->ptr);
					r->type = V_NUM;
					}
				break;
			case	'+':
				break;
			case	OPLOG_NOT:	// The result of ! is always integer
				r->i = !v_igetval(r);
				if	( r->type == V_STR )	{
					if	( r->ptr )
						tmp_free(r->ptr);
					}
				r->type = V_INT;
				break;
				}

			// cleanup
			break;

		//////////////// LOGICAL ///////////////////
		case kwTYPE_LOGOPR:
			op = CODE(IP);	IP ++;

			switch ( op )	{
			case	OPLOG_AND:
				r->i = v_igetval(left) && v_igetval(r);
				break;
			case	OPLOG_OR:
				r->i = v_igetval(left) || v_igetval(r);
				break;
			case	OPLOG_XOR:
				r->i = v_igetval(left) ^ v_igetval(r);
				break;
				};

			// cleanup
			V_FREE(left);
			V_FREE(r);

			//
			r->type = V_INT;
			break;

		//////////////// COMPARE ///////////////////
		case kwTYPE_CMPOPR:
			op = CODE(IP);	IP ++;

			switch ( op )	{
			case	OPLOG_EQ:
				r->i = (v_compare(left, r) == 0);
				break;
			case	OPLOG_GT:
				r->i = (v_compare(left, r) > 0);
				break;
			case	OPLOG_GE:
				r->i = (v_compare(left, r) >= 0);
				break;
			case	OPLOG_LT:
				r->i = (v_compare(left, r) < 0);
				break;
			case	OPLOG_LE:
				r->i = (v_compare(left, r) <= 0);
				break;
			case	OPLOG_NE:
				r->i = (v_compare(left, r) != 0);
				break;
				}

			// cleanup
			V_FREE(left);
			V_FREE(r);
			//
			r->type = V_INT;
			break;

		//////////////// POW ///////////////////
		case kwTYPE_POWOPR:
			op = CODE(IP);	IP ++;

			r->n = pow(v_getval(left), v_getval(r));
			V_FREE(r);
			r->type = V_NUM;

			// cleanup
			V_FREE(left);
			break;

		/////////////////////////////////////////////////////////////////////////////////

		case kwTYPE_LEVEL_BEGIN:
			level ++;
			break;

		case kwTYPE_LEVEL_END:
			if	( level == 0 )	{
				IP --;
				return;
				}

			level --;
			break;

		/////////////////////////////////////////////////////////////////////////////////

		// num FUNC(STR)
		case kwASC:		case kwLEN:		case kwVAL:
		case kwTEXTWIDTH: case kwTEXTHEIGHT:
		case kwEXIST:
			V_FREE(r);

			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				IP ++;

				v_init(&vtmp);
				eval(&vtmp);
				if	( prog_error )	return;
				cmd_ns1(code, &vtmp, r);
				V_FREE(&vtmp);

				if	( CODE_PEEK() != kwTYPE_LEVEL_END )
					eval_rte_missing_rp();
				else
					IP ++;
				}
			break;

		// str FUNC(any)
		case kwCHR:		case kwSTR:
		case kwOCT:		case kwHEX:
		case kwLCASE:	case kwUCASE:
		case kwLTRIM:	case kwRTRIM:
		case kwSPACE:	case kwTAB:
		case kwCAT:
			V_FREE(r);

			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				IP ++;

				v_init(&vtmp);
				eval(&vtmp);
				if	( prog_error )	return;

				r->type = V_STR;
				cmd_str1(code, &vtmp, r);
				V_FREE(&vtmp);

				if	( CODE_PEEK() != kwTYPE_LEVEL_END )
					eval_rte_missing_rp();
				else
					IP ++;
				}
			break;

		// str FUNC(...)
		case kwSTRING:
		case kwLEFT:	case kwRIGHT:
		case kwMID:
			V_FREE(r);

			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				r->type = V_STR;

				IP ++;		// '('
				cmd_strN(code, r);
				if	( prog_error )	return;
				if	( CODE_PEEK() == kwTYPE_SEP )	
					IP ++;		// ','
				else if	( CODE_PEEK() == kwTYPE_LEVEL_END )	
					IP ++;		// ')'
				else
					eval_rte_missing_rp();
				}
			break;

		// str FUNC(void)
		case kwINKEY:
		case kwTIME:
		case kwDATE:
			V_FREE(r);

			cmd_str0(code, r);
			break;

		// int FUNC(...)
		case kwINSTR:
		case kwLBOUND:	case kwUBOUND:
			V_FREE(r);

			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				r->type = V_INT;

				IP ++;		// '('
				cmd_intN(code, r);
				if	( prog_error )	return;
				if	( CODE_PEEK() == kwTYPE_SEP )	
					IP ++;		// ','
				else if	( CODE_PEEK() == kwTYPE_LEVEL_END )	
					IP ++;		// ')'
				else
					eval_rte_missing_sep();
				}
			break;

		// fp FUNC(...)
		case kwATAN2:	case kwPOW:
		case kwROUND:
			V_FREE(r);

			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				r->type = V_NUM;

				IP ++;		// '('
				cmd_numN(code, r);
				if	( prog_error )	return;
				if	( CODE_PEEK() == kwTYPE_SEP )	
					IP ++;		// ','
				else if	( CODE_PEEK() == kwTYPE_LEVEL_END )	
					IP ++;		// ')' level
				else
					eval_rte_missing_sep();
				}
			break;

		// fp FUNC(fp)
		case kwCOS:		case kwSIN: 	case kwTAN:
		case kwCOSH:	case kwSINH: 	case kwTANH:
		case kwACOS:	case kwASIN:	case kwATAN:
		case kwACOSH:	case kwASINH:	case kwATANH:
		case kwSQR:		case kwABS:		case kwEXP:
		case kwLOG:		case kwLOG10:
		case kwFIX:		case kwINT:		case kwCDBL:
		case kwDEG:		case kwRAD:		case kwPEN:
			V_FREE(r);

			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				IP ++;

				v_init(&vtmp);
				eval(&vtmp);
				if	( prog_error )	return;

				r->type = V_NUM;
				r->n = cmd_math1(code, &vtmp);
				V_FREE(&vtmp);
				if	( prog_error )	return;

				if	( CODE_PEEK() != kwTYPE_LEVEL_END )
					eval_rte_missing_rp();
				else
					IP ++;
				}
			break;

		// int FUNC(fp)
		case kwFRE:	case kwSGN:	case kwCINT:
		case kwEOF:	case kwSEEK: case kwLOF:

			V_FREE(r);

			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				IP ++;

				v_init(&vtmp);
				eval(&vtmp);
				if	( prog_error )	return;

				r->type = V_INT;
				r->i = cmd_imath1(code, &vtmp);
//				v_free(&vtmp);

				if	( CODE_PEEK() != kwTYPE_LEVEL_END )
					eval_rte_missing_rp();
				else
					IP ++;
				}
			break;

		// fp FUNC(void)
		case kwRND:		
			V_FREE(r);

			vtmp.type = V_NUM;
			vtmp.n = 0;
			r->type = V_NUM;
			r->n = cmd_math1(code, &vtmp);
			break;

		case kwMAX:	case kwMIN:
		case kwINPUTSEP:

			V_FREE(r);
			if	( CODE_PEEK() != kwTYPE_LEVEL_BEGIN )
				eval_rte_missing_lp();
			else	{
				IP ++;

				cmd_genfunc(code, r);
				if	( prog_error )	return;

				if	( CODE_PEEK() != kwTYPE_LEVEL_END )
					eval_rte_missing_rp();
				else
					IP ++;
				}
			break;

		// int FUNC(void)
		case kwTICKS:	case kwTICKSPERSEC:	case kwTIMER:
			V_FREE(r);

			vtmp.type = V_INT;
			vtmp.i = 0;
			r->type = V_INT;
			r->i = cmd_imath1(code, &vtmp);
			break;

		case kwFREEFILE:
			V_FREE(r);

			r->type = V_INT;
			r->i = dev_freefilehandle();
			break;

		case kwTYPE_CALL_UDF:

			prog_ip --;
			bc_loop(1);
			
			if	( !prog_error )	{
				code_pop(&udf_rv);
				if	( udf_rv.type != kwTYPE_RET )	
					err_stackmess();
				else	{
					v_set(r, udf_rv.x.vdvar.vptr);
					v_free(udf_rv.x.vdvar.vptr);				// free ret-var
					tmp_free(udf_rv.x.vdvar.vptr);
					}
				}

			break;

		//////////////////////////////////////
		default:
			IP --;
			return;
			};

		// run-time error check
		if	( prog_error )	
			return;
		
		} while ( 1 );

}