blib.c

smallbasic for linux

			prog_ip = node.x.vfor.step_expr_ip;
			eval(&var_step);
			}

		if	( !prog_error && (var_step.type == V_INT || var_step.type == V_NUM) )	{
			v_inc(var_p, &var_step);
			if	( v_sign(&var_step) < 0 )	
				check = (v_compare(var_p, &var_to) >= 0);
			else 
				check = (v_compare(var_p, &var_to) <= 0);
			} //
		else	{
			if	( !prog_error )
				err_syntax();
			}
		}
	else	{
		if	( !prog_error )
			err_syntax();
		}

	//
	//	RUN
	//
	if	( !prog_error )	{
		if	( check )	{
			code_push(&node);
			code_jump(jump_ip);	
			}
		else
			code_jump(next_ip);	
		}

	// clean up
	v_free(&var_to);
	v_free(&var_step);
}

//
//	READ var [, var [, ...]]
//
void	cmd_read()
{
	byte	code, exitf = 0;
	var_t	*vp = NULL;

	if	( data_ip == 0xFFFF )	{
		rt_raise("READ: USE RESTORE [label]");
		return;
		}

	do	{
		code = code_peek();
		switch ( code )	{
		case	kwTYPE_LINE:
		case	kwTYPE_EOC:
			exitf = 1;
			break;
		case	kwTYPE_SEP:
			code_skipnext16();	// get 2 bytes
			break;
		default:
			code_skipnext();
			vp = code_getvarptr();
			if	( prog_error )	return;

			//////
			if	( !prog_error )	{
				v_free(vp);

				if	( data_ip >= prog_length )	{
					rt_raise("READ: OUT OF RANGE(DATA)");
					return;
					}

				switch ( prog_source[data_ip] )	{
				case	kwTYPE_EOC:	// null data
					vp->type = V_INT;
					vp->i = 0;
					break;
				case	kwTYPE_INT:
					data_ip ++;

					vp->type = V_INT;
					memcpy(&vp->i, prog_source+data_ip, 4);
					data_ip += 4;
					break;
				case	kwTYPE_NUM:
					data_ip ++;

					vp->type = V_NUM;
					memcpy(&vp->n, &prog_source[data_ip], 8);
					data_ip += 8;
					break;
				case	kwTYPE_STR:
					{
					word	len;

					data_ip ++;

					vp->type = V_STR;
					memcpy(&len, prog_source+data_ip, 2);
					data_ip += 2;

					vp->ptr = tmp_alloc(len+1);
					memcpy(vp->ptr, prog_source+data_ip, len);
					*((char *) (vp->ptr+len)) = '\0';
					vp->size = len;
					data_ip += len;
					}
					break;
				default:
					rt_raise("READ: OUT OF RANGE(DATA) IDX=%d", data_ip);
					return;
					}

				if	( prog_source[data_ip] == kwTYPE_EOC )	
					data_ip ++;

				}
			};
		} while ( !exitf ); 
}

//
//	DATA ...
//
void	cmd_data()
{
	rt_raise("DATA: CANNOT EXECUTE DATA");
}

//
//	RESTORE label
//
void	cmd_restore()
{
	data_ip = code_getnext16();
}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////	SYSTEM
////////////

//
//	RANDOMIZE [num]
//
void	cmd_randomize()
{
	byte	code;
	long	seed;

	code = code_peek();
	switch ( code )	{
	case	kwTYPE_LINE:
	case	kwTYPE_EOC:
		#if defined(_PalmOS)
		SysRandom(TimGetTicks());
		#else
		srand(clock());
		#endif
		break;
	default:
		seed = par_getint();
		if ( !prog_error )	{
			#if defined(_PalmOS)
			SysRandom(seed);
			#else
			srand(seed);
			#endif
			}
		};
}

//
//	DELAY
//
void	cmd_delay()
{
	dword	ms;

	ms = par_getint();		if	( prog_error )	return;
	dev_delay(ms);
}

//
//	AT x,y
//
void	cmd_at()
{
	int		x, y;

	x = par_getint();		if	( prog_error )	return;
	    par_getcomma();		if	( prog_error )	return;
	y = par_getint();		if	( prog_error )	return;
	dev_setxy(x,y);
}

//
//	LOCATE y,x
//
void	cmd_locate()
{
	int		x, y;

	y = par_getint();		if	( prog_error )	return;
	    par_getcomma();		if	( prog_error )	return;
	x = par_getint();		if	( prog_error )	return;
	#if defined(_PalmOS)
	dev_setxy(x*8,y*11);
	#else
	dev_setxy(x*8,y*16);
	#endif
}

//
//	PAUSE [secs]
//
void	cmd_pause()
{
	int		x = 0, evc;
	byte	code;
	long	start, now, tps;

	code = code_peek();
	if	( code == kwTYPE_VAR ) {
		x = par_getint();	
		if	( prog_error )	return;
		}
	else if ( code == kwTYPE_INT )	{
		code_skipnext();
		x = code_getnext32();
		}
	else if ( code == kwTYPE_NUM )	{
		code_skipnext();
		x = code_getnext64f();
		}

	if	( x == 0 )	{
		while ( dev_kbhit() == 0 )	{
			switch ( dev_events(0) )	{
			case	0:	// no event
				break;
			case	-2:	// break
				brun_break();
			case	-1:	// break
				return;
				}
			}

		dev_getch();
		}
	else	{
		#if defined(_PalmOS)
		start = TimGetTicks();
		tps = SysTicksPerSecond();
		#else
		start = clock();
		tps = CLOCKS_PER_SEC;
		#endif
		while ( !dev_kbhit() )	{
			switch ( (evc = dev_events(0)) )	{
			case	0:	// no event
				break;
			case	-2:	// break
				brun_break();
			case	-1:	// break
				return;
				}
			if	( evc )	{
				if	( dev_kbhit() )
					dev_getch();
				break;
				}

			#if defined(_PalmOS)
			now = TimGetTicks();
			#else
			now = clock();
			#endif
			
			if	( now > start + tps * x )
				break;
			}

		dev_getch();
		}
}

//
//	COLOR fg[,text_bg]
//
void	cmd_color()
{
	int		fg, bg = -1;

	fg = par_getint();		if	( prog_error )	return;
	if	( code_peek() == kwTYPE_SEP )	{
	    par_getcomma();			if	( prog_error )	return;
		bg = par_getint();		if	( prog_error )	return;
		}

	dev_settextcolor(fg, bg);
}

//
//	SPLIT string, delimiters, array()
//
void	cmd_wsplit()
{
	int		quotes, len, count, lc = 0;
	char	*p, *ps, *new_text;
	var_t	str, del, *var_p, *elem_p;

	v_init(&str);
	v_init(&del);
	par_getstr(&str);	if	( prog_error )	return;
	par_getcomma();		if	( prog_error )	{ v_free(&str); return; }
	par_getstr(&del);	if	( prog_error )	{ v_free(&str); return; }
	par_getcomma();		if	( prog_error )	{ v_free(&str); v_free(&del); return; }
	if	( !code_isnullarray() )	{
		if	( code_peek() == kwTYPE_VAR )	{
			code_skipnext();
			var_p = tvar[code_getnext16()];
			v_free(var_p);

			var_p->type = V_ARRAY;
			var_p->ptr = tmp_alloc(sizeof(var_t));
			var_p->size = 1;
			var_p->lbound[0] = 0;
			var_p->ubound[0] = var_p->lbound[0] + 1;
			var_p->maxdim = 1;
			}
		else	{
			err_typemismatch();
			v_free(&str); v_free(&del); 
			return;
			}
		}
	else	{
		code_skipnext();
		var_p = tvar[code_getnext16()];
		}

	//
	//	reformat
	//
	p = (char *) str.ptr;
	new_text = tmp_alloc((len=(strlen(p)+4)));
	memset(new_text, 0, len);
	ps = new_text;
	quotes = 0;
	while ( *p )	{
		if	( !quotes )	{
			if ( *p == '\n' )	{
				*ps ++ = '\n';
				while ( *(p+1) == ' ' || *(p+1) == '\t' )
					p ++;
				}
			else if ( (*p == '\t' || *p == ' ') && lc != ' ' )
				*ps ++ = ' ';
			else if	( (*p > ' ') || (*p & 0x80) )	
				*ps ++ = *p;

			lc = *ps;
			}
		else
			*ps ++ = *p;

		if	( *p == '\"' )	
			quotes = !quotes;

		p ++;
		}
	*ps = '\0';	

	//
	//	scan
	//
	count = 0;
	ps = p = new_text;
	while ( *p )	{
		if	( strchr(del.ptr, *p) )	{
			*p = '\0';

			// add element (ps)
			if	( var_p->size <= count )		// resize array
				v_resize_array(var_p, count+8);

			elem_p = (var_t *) (var_p->ptr + (sizeof(var_t) * count));
			elem_p->type = V_STR;
			elem_p->ptr = tmp_alloc((len=(strlen(ps)+1)));
			strcpy(elem_p->ptr, ps);
			elem_p->size = len;

			count ++;

			// next word
			ps = p+1;
			}

		p ++;
		}

	if	( *ps )	{
		// add the last element (ps)
		if	( var_p->size <= count )		// resize array
			v_resize_array(var_p, count+8);

		elem_p = (var_t *) (var_p->ptr + (sizeof(var_t) * count));
		elem_p->type = V_STR;
		elem_p->ptr = tmp_alloc((len=(strlen(ps)+1)));
		strcpy(elem_p->ptr, ps);
		elem_p->size = len;

		count ++;
		}

	v_resize_array(var_p, count);	// final resize

	// cleanup
	v_free(&str);
	v_free(&del);
	tmp_free(new_text);
}

#ifdef BC_DEBUG
//////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////

void	cmd_bcdump()
{
	int		c, i, b, h, l, j;
	int		len, new_ip;
	int		a = 10; // Default dump size
	char	buf[10];

	b = code_getnext();
	while ( b == kwTYPE_EOC )	b = code_getnext();

	if ( b == kwTYPE_INT ) {
		a = code_getnext32();
	   	b = code_getnext();
		while ( b == kwTYPE_EOC )	b = code_getnext();
		}

	if ( b != kwTYPE_LINE) {
		dev_printf("** BCDUMP [n] **\n");
		return;
		}
	else
		dev_printf("== BCDUMP-LINE: %d\n", code_getnext16());

	for ( i = 0; i < a; i ++ ) {
		b = code_getnext();
		h = b >> 4;
		l = b & 0xF;

		dev_printf("%04d: %c%c %c ",
			prog_ip-1,
			"0123456789ABCDEF"[h],
			"0123456789ABCDEF"[l],
			(b>=32) ? b : 42 );

		switch ( b )	{
		case	kwTYPE_LINE:
			dev_printf("--LINE: %d", code_getnext16());
			break;
		case	kwTYPE_EOC:
			dev_printf("--EOC");
			break;
		default:
			for ( c = 0; keyword_table[c].name[0] != '\0'; c ++)	{
				if ( b == keyword_table[c].code )	{
					dev_printf("%s ", keyword_table[c].name);
					break;
					}
				}

			switch ( b )	{
			case	kwTYPE_LEVEL_BEGIN:
			case	kwTYPE_LEVEL_END:
				break;
			case	kwTYPE_SEP:
			case	kwTYPE_LOGOPR:
			case	kwTYPE_CMPOPR:
			case	kwTYPE_ADDOPR:
			case	kwTYPE_MULOPR:
			case	kwTYPE_POWOPR:
			case	kwTYPE_UNROPR:
				dev_printf(" SYM '%c'", code_getnext());
				break;
			case	kwFILEINPUT:
				dev_printf("FILE INPUT");
				break;
			case	kwFILEPRINT:
				dev_printf("FILE PRINT");
				break;
			case	kwONJMP:
				new_ip = code_getnext16();
				code_skipnext16();
				b = code_getnext();
				c = code_getnext();
				dev_printf("ON %s CNT %d\n", ((b == kwGOTO)?"GOTO":"GOSUB"), c);
				dev_printf("      NEXT IP %d\n", new_ip);
				for ( j = 0; j < c; j ++ )	
					dev_printf("       JMP IP %d\n", code_getnext16());
				dev_printf("ON %s EXPR:", ((b == kwGOTO)?"GOTO":"GOSUB"));
				break;
			case	kwGOTO:
				new_ip = code_getnext16();
				dev_printf("= JMP %d ", new_ip);
				c = code_getnext();
				dev_printf(" POPs %d", c);
				break;
			case	kwGOSUB:
				c = code_getnext16();
				dev_printf("ID %d ", c);
				new_ip = tlab[c].ip;
				dev_printf("= JMP %d ", new_ip);
				dev_printf("\n(J)ump, (C)ontinue?");
				do	{
					dev_gets(buf, 8);
					if	( buf[0] == 'j' )	{
						prog_ip = new_ip;
						break;
						}
					else if	( buf[0] == 'c' )
						break;
					} while ( 1 );

				break;
			case	kwPROC:
				dev_printf("=== PROCEDURE ===");
				break;
			case	kwFUNC:
				dev_printf("=== FUNCTION ===");
				break;
			case	kwTYPE_PARAM:
			case	kwTYPE_CRVAR:
				c = code_getnext();
				if	( b == kwTYPE_PARAM )
					dev_printf("PARAM = %d: ", c);
				else
					dev_printf("CRVAR = %d: ", c);
				
				for ( j = 0; j < c; j ++ )	{
					if	( b == kwTYPE_PARAM )	{
						if	( code_getnext() & 0x80 )
							dev_printf("&");
						}
					dev_printf("%d ", code_getnext16());
					}
				break;
			case	kwTYPE_RET:
				dev_printf("=== UDP/F RET ===");
				break;
			case	kwTYPE_CALL_UDP:
				dev_printf("CALL UDP %d", code_getnext16());
				code_skipnext16();
				break;
			case	kwTYPE_CALL_UDF:
				dev_printf("CALL UDF %d,", code_getnext16());
				dev_printf(" RVID: %d", code_getnext16());
				break;
			case	kwRESTORE:
			case	kwTYPE_LINE:
			case	kwLABEL:
			case	kwTYPE_VAR:
			case	kwLET:
				dev_printf("ID %d ", code_getnext16());
				break;
			case	kwTYPE_INT:
				dev_printf("VAL %d ", code_getnext32());
				break;
			case	kwTYPE_NUM:
				dev_printf("VAL %f ", code_getnext64f());
				break;
			case	kwTYPE_STR:
				len = code_getnext16();
				dev_printf("\"");
				for ( j = 0; j < len; j ++ )
					dev_printf("%c", prog_source[prog_ip+j]);
				dev_printf("\"");
				prog_ip += len;	// +1?
				break;
			case	kwIF:		case	kwFOR: 		case	kwWHILE:	case	kwREPEAT:
			case	kwELSE:		case	kwELIF:
			case	kwENDIF:	case	kwNEXT:		case	kwWEND:		case	kwUNTIL:
				dev_printf("IP1 %d IP2 %d ", code_getnext16(), code_getnext16());
				break;
				}
			}
		dev_printf("\n");
		if ( b == kwSTOP ) break;
	}
}
#endif