blib.c

smallbasic for linux

/*
*	SmallBASIC RTL - STANDARD COMMANDS
*
*	2000-05-27, 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
*/

#define ERROR_CHECK_LEVEL 2
#include "sys.h"
#include "str.h"
#include "kw.h"
#include "panic.h"
#include "var.h"
#include "device.h"
#include "blib.h"
#include "pproc.h"
#include "smbas.h"

//
//	LET v[(x)] = any
//	CONST v[(x)] = any
//
void	cmd_let(int allowConst)
{
	var_t	*var_p = NULL;
	var_t	arg;
	int		nullarr = 0;

	if	( code_isnullarray_nc(0) )	{
		var_p = tvar[code_getnext16()];
		nullarr = 1;
		}
	else
		var_p = code_getvarptr();

	if	( !prog_error )	{
		if	( var_p->const_flag && !allowConst )	{
			rt_raise("CANNOT USE CONSTANT");
			return;		
			}

		if	( prog_source[prog_ip] == kwTYPE_CMPOPR && prog_source[prog_ip+1] == '=' )	
			code_skipnext16();

		if	( code_isnullarray() )	
			nullarr |= 2;

		if	( nullarr )	{
			if	( nullarr == 3 || nullarr == 2 )	{	// source is array
				code_skipnext();
				v_set(var_p, tvar[code_getnext16()]);
				var_p->const_flag = allowConst;
				}
			else if ( nullarr == 1 )	{	// dest is array but source isnt
				v_init(&arg);
				eval(&arg);

				if	( arg.type == V_ARRAY )	{
					v_set(var_p, &arg);
					v_free(&arg);
					var_p->const_flag = allowConst;
					}
				else	{
					v_free(&arg);
					rt_raise("LET: WRONG ASSIGNMENT");
					}
				}
			}
		else	{
			v_init(&arg);
			eval(&arg);
			v_set(var_p, &arg);
			v_free(&arg);
			var_p->const_flag = allowConst;
			}
		}
}

//
//	DIM	var([lower TO] uppper [, ...])
//
void	cmd_dim()
{
	int		exitf = 0;

	do	{
		var_t	*var_p = NULL;
		var_t	arg, array;
		int		i, size;
		byte	code;

		code = code_peek();
		if	( code == kwTYPE_LINE || code == kwTYPE_EOC )
			exitf = 1;
		else	{
			array.maxdim = 0;
			if	( code_peek() == kwTYPE_SEP )	{
				code_skipnext();
				if	( code_getnext() != ',' )
					err_syntax();
				}
			if	( code_peek() == kwTYPE_VAR )	{
				code_skipnext();
				var_p = tvar[code_getnext16()];
				if	( code_peek() == kwTYPE_LEVEL_BEGIN )	{
					code_skipnext();

					do	{
						eval(&arg);
						if	( prog_error )		return;

						if	( code_peek() == kwTO )	{
							array.lbound[array.maxdim] = v_getint(&arg);
							code_skipnext();
							eval(&arg);
							if	( prog_error )		return;

							array.ubound[array.maxdim] = v_getint(&arg);
							}
						else	{
							array.lbound[array.maxdim] = 0;
							array.ubound[array.maxdim] = v_getint(&arg);
							}
						v_free(&arg);
						array.maxdim ++;

						// skip separator
						if	( code_peek() == kwTYPE_SEP )	{
							code_skipnext();
							if	( code_getnext() != ',' )
								err_syntax();
							}

						} while ( code_peek() != kwTYPE_LEVEL_END );

					code_skipnext();	// ')', level
					}
				else	
					err_syntax();
				}
			else
				err_syntax();

			//
			//	run...
			//
			if	( !prog_error )	{
				size = 1;
				for ( i = 0; i < array.maxdim; i ++ )	
					size = size * (ABS(array.ubound[i] - array.lbound[i]) + 1);

				v_free(var_p);
				var_p->type = V_ARRAY;
				var_p->size = size;
				var_p->maxdim = array.maxdim;
				for ( i = 0; i < array.maxdim; i ++ )	{
					var_p->lbound[i] = array.lbound[i];
					var_p->ubound[i] = array.ubound[i];
					}
				var_p->ptr = tmp_alloc(size * sizeof(var_t));
				for ( i = 0; i < size; i ++ )
					v_init(v_getelemptr(var_p, i));
				}
			else
				exitf = 1;
			}
		} while ( !exitf && !prog_error );
}

//
//	ERASE var1 [, var2[, ...]]
//
void	cmd_erase()
{
	byte	code;
	var_t	*var_p;

	do	{
		if	( prog_error )
			break;

		code = code_peek();
		
		if ( code == kwTYPE_VAR )	{
			code_skipnext();
			var_p = tvar[code_getnext16()];
			}
		else	{
			err_typemismatch();
			break;
			}
		v_free(var_p);
		v_init(var_p);

		// next
		code = code_peek();
		if	( code == kwTYPE_SEP )	
			par_getcomma();	
		else
			break;

		} while ( 1 );
}

//
//	PRINT ...
//
void	cmd_print()
{
	byte	code, last_op = 0, exitf = 0;
	var_t	var;

	do	{
		code = code_peek();
		switch ( code )	{
		case	kwTYPE_LINE:
		case	kwTYPE_EOC:
			exitf = 1;
			break;
		case	kwTYPE_SEP:
			code_skipnext();
			last_op = code_getnext();
			if	( last_op == ',' )
				dev_print("\t");
			break;
		default:
			last_op = 0;
			v_init(&var);
			eval(&var);
			if	( !prog_error )
				print_var(&var);
			v_free(&var);
			};

		if	( prog_error )
			return;
		} while ( exitf == 0 );

	if	( last_op == 0 )
		dev_print("\n");
}

void	logprint_var(var_t *var)
{
	var_t	*vp;
	int		i;

	switch ( var->type )	{
	case	V_STR:
		lwrite(var->ptr);
		break;
	case	V_INT:
		lprintf("%d", var->i);
		break;
	case	V_NUM:
		lprintf("%f", var->n);
		break;
	case	V_ARRAY:	
		lprintf("\nArray of =%d elements\n", var->size+1);
		for ( i = 0; i < var->size; i ++ )	{
			vp = (var_t *) (var->ptr + (sizeof(var_t) * i));
			logprint_var(vp);
			}
		break;
		}
}

void	cmd_logprint()
{
	byte	code, last_op = 0, exitf = 0;
	var_t	var;

	do	{
		code = code_peek();
		switch ( code )	{
		case	kwTYPE_LINE:
		case	kwTYPE_EOC:
			exitf = 1;
			break;
		case	kwTYPE_SEP:
			code_skipnext();
			last_op = code_getnext();
			if	( last_op == ',' )
				lprintf("\t");
			break;
		default:
			last_op = 0;
			v_init(&var);
			eval(&var);
			if	( !prog_error )	
				logprint_var(&var);
			v_free(&var);
			};

		if	( prog_error )
			return;
		} while ( exitf == 0 );

	if	( last_op == 0 )
		lprintf("\n");
}

//
//	INPUT [str {,|;}] var [, var2 [, ...]]
//
void	cmd_input()
{
	byte		code, sep;
	var_t		arg;
	var_p_t		varlist[16];
	char_p_t	datalist[16];
	int			i, count, count_commas;
	char		*p, *ps, *np;
	char		prompt[256];
	char 		tmpsb[256];
	int			type;
	long		lv;
	double		dv;
	
	code = code_peek();
	strcpy(prompt, "");

	/* prompt */
	if	( code == kwTYPE_STR )	{
		v_init(&arg);
		eval(&arg);
		strcat(prompt, arg.ptr);
		v_free(&arg);

		code = code_getnext();
		if	( code == kwTYPE_SEP )	{
			sep = code_getnext();
			if	( sep == ';' )
				strcat(prompt, "? ");
			}
		else	{
			err_syntax();
			return;
			}

		}
	else // no prompt!
		strcat(prompt, "? ");

	/* count & check variables */
	count = 0;
	do	{
		code = code_peek();
		if	( code != kwTYPE_VAR )	{
			err_syntax();
			return;
			}
		code_skipnext();

		// check 	
		if	( count == 15 )	{
			rt_raise("INPUT: TOO MANY VARS");
			return;
			}

		// store variable's pointer
		varlist[count] = code_getvarptr();
		if	( prog_error )	return;
		if	( varlist[count]->const_flag )	{
			rt_raise("INPUT: CANNOT USE CONSTANT");
			return;
			}
		v_free(varlist[count]);
		count ++;

		// next
		code = code_peek();
		if	( code != kwTYPE_SEP )
			break;
		else	
			code_skipnext16();
		} while ( 1 );

	/* read the string */
	do	{
		dev_print(prompt);
		dev_gets(tmpsb, 255);
		if	( prog_error )	return;		// break or something can be happened
		
		// check user's input string
		if	( count > 1 )	{
			count_commas = 0;
			p = tmpsb;
			while ( *p )	{
				if	( *p == ',' )	{
					if ( count_commas == count )	{
						count_commas = -1;
						break;
						}

					// store ptr
					datalist[count_commas] = p;
					count_commas ++;
					}
				p ++;
				}
			}
		else
			count_commas = 0;	// only one variable is rq

		if	( count != (count_commas+1) )	// error number of input variables
			dev_print("* REDO FROM START *\n");

		} while ( count != (count_commas+1) );

	/* assign, variables */
	for ( i = 0; i < count; i ++ )	{
		// ps = string data start
		if	( i > 0 )	{
			ps = datalist[i-1];
			ps ++;
			}
		else
			ps = tmpsb;

		// close the string
		if	( i < count_commas )	{
			p = datalist[i];
			*p = '\0';
			}

		// 
		np = get_numexpr(ps, prompt, &type, &lv, &dv);

		if	( type == 1 && *np == '\0' )	{
			varlist[i]->type = V_INT;
			varlist[i]->i = lv;
			}
		else if	( type == 2  && *np == '\0' )	{
			varlist[i]->type = V_NUM;
			varlist[i]->n = dv;
			}
		else	
			v_createstr(varlist[i], ps);
		}
}

//
//	ON x GOTO|GOSUB ...
//
void	cmd_on_go()
{
	word	next_ip, expr_ip, table_ip, dest_ip;
	byte	command, count;
	var_t	var;
	word	index;
	stknode_t	node;

	next_ip = code_getnext16();
	code_skipnext16();
	command  = code_getnext();
	count    = code_getnext();
	table_ip = prog_ip;
	expr_ip  = prog_ip + (count << 1);

	v_init(&var);
	prog_ip = expr_ip;
	eval(&var);
	index = (v_igetval(&var) - 1);
	if	( index >= count )
		rt_raise("ON x %s: OUT OF RANGE", (command==kwGOTO)?"GOTO":"GOSUB");
	
	memcpy(&dest_ip, prog_source+table_ip+(index<<1), 2);
	switch ( command )	{
	case	kwGOTO:
		code_jump(dest_ip);
		break;
	case	kwGOSUB:
		node.type = kwGOSUB;
		node.x.vgosub.ret_ip = next_ip;
		code_jump(dest_ip);
		code_push(&node);
		break;
	default:
		rt_raise("ON x: INTERNAL ERROR");
		}
}

//
//	GOSUB label
//
void	cmd_gosub()
{
	stknode_t	node;
	word		goto_label;

	goto_label = code_getnext16();
	node.type = kwGOSUB;
	node.x.vgosub.ret_ip = prog_ip;
	code_jump_label(goto_label);
	code_push(&node);
}

//
//	CALL UDP/F address
//
//	Stack:
//	[p1]
//	...
//	[pN]
//	[vcall]
//
//	p1...pN will be removed by cmd_param()
//
void	cmd_udp(int cmd)
{
	stknode_t	ncall, param;
	word		goto_addr, pcount = 0, rvid;
	var_t		*var_p, *arg = NULL;
	byte		ready, code;
	word		ofs;

	goto_addr = code_getnext16();		// jump to
	rvid      = code_getnext16();		// return-variable ID

	if	( code_peek() == kwTYPE_LEVEL_BEGIN )	{
		code_skipnext();		// kwTYPE_LEVEL_BEGIN

		ready = 0;
		do	{
			code = code_peek();
			switch ( code )	{
			case	kwTYPE_EOC:
				code_skipnext();
				break;
			case	kwTYPE_SEP:			// separator 
				code_skipnext16();
				break;
			case	kwTYPE_LEVEL_END:	// ) -- end of parameters
				ready = 1;
				break;
			case	kwTYPE_VAR:		// variable
				ofs = prog_ip;		// store IP

				// check if its a whole array i.e. MAX(v())
				if	( code_isnullarray() )	{	
					code_skipnext();

					// push parameter
					param.type = kwTYPE_VAR;
					param.x.param.res = tvar[code_getnext16()];
					param.x.param.vcheck = 0x83;	// NULLARRAY - BYVAL|BYREF
					code_push(&param);
					pcount ++;
					break;
					}

				code_skipnext();
				var_p = code_getvarptr();
			
				// check if it has no more args (sep|rpar)
				code = code_peek();
				if	( code == kwTYPE_EOC )	{
					code_skipnext();
					code = code_peek();
					}

				if ( code == kwTYPE_SEP || code == kwTYPE_LEVEL_END )	{
					// push parameter
					param.type = kwTYPE_VAR;
					param.x.param.res = var_p;
					param.x.param.vcheck = 3;	// BYVAL|BYREF
					code_push(&param);
					pcount ++;
					break;
					}

				prog_ip = ofs;	// restore IP
				// no 'break' here
			default:
				// default --- expression (BYVAL ONLY)
				arg = (var_t *) tmp_alloc(sizeof(var_t));
				v_init(arg);

				eval(arg);
				if	( !prog_error )	{
					// push parameter
					param.type = kwTYPE_VAR;
					param.x.param.res = arg;	
					if	( arg->type == V_ARRAY )
						param.x.param.vcheck = 0x81;	// ARRAY - BYVAL ONLY
					else
						param.x.param.vcheck = 1;	// BYVAL ONLY
					code_push(&param);
					pcount ++;
					}
				else	{
					v_free(arg);
					return;
					}

				}

			} while ( !ready );