scan.c

smallbasic for linux

	if	( idx == -1 )	{
		// search global name-space
		bc_prepname(name, var_name, 32);
		for ( i = 0; i < var_count; i ++ )	{
			if	( strcmp(var_table[i].name, name) == 0 )	{
				idx = i;
				break;
				}
			}
		}

	if	( idx == -1 )	{
		// create one
		if ( var_count >= var_size ) {
			var_size += GROWSIZE;
			var_table = tmp_realloc(var_table, var_size * sizeof(var_t));
			}

		if	( !is_alpha(var_name[0]) )
			sc_raise("WRONG VAR NAME: %s", var_name);
		else	{
			var_table[var_count].name = tmp_alloc(strlen(name)+1);
			strcpy(var_table[var_count].name, name);
			idx = var_count;
			var_count ++;
			}
		}

	return idx;
}

/*
*	adds a mark in stack at the current code position
*/
void	bc_push1(word ip) SEC(BCSCAN);
void	bc_push1(word ip)
{
/*
	if ( stk_count >= stk_size ) {
		stk_size += GROWSIZE;
		bc_stack = tmp_realloc(bc_stack, stk_size * sizeof(pass_node_t));
		}

	bc_stack[stk_count].pos      = ip;
	bc_stack[stk_count].level    = block_level;
	bc_stack[stk_count].block_id = block_id;
	bc_stack[stk_count].line     = scan_line;
	bc_stack[stk_count].sec      = tmp_alloc(strlen(bc_sec)+1);
	strcpy(bc_stack[stk_count].sec, bc_sec);
	stk_count ++;
*/
	pass_node_t		node;

	strcpy(node.sec, bc_sec);
	node.pos      = ip;
	node.level    = block_level;
	node.block_id = block_id;
	node.line     = scan_line;
	dbt_write(bc_stack, stk_count, &node, sizeof(pass_node_t));

	stk_count ++;
}

/*
*	adds a mark in stack at the current code position
*/
void	bc_push(void) SEC(BCSCAN);
void	bc_push()
{
	bc_push1(bc_prog.count);
}

/*
*	returns the keyword code 
*/
int		bc_is_keyword(char *name)
{
	int		i, idx;
	byte	dolar_bug = 0;

//	Code to enable the $ but not for keywords (INKEY$=INKEY, PRINT$=PRINT !!!)
//	I don't want to increase the size of keywords table.
	idx = strlen(name) - 1;
	if	( name[idx] == '$' )	{
		name[idx] = '\0';
		dolar_bug ++;
		}

	for ( i = 0; keyword_table[i].name[0] != '\0'; i ++ )	{
		if	( strcmp(keyword_table[i].name, name) == 0 )
			return keyword_table[i].code;
		}

	if	( dolar_bug )
		name[idx] = '$';

	return -1;
}

/*
*	get keyword name
*/
char	*bc_getkeywordstr(char *text, char *dest) SEC(BCSCAN);
char	*bc_getkeywordstr(char *text, char *dest)
{
	char	*p = (char *) text;
	char	*d = dest;

	if	( p == NULL )	{
		*dest = '\0';
		return 0;
		}

	while ( is_space(*p) )	p ++;

	if	( *p == '?' )	{
		strcpy(dest, "PRINT");
		p ++;
		while ( is_space(*p) )	p ++;
		return p;
		}

	if	( *p == '\'' || *p == '#' )	{
		strcpy(dest, "REM");
		p ++;
		while ( is_space(*p) )	p ++;
		return p;
		}

	while ( is_alnum(*p) )	{
		*d = *p;
		d ++; p ++;
		}

//	Code to kill the $
//	if	( *p == '$' )	
//		p ++;

//	Code to enable the $
	if	( *p == '$' )
		*d ++ = *p ++;

	*d = '\0';
	while ( is_space(*p) )	p ++;
	return p;
}

/*
*	expression (parameters)
*/
void	bc_scan_expr(char *expr, byte no_parser) SEC(BCSCAN);
void	bc_scan_expr(char *expr, byte no_parser)
{
	char	*ptr = (char *) expr;
	int		idx, level = 0, check_udf = 0;
	int		tp;
	word	w, stip, cip;
	long	lv = 0;
	double	dv = 0;
	bc_t	bc;

	str_alltrim(expr);

	if	( *ptr == '\0' )	
		return;

	bc_create(&bc);

	while ( *ptr )	{

		if	( is_digit(*ptr) || *ptr == '.' || (*ptr == '&' && strchr("XHOB", *(ptr+1) ) ) )	{
			//	number - constant
			ptr = get_numexpr(ptr, bc_name, &tp, &lv, &dv);
			switch ( tp )	{
			case	1:
				bc_add2l(&bc, kwTYPE_INT, lv);
				continue;
			case	2:
				bc_add2d(&bc, kwTYPE_NUM, dv);
				continue;
			default:
				sc_raise("NUMERIC EXPR: SYNTAX ERROR");
				}
			}
		else if ( *ptr == '\'' /* || *ptr == '#' */ )  	// remarks
			break;		// WHILE
		else if	( is_alpha(*ptr) || *ptr == '?' )	{
			// keyword
			ptr = bc_getkeywordstr(ptr, bc_name);
			idx = bc_is_keyword(bc_name);
			if	( idx != -1 )	{
				switch ( idx )	{
				case	kwFOR:		// this FOR is separator
					bc_add1(&bc, kwFORSEP);
					break;
				case	kwINPUT:	// this INPUT is separator
					bc_add1(&bc, kwINPUTSEP);
					break;
				// invalid keywords
				case kwLABEL: case kwGOTO:	case kwGOSUB:	case kwRETURN:
				case kwIF:	  case kwWHILE:	case kwREPEAT:
				case kwELSE:  case kwELIF:  case kwENDIF:	case kwNEXT:	case kwWEND:
				case kwUNTIL: case kwPRINT: case kwLOCATE:
				case kwAT:	  case kwRECT:	case kwLINE:	case kwCLS:
				case kwCIRCLE: case kwLET:	case kwCONST:	case kwRANDOMIZE:
				case kwPSET:  case kwBEEP:	case kwSOUND:	case kwCHAIN:	case kwREAD: case kwDATA: case kwRESTORE:
				case kwDIM:	case kwARC:		case kwDRAW:	case kwPLAY:	case kwOPEN:
					sc_raise("%s: MUST BE FIRST STATEMENT ON THE LINE", bc_name);
					break;
				// null keywords
				case kwTHEN:
					if	( level )
						sc_raise("MISSING ')'");
					break;
				// valid keywords
				default:
					if	( idx == kwLBOUND || idx == kwUBOUND )	{	// LBOUND & UBOUND IS A SPECIAL CASE
						bc_add1(&bc, idx);

						while ( *ptr == ' ' ) ptr ++;
						if	( *ptr != '(' )
							sc_raise("U|LBOUND: MISSING '('");
						else	{
							level ++;
							bc_add1(&bc, kwTYPE_LEVEL_BEGIN);

							ptr ++;
							ptr = bc_getkeywordstr(ptr, bc_name);
	
							w = bc_get_var_id(bc_name);
							bc_add2i(&bc, kwTYPE_VAR, w);
							}
						}
					else	{
						bc_add1(&bc, idx);
						}
					}
				}
			else {	// idx == -1
				// keyword/operators or variable
				if	( strcmp(bc_name, "AND") == 0 )	{
					bc_add2(&bc, kwTYPE_LOGOPR, '&');
					}
				else if	( strcmp(bc_name, "OR") == 0 )	{ 
					bc_add2(&bc, kwTYPE_LOGOPR, '|');
					}
				else if	( strcmp(bc_name, "XOR") == 0 )	{ 
					bc_add2(&bc, kwTYPE_LOGOPR, '~');
					}
				else if	( strcmp(bc_name, "NOT") == 0 )	{ 
					bc_add2(&bc, kwTYPE_UNROPR, '!');
					}
				else if	( strcmp(bc_name, "MOD") == 0 )	{ 
					bc_add2(&bc, kwTYPE_MULOPR, '%');
					}
				else	{
					int		udf;

					udf = bc_get_proc_id(bc_name);
					if	( udf != -1 )	{
						// UDF

						bc_add2i(&bc, kwTYPE_CALL_UDF, udf);
						bc_add1i(&bc, 0);
						check_udf ++;
						}
					else	{
						// VARIABLE
						
						while ( *ptr == ' ' ) ptr ++;
						if	( *ptr == '(' )	{
							if	( *(ptr+1) == ')' )	{
								// null array
								ptr += 2;
								}
							}

						w = bc_get_var_id(bc_name);
						bc_add2i(&bc, kwTYPE_VAR, w);
						}
					}
				}
			}
		else if ( *ptr == ',' || *ptr == ';' || *ptr == '#' )	{
			// parameter separator
			bc_add2(&bc, kwTYPE_SEP, *ptr);

			ptr ++;
			}
		else if ( *ptr == '\"' )	{
			// string
			ptr = bc_store_string(&bc, ptr);
			}
		else if ( *ptr == '(' )	{
			// parenthesis
			level ++;
			bc_add1(&bc, kwTYPE_LEVEL_BEGIN);

			ptr ++;
			}
		else if ( *ptr == ')' )	{
			// parenthesis
			bc_add1(&bc, kwTYPE_LEVEL_END);

			level --;
			ptr ++;
			}
		else if ( is_space(*ptr) )	
			// null characters
			ptr ++;
		else	{
			// operators
			if	( *ptr == '+' || *ptr == '-' )	{
				bc_add2(&bc, kwTYPE_ADDOPR, *ptr);
				}
			else if	( *ptr == '*' || *ptr == '/' || *ptr == '\\' || *ptr == '%' )	{
				bc_add2(&bc, kwTYPE_MULOPR, *ptr);
				}
			else if	( *ptr == '^' )	{
				bc_add2(&bc, kwTYPE_POWOPR, *ptr);
				}
			else if	( strncmp(ptr, "<=", 2) == 0 || strncmp(ptr, "=<", 2) == 0 )	{
				bc_add2(&bc, kwTYPE_CMPOPR, OPLOG_LE);

				ptr ++;
				}
			else if	( strncmp(ptr, ">=", 2) == 0 || strncmp(ptr, "=>", 2) == 0 )	{
				bc_add2(&bc, kwTYPE_CMPOPR, OPLOG_GE);

				ptr ++;
				}
			else if	( strncmp(ptr, "<>", 2) == 0 || strncmp(ptr, "!=", 2) == 0 )	{
				bc_add2(&bc, kwTYPE_CMPOPR, OPLOG_NE);

				ptr ++;
				}
			else if	( *ptr == '=' || *ptr == '>' || *ptr == '<' )	{
				bc_add2(&bc, kwTYPE_CMPOPR, *ptr);
				}
			else if	( *ptr == '&' || *ptr == '|' || *ptr == '~' )	{
				bc_add2(&bc, kwTYPE_LOGOPR, *ptr);
				}
			else if	( *ptr == '!' )	{
				bc_add2(&bc, kwTYPE_UNROPR, *ptr);
				}
			else
				sc_raise("UNKNOWN OPERATOR: '%c'", *ptr);

			ptr ++;
			}
		};

	if	( level )
		sc_raise("MISSING ')'");

	if	( !scan_error )	{
		if	( no_parser == 0 )	{
			// optimization
			bc_add1(&bc, kwTYPE_EOC);
			expr_parser(&bc);
			}

		if	( bc.count )	{
			stip = bc_prog.count;
			bc_append(&bc_prog, &bc);

			if	( check_udf )	{
				cip = stip;
				while ( (cip = bc_search(cip, kwTYPE_CALL_UDF)) != 0xFFFF )	{
					bc_push1(cip);
					cip += 5;
					}
				}
			}
		bc_eoc(&bc_prog);
		}

	// clean-up
	bc_destroy(&bc);
}

/*
*	Converts DATA commands to bytecode
*/
void	bc_scan_data(char *source) SEC(BCSCAN);
void	bc_scan_data(char *source)
{
	char	*ptr = source;
	char	*commap;
	long	lv = 0;
	double	dv = 0, sign = 1;
	char	*tmp = bc_temp;
	int		quotes;
	int		tp;

	while ( *ptr )	{
		while ( *ptr == ' ' )	ptr ++;

		if	( *ptr == '\0' )	
			break;
		else if	( *ptr == ',' )	{
			bc_add1(&bc_data, kwTYPE_EOC);
			ptr ++;
			}
		else	{
			// find the end of the element
			commap = ptr;
			quotes = 0;
			while ( *commap )	{
				if	( *commap == '\"' )
					quotes = !quotes;
				else if ( (*commap == ',') && (quotes == 0) )
					break;

				commap ++;
				}
			if	( *commap == '\0' )
				commap = NULL;

			if	( commap != NULL )
				*commap = '\0';

			if  ((*ptr == '-' || *ptr == '+') && strchr("0123356789.", *(ptr+1)))	{ 
				if	( *ptr == '-' )
					sign = -1;
				ptr ++;
				}
			else
				sign = 1;

			if	( is_digit(*ptr) || *ptr == '.' 
					|| (*ptr == '&' && strchr("XHOB", *(ptr+1))) )	{

				//	number - constant
				ptr = get_numexpr(ptr, tmp, &tp, &lv, &dv);
				switch ( tp )	{
				case	1:
					bc_add2l(&bc_data, kwTYPE_INT, lv * sign);
					break;
				case	2:
					bc_add2d(&bc_data, kwTYPE_NUM, dv * sign);
					break;
				default:
					sc_raise("NUMERIC EXPR: SYNTAX ERROR");
					}
				}
			else	{
				// add it as string
				if	( *ptr != '\"' )	{
					strcpy(tmp, "\"");
					strcat(tmp,  ptr);
					strcat(tmp, "\"");
					bc_store_string(&bc_data, tmp);
					if	( commap )
						ptr = commap;
					else
						ptr = ptr + strlen(ptr);
					}
				else
					ptr = bc_store_string(&bc_data, ptr);
				}

			if	( commap != NULL )	
				*commap = ',';
			}
		}

	bc_add1(&bc_data, kwTYPE_EOC);	// no bc_eoc
}

/*
*	Scans the 'source' for "names" separated by 'delims' and returns the elements (pointer in source)
*	into args array.
*
*	Returns the number of items
*/
int		bc_getlist(char *source, char_p_t *args, char *delims, int maxarg) SEC(BCSCAN);
int		bc_getlist(char *source, char_p_t *args, char *delims, int maxarg)
{
	char	*p, *ps;
	int		count = 0;

	ps = p = source;
	while ( *p )	{
		if	( strchr(delims, *p) ) {
			*p = '\0';
			args[count] = ps;
			count ++;
			if	( count == maxarg )
				return count;
			ps = p+1;
			}

		p ++;
		}

	if	( *ps )	{
		*p = '\0';
		args[count] = ps;
		count ++;
		}

	return count;
}

/*
*/
char*	bc_next_char(char *source)	SEC(BCSCAN);
char*	bc_next_char(char *source)
{
	char	*p = source;

	while ( *p )	{
		if	( *p != ' ' )
			return p;
		p ++;
		}
	return p;
}

/*
*/
int		bc_getlist_insep(char *source, char_p_t *args, char *sep, char *delims, int maxarg) SEC(BCSCAN);
int		bc_getlist_insep(char *source, char_p_t *args, char *sep, char *delims, int maxarg)
{
	char	*p = source;
	char	*ps;
	int		count = 0, level = 1;
	
	p = strchr(source, sep[0]);
	if	( p )	{
		ps = p+1;
		p ++;
		while ( *p )	{
			if	( *p == sep[1] )	{
				level --;
				if ( level == 0 )
					break;
				}
			else if	( *p == sep[0] )
				level ++;

			p ++;
			}

		if	( *p == sep[1] )	{
			*p = '\0';
			if	( strlen(ps) )	
				count = bc_getlist(ps, args, delims, maxarg);
			}
		else	
			sc_raise("MISSING '%c'", sep[1]);
		}
	return count;
}

/*
*	INLINE IFs
*
*	returns true if there is an inline IF
*
*	IF expr THEN ... ---> IF expr THEN (:) .... (:FI)
*	IF expr THEN ... ELSE ... ---> IF expr THEN (:) .... (:ELSE:) ... (:FI)
*/
int		bc_scan_inline_if(char *text)
{
	char	*p = (char *) text;	// *text points to 'expr'
	char	*pthen, *pelse;
	char	buf[TEXT_LINE_SIZE];

	if	( scan_error )		return 0;

	pthen = p;
	do	{
		pthen = str_istr(pthen+1, " THEN ");
		if	( pthen )	{
			// store the expression
			while ( *p == ' ' )	p ++;
			strcpy(buf, p);
			p = str_istr(buf, " THEN ");
			*p = '\0';

			// check for ':'
			p = pthen+6;
			while ( *p == ' ' )	p ++;

			if	( *p != ':' && *p != '\0' )	{
				// store the IF
				block_level ++;	block_id ++;
				bc_push();	bc_add1(&bc_prog,kwIF);	bc_add1i(&bc_prog,0);	bc_add1i(&bc_prog,0);
				bc_scan_expr(buf, 0);
				if	( scan_error )		return 0;
				// store EOC
				bc_add1(&bc_prog,kwTYPE_EOC);	//bc_eoc();

				// auto-goto 
				p = pthen + 6;
				while ( *p == ' ' )	p ++;
				if	( is_digit(*p) )	{
					// add goto
					strcpy(buf, "GOTO ");
					strcat(buf, p);
					}
				else
					strcpy(buf, p);

				// ELSE command
				// If there are more inline-ifs (nested) the ELSE belongs to the first IF (that's an error)
				pelse = str_istr(buf+1, "ELSE");
				if	( pelse )	{
					do	{
						if	( (*(pelse-1) == ' ' || *(pelse-1) == '\t') &&
							  (*(pelse+4) == ' ' || *(pelse+4) == '\t') )	{

							*pelse = '\0';

							// scan the commands before ELSE
							bc_scan_cmd(buf);
							// add EOC
							bc_eoc(&bc_prog);

							// auto-goto
							strcpy(buf, "ELSE:");
							p = pelse + 4;
							while ( *p == ' ' || *p == '\t' )	p ++;
							if	( is_digit(*p) )	{
								// add goto
								strcat(buf, "GOTO ");
								strcat(buf, p);
								}
							else
								strcat(buf, p);
							
							//
							break;
							}
						else
							pelse = str_istr(pelse+1, "ELSE");
						} while ( pelse != NULL );
					}

				// scan the rest commands
				bc_scan_cmd(buf);
				// add EOC
				bc_eoc(&bc_prog);

				// add ENDIF
				bc_push();	bc_add1(&bc_prog, kwENDIF);	bc_add1i(&bc_prog,0);	bc_add1i(&bc_prog,0);
				block_level --;

				return 1;
				}
			else	// *p == ':'
				return 0;
			}
		else
			break;

		} while ( pthen != NULL );

	return 0;	// false
}

/*
*	PASS1: scan source line
*/
void	bc_scan_cmd(char *text)
{
	char	*p;
	char	*lb_end;
	char	*last_cmd;
	int		idx, sharp, decl = 0, vattr;