blib.c

smallbasic for linux

		///
		code_skipnext();		// kwTYPE_LEVEL_END
		}

	///
	ncall.type = cmd;
	ncall.x.vcall.pcount = pcount;
	ncall.x.vcall.ret_ip = prog_ip;
	ncall.x.vcall.rvid   = rvid;
	if	( rvid != 0xFFFF )	{
		ncall.x.vcall.retvar = tvar[rvid];	// store previous data of RVID
		tvar[rvid] = v_new();
		}

	code_push(&ncall);
	prog_ip = goto_addr;
}

//
//	RETURN FROM UDP/F
//
void	cmd_udpret()
{
	stknode_t	node, rval;
	
	code_pop(&node);
	while ( (node.type != kwPROC) && (node.type != kwFUNC) )	{ 

		if	( node.type == kwTYPE_CRVAR )	{ 				// local variable - cleanup
			v_free(tvar[node.x.vdvar.vid]);					// free local variable data
			tmp_free(tvar[node.x.vdvar.vid]);
			tvar[node.x.vdvar.vid] = node.x.vdvar.vptr;		// restore ptr
			}
		else if	( node.type == kwBYREF )	{ 			// variable reference
			tvar[node.x.vdvar.vid] = node.x.vdvar.vptr;		// restore ptr
			}

		// next
		code_pop(&node); 
		if ( prog_error )
			return; 
		}

	if ( (node.type != kwPROC) && (node.type != kwFUNC) )	{
		err_syntax();
		dump_stack();
		}
	else	{
		// restore return value
		if	( node.x.vcall.rvid != 0xFFFF )	{

			// store value to stack
			rval.type = kwTYPE_RET;
			rval.x.vdvar.vptr = tvar[node.x.vcall.rvid];
			code_push(&rval);

			tvar[node.x.vcall.rvid] = node.x.vcall.retvar;	// restore ptr
			}
		}

	prog_ip = node.x.vcall.ret_ip;
}

//
//	CREATE DYNAMIC VARIABLES
//
void	cmd_crvar()
{
	int			i, count;
	word		vid;
	stknode_t	node;

	count = code_getnext();
	for ( i = 0; i < count; i ++ )	{
		vid   = code_getnext16();

		// store previous variable-ptr to stack
		node.type = kwTYPE_CRVAR;
		node.x.vdvar.vid = vid;
		node.x.vdvar.vptr = tvar[vid];
		code_push(&node);
		
		// create a new one with the same ID
		tvar[vid] = (var_t *) tmp_alloc(sizeof(var_t));
		v_init(tvar[vid]);
		}
}

//
//	UDP/F PARAMETERS
//
void	cmd_param()
{
	int		i, pcount;
	int		vid;
	byte	vattr;
	stknode_t	ncall, *param, node;

	code_pop(&ncall);
	if ( (ncall.type != kwPROC) && (ncall.type != kwFUNC) )	{ 
		err_stackmess();
		return;
		}
	pcount = code_getnext();

	if	( pcount != ncall.x.vcall.pcount )	{
		err_parm_num();
		return;
		}

	if	( pcount )	{
		// get parameters
		param = (stknode_t *) tmp_alloc(sizeof(stknode_t) * pcount);
		for ( i = pcount-1; i > -1; i -- )	
			code_pop(&param[i]);

		// push call's pars (again)
		code_push(&ncall);

		//
		for ( i = 0; i < pcount; i ++ )	{
			vattr = code_getnext();
			vid   = code_getnext16();

			if	( (vattr & 0x80) == 0 )	{		// BY VALUE
				// store previous variable to stack
				node.type = kwTYPE_CRVAR;
				node.x.vdvar.vid = vid;
				node.x.vdvar.vptr = tvar[vid];
				code_push(&node);

				// assign
				if	( param[i].x.param.vcheck == 1 )	{	
					if	( vattr & 1 )	{
						code_pop(&node);
						rt_raise("PARAM %d IS AN ARRAY", i+1);
						}
					else
						tvar[vid] = param[i].x.param.res;
					}
				else if ( param[i].x.param.vcheck == 0x81 )	{
					if	( (vattr & 1) == 0 )	{
						code_pop(&node);
						rt_raise("PARAM %d IS NOT AN ARRAY", i+1);
						}
					else
						tvar[vid] = param[i].x.param.res;
					}

				else if ( param[i].x.param.vcheck & 0x80 )	{
					if	( (vattr & 1) == 0 )	{
						code_pop(&node);
						rt_raise("PARAM %d IS NOT AN ARRAY", i+1);
						}
					else
						tvar[vid] = v_clone(param[i].x.param.res);
					}
				else	{
					if	( vattr & 1 )	{
						code_pop(&node);
						rt_raise("PARAM %d IS AN ARRAY", i+1);
						}
					else
						tvar[vid] = v_clone(param[i].x.param.res);
					}
				}
			else	{					// BY REFERENCE
				if	( (param[i].x.param.vcheck == 1) || (param[i].x.param.vcheck == 0x81) )	{
					err_parm_byref(i);
					break;
					}
				else	{
					// store previous variable to stack
					node.type = kwBYREF;
					node.x.vdvar.vid = vid;
					node.x.vdvar.vptr = tvar[vid];
					code_push(&node);

					if ( param[i].x.param.vcheck & 0x80 )	{
						if	( (vattr & 1) == 0 )	{
							code_pop(&node);
							rt_raise("PARAM %d IS NOT AN ARRAY", i+1);
							}
						else
							tvar[vid] = param[i].x.param.res;
						}
					else	{
						if	( vattr & 1 )	{
							code_pop(&node);
							rt_raise("PARAM %d IS AN ARRAY", i+1);
							}
						else
							tvar[vid] = param[i].x.param.res;
						}

					}
				}
			}

		tmp_free(param);
		}
	else	{
		// push call's pars (again)
		code_push(&ncall);
		}
}

//
//	EXIT [FOR|LOOP|FUNC|PROC]
//
void	cmd_exit()
{
	stknode_t	node;
	int			ready = 0;
	word		addr = 0xFFFF;
	byte		code;

	code = code_peek();
	if	( !(code == kwLOOP || code == kwFOR || 
		    code == kwPROC || code == kwFUNC) )
		code = 0;
	else
		code_skipnext();

	do	{
		code_pop(&node);
		if	( prog_error )
			return;
		
		switch ( node.type )	{
		case	kwIF:
			break;
		case	kwGOSUB:
			if	( code == 0 )	{
				addr = node.x.vgosub.ret_ip;
				ready = 1;
				}
			break;
		case	kwFOR:
			if	( code == 0 || code == kwFOR )	{
				addr = node.exit_ip;
				ready = 1;
				}
			break;
		case	kwWHILE:
			if	( code == 0 || code == kwLOOP )	{
				addr = node.exit_ip;
				ready = 1;
				}
			break;
		case	kwREPEAT:
			if	( code == 0 || code == kwLOOP )	{
				// address of UNTIL
				prog_ip = node.exit_ip+1;
				addr = code_getnext16();
				ready = 1;
				}
			break;
		case	kwPROC:
		case	kwFUNC:
		case	kwTYPE_CRVAR:
		case	kwBYREF:
		case	kwTYPE_PARAM:
			if	( code == 0 || code == kwPROC || code == kwFUNC )	{
				code_push(&node);
				cmd_udpret();
				addr = 0xFFFF;
				ready = 1;
				}
			else	{
				if	( code == kwFOR )
					rt_raise("EXIT FOR: NO 'FOR' INSIDE SUB/FUNC");
				else
					rt_raise("EXIT LOOP: NO 'LOOP' INSIDE SUB/FUNC");
				}
			break;
			};
		} while ( ready == 0 );

	if	( addr != 0xFFFF )
		code_jump(addr);
}

//
//	RETURN
//
void	cmd_return()
{
	stknode_t	node;
	
	// get return-address and remove any other item (sub items) from stack
	code_pop(&node);

	// 'GOTO' SHIT
	while ( node.type != kwGOSUB )	{ code_pop(&node); if ( prog_error ) return; }

	if ( node.type != kwGOSUB )	{
		err_syntax();
		dump_stack();
		}

	code_jump(node.x.vgosub.ret_ip);
}

//
//	IF expr [THEN]
//
void	cmd_if()
{
	word	true_ip, false_ip;
	var_t	var;
	stknode_t	node;

	true_ip = code_getnext16();
	false_ip = code_getnext16();

	// expression
	v_init(&var);
	eval(&var);
	node.type = kwIF;
	node.x.vif.lcond = v_is_nonzero(&var);
	code_jump( (node.x.vif.lcond) ? true_ip : false_ip);
	v_free(&var);

	code_push(&node);
}

//
//	ELSE
//
void	cmd_else()
{
	word	true_ip, false_ip;
	stknode_t	node;

	true_ip = code_getnext16();
	false_ip = code_getnext16();

	code_pop(&node);

	// 'GOTO' SHIT
	while ( node.type != kwIF )	{ code_pop(&node); if ( prog_error ) return; }

	if	( node.type != kwIF )	{
		err_syntax();
		dump_stack();
		return;
		}
	code_push(&node);
			
	code_jump((!node.x.vif.lcond) ? true_ip : false_ip);
}

//
//	ELIF
//
void	cmd_elif()
{
	word		true_ip, false_ip;
	var_t		var;
	stknode_t	node;

	true_ip = code_getnext16();
	false_ip = code_getnext16();

	// else cond
	code_pop(&node);

	// 'GOTO' SHIT
	while ( node.type != kwIF )	{ code_pop(&node); if ( prog_error ) return; }

	if	( node.type != kwIF )	{
		err_syntax();
		dump_stack();
		return;
		}

	if	( !node.x.vif.lcond )			{
		// previous IF failed

		// expression
		v_init(&var);
		eval(&var);
		node.x.vif.lcond = v_is_nonzero(&var);
		code_jump( (node.x.vif.lcond) ? true_ip : false_ip);
		v_free(&var);

		code_push(&node);
		}
	else	{
		// previous IF succeded
		code_push(&node);
		code_jump(false_ip);
		}
}

//
//	FOR var = expr TO expr [STEP expr]
//
void	cmd_for()
{
	byte	code;
	word	true_ip, false_ip;
	stknode_t	node;
	var_t	var, varstep, *var_p;

	true_ip = code_getnext16();
	false_ip = code_getnext16();

	code = code_peek();
	if	( code != kwTYPE_VAR )	{
		err_syntax();
		return;
		}
	node.type = kwFOR;
	node.exit_ip = false_ip + 5;
	node.x.vfor.jump_ip = true_ip;

	//
	//	get FOR-variable
	//
	code_skipnext();
	var_p = code_getvarptr();
	if	( prog_error )	return;
	node.x.vfor.var_ptr = var_p;
	v_free(var_p);

	v_init(&var);
	v_init(&varstep);

	// get the first expression
	eval(&var);
	if	( !prog_error && (var.type == V_NUM || var.type == V_INT) )	{
		//
		//	assign FOR-variable
		//
		v_set(var_p, &var);

		code = code_getnext();
		if	( code == kwTO )	{
			//
			//	get TO-expression
			//
			node.x.vfor.to_expr_ip = prog_ip;
			v_init(&var);
			eval(&var);	

			if	( !prog_error && (var.type == V_NUM || var.type == V_INT) )	{
				//
				//	step
				//
				code = code_peek();
				if	( code == kwSTEP )	{
					code_skipnext();
					node.x.vfor.step_expr_ip = prog_ip;
					eval(&varstep);	
					if	( !(varstep.type == V_NUM || varstep.type == V_INT) )	{
						if	( !prog_error )
							err_syntax();	
						}
					}
				else	{
					node.x.vfor.step_expr_ip = 0xFFFF;
					varstep.type = V_INT;
					varstep.i = 1;
					} // STEP kw
				}  
			else {	// str for TO
				if	( !prog_error )
					err_syntax();	
				}
			}
		else	// TO keyword
			err_syntax();
		}

	//
	//	run
	//	
	if	( !prog_error )	{
		if	( v_sign(&varstep) < 0 )	{
			code_jump( (v_compare(var_p, &var) >= 0) ? true_ip : false_ip);
			}
		else {
			if	( v_compare(var_p, &var) <= 0 )	
				code_jump(true_ip);
			else	
				code_jump(false_ip);
			}

		code_push(&node);
		}

	// clean up
	v_free(&var);
	v_free(&varstep);
}

//
//	WHILE expr
//
void	cmd_while()
{
	word	true_ip, false_ip;
	var_t	var;
	stknode_t	node;

	true_ip = code_getnext16();
	false_ip = code_getnext16();

	// expression
	v_init(&var);
	eval(&var);
	if	( v_sign(&var) )
		code_jump(true_ip);
	else
		code_jump(false_ip+5);
	v_free(&var);

	node.type = kwWHILE;
	node.exit_ip = false_ip+5;
	code_push(&node);	// GOTO's SHIT
}

//
//	WEND
//
void	cmd_wend()
{
	stknode_t	node;
	word	/* next_ip, */ jump_ip;

	/* next_ip = */ code_skipnext16();
	jump_ip = code_getnext16();
	code_jump(jump_ip);
	code_pop(&node);			// GOTO's SHIT
}

//
//	UNTIL expr
//
void	cmd_until()
{
	word	/* next_ip, */ jump_ip;
	var_t	var;
	stknode_t	node;

	/* next_ip = */ code_skipnext16();
	jump_ip = code_getnext16();

	// expression
	v_init(&var);
	eval(&var);
	if	( !v_sign(&var) )
		code_jump(jump_ip);
	v_free(&var);
	code_pop(&node);			// GOTO's SHIT
}

//
//	NEXT
//
void	cmd_next()
{
	word	next_ip, jump_ip;
	var_t	var_to, var_step, *var_p;
	int		check = 0;
	stknode_t	node;

	next_ip = code_getnext16();
	jump_ip = code_getnext16();

	code_pop(&node);

	// 'GOTO' SHIT
	while ( node.type != kwFOR )	{ code_pop(&node); if ( prog_error ) return; }

	if	( node.type != kwFOR )	{
		err_syntax();
		dump_stack();
		return;
		}
	jump_ip = node.x.vfor.jump_ip;

	//
	var_p = node.x.vfor.var_ptr;

	v_init(&var_to);
	v_init(&var_step);

	// get last val
	prog_ip = node.x.vfor.to_expr_ip;
	eval(&var_to);
	if	( !prog_error && (var_to.type == V_INT || var_to.type == V_NUM) )	{
		// get step val
		if	( node.x.vfor.step_expr_ip == 0xFFFF )	{
			var_step.type = V_INT;
			var_step.i = 1;
			}
		else	{