scan.c

smallbasic for linux

	char	pname[33], vname[33];

	if	( scan_error )		return;

	str_alltrim(text);
	p = text;

	if	( *p == ':' )	{
		p ++;
		bc_scan_cmd(p);
		return;
		}

	// remark
	if	( *p == '\'' || *p == '#' )	return;

	// empty line
	if	( *p == '\0' )		return;

	lb_end = p = bc_getkeywordstr((char *)text, bc_name);
	last_cmd = p;
	p = get_param_sect(p, ":", bc_parm);

	/* check old style labels */
	if	( is_all_digits(bc_name) )	{
		str_alltrim(bc_name);
		idx = bc_get_label_id(bc_name);
		bc_set_label_ip(idx);
		if	( scan_error )		return;

		// continue
		last_cmd = p = bc_getkeywordstr(lb_end, bc_name);
		if	( strlen(bc_name) == 0 )	{
			if	( !p )	return;
			if	( *p == '\0' ) return;
			}
		p = get_param_sect(p, ":", bc_parm);
		}

	/* what is this ? */
	idx = bc_is_keyword(bc_name);

	if	( idx == kwLET )	{	// old-style keyword LET
		char	*p;
		idx = -1;
		p = bc_getkeywordstr(bc_parm, bc_name);
		strcpy(bc_parm, p);
		}
	else if ( idx == kwDECLARE )	{ // declaration
		char	*p;

		decl = 1;
		p = bc_getkeywordstr(bc_parm, bc_name);
		idx = bc_is_keyword(bc_name);
		strcpy(bc_parm, p);
		if	( idx != kwPROC && idx != kwFUNC )	{
			sc_raise("USE DECLARE WITH SUB|FUNC KEYWORD");
			return;
			}
		}

	//////
	sharp = (bc_parm[0] == '#');

	if	( bc_parm[0] == '=' && (idx != -1) )	{	// can't check arrays
		sc_raise("%s: IS KEYWORD", bc_name);
		return;                             
		}
	else if	( (bc_parm[0] == '=' || bc_parm[0] == '(') && (idx == -1) )	{
		// add let command
		bc_add2i(&bc_prog, kwLET, bc_get_var_id(bc_name));

		if	( bc_parm[0] == '(' )	{
			char	*p = strchr(bc_parm, '=');
			char	*n;
			
			if	( !p )	
				sc_raise("MISSING '='");
			else	{
				if	( *bc_next_char(bc_parm+1) == ')' )	{
					bc_scan_expr(p, 0);
					}
				else	{
					// ARRAY (LEFT)
					*p = '\0';
					n = p;
					str_alltrim(bc_parm);
					bc_parm[0] = ' ';
					bc_parm[strlen(bc_parm)-1] = ' ';
	
					bc_add1(&bc_prog,kwTYPE_LEVEL_BEGIN);
					bc_scan_expr(bc_parm, 0);
					bc_prog.ptr[bc_prog.count-1] = kwTYPE_LEVEL_END;
	
					*n = '=';
					bc_scan_expr(n, 0);
					}
				}
			}
		else
			bc_scan_expr(bc_parm, 0);
		}
	else if ( /* idx == kwLET || */ idx == kwCONST )	{
		p = bc_getkeywordstr(bc_parm, bc_name);
		p = get_param_sect(p, ":", bc_parm);

		if	( bc_is_keyword(bc_name) != -1 )
			sc_raise("%s: IS KEYWORD", bc_name);
		else	{
			if	( !(bc_parm[0] == '=' || bc_parm[0] == '(') )	
				sc_raise("MISSING '='");
			else	{
				bc_add2i(&bc_prog,idx, bc_get_var_id(bc_name));
				bc_scan_expr(bc_parm, 0);
				}
			}
		}
	else {
		// add generic command
		if	( idx != -1 )	{
			if	( idx == kwLABEL )	{
				str_alltrim(bc_parm);
				idx = bc_get_label_id(bc_parm);
				bc_set_label_ip(idx);
				}
			else if	( idx == kwEXIT )	{
				bc_add1(&bc_prog, idx);
				str_alltrim(bc_parm);
				if	( strlen(bc_parm) )	{
					idx = bc_is_keyword(bc_parm);
					if	( idx == kwFOR || idx == kwLOOP || idx == kwPROC || idx == kwFUNC )	
						bc_add1(&bc_prog, idx);
					else
						sc_raise("USE EXIT [FOR|LOOP|SUB|FUNC]");
					}
				}
			else if	( idx == kwDECLARE )	{
				}
			else if	( idx == kwPROC || idx == kwFUNC )	{
				//
				//	PROCEDURES/FUNCTIONS
				//
				char_p_t pars[64];
				char	*lpar_ptr;
				int		i, count, pidx;

				lpar_ptr = strchr(bc_parm, '(');
				if	( lpar_ptr )
					*lpar_ptr = '\0';

				bc_prepname(pname, bc_parm, 32);
				if	( decl )	{
					// declaration
					if	( bc_proc_getip(pname) == 0xFFFF )
						bc_addproc(pname);
					}
				else	{
					if	( bc_proc_getip(pname) != 0xFFFF )
						sc_raise("PROC/FUNC ALREADY DEFINED: %s", pname);
					else {

						if	( (pidx = bc_proc_setip(pname, bc_prog.count)) == -1 )	{
							pidx = bc_addproc(pname);
							bc_proc_setip(pname, bc_prog.count);
							}

						//
						bc_add1(&bc_prog, kwGOTO);
						bc_add1i(&bc_prog,0);
						bc_add1(&bc_prog,0);

						block_level ++; block_id ++;
						bc_push();
						bc_add1(&bc_prog, idx);

						//
						if	( bc_proc_level )	{
							strcat(bc_proc, "/");
							strcat(bc_proc, pname);
							}
						else
							strcpy(bc_proc, pname);

						if	( !scan_error )	{
							bc_proc_level ++;

							if	( idx == kwFUNC )	{	// setup dvar. {F}/{F}
								char	*buf;
								buf = tmp_alloc(strlen(bc_proc)+strlen(pname)+2);
								#if defined(_PalmOS)
								StrPrintF(buf, "%s/%s", bc_proc, pname);
								#else
								sprintf(buf, "%s/%s", bc_proc, pname);
								#endif
								proc_table[pidx].vid = bc_get_var_id(buf);
								tmp_free(buf);
								}
							else
								proc_table[pidx].vid = 0xFFFF;

							// parameters
							if	( lpar_ptr )	{
								char	*buf;

								buf = tmp_alloc(TEXT_LINE_SIZE);

								*lpar_ptr = '(';
								count = bc_getlist_insep(bc_parm, pars, "()", ",", 64);
								bc_add2c(&bc_prog, kwTYPE_PARAM, count);
								for ( i = 0; i < count; i ++ )	{
									if	( strncmp(pars[i], "BYREF ", 6) == 0 )	{
										bc_prepname(vname, pars[i]+6, 32);
										vattr = 0x80;
										}
									else	{
										bc_prepname(vname, pars[i], 32);
										vattr = 0;
										}
										
									if	( strchr(pars[i], '(') )	{
										vattr |= 1;
										}

									bc_add1(&bc_prog, vattr);
									#if defined(_PalmOS)
									StrPrintF(buf, "%s/%s", bc_proc, vname);
									#else
									sprintf(buf, "%s/%s", bc_proc, vname);
									#endif
									bc_add1i(&bc_prog, bc_get_var_id(buf));
									}

								tmp_free(buf);
								}
							else	{
								bc_add2c(&bc_prog, kwTYPE_PARAM, 0);
								}
							}
						}
					}
				}
			else if	( idx == kwLOCAL )	{	// local variables
				char_p_t pars[64];
				int		i, count;

				count = bc_getlist(bc_parm, pars, ",", 64);
				bc_add2c(&bc_prog, kwTYPE_CRVAR, count);
				for ( i = 0; i < count; i ++ )	{
					bc_prepname(vname, pars[i], 32);

					if	( bc_proc_level )	{
						char	*buf;
						buf = tmp_alloc(strlen(bc_proc)+strlen(vname)+2);
						#if defined(_PalmOS)
						StrPrintF(buf, "%s/%s", bc_proc, vname);
						#else
						sprintf(buf, "%s/%s", bc_proc, vname);
						#endif
						bc_add1i(&bc_prog, bc_get_var_id(buf));
						tmp_free(buf);
						}
					else
						bc_add1i(&bc_prog, bc_get_var_id(vname));
					}
				}
			else if ( idx == kwREM )	
				return;
			else if ( idx == kwGOTO )	{
				str_alltrim(bc_parm);
				bc_push();
				bc_add2i(&bc_prog, idx, bc_get_label_id(bc_parm));
				bc_add1(&bc_prog, block_level);
				}
			else if ( idx == kwGOSUB )	{
				str_alltrim(bc_parm);
				bc_add2i(&bc_prog,idx, bc_get_label_id(bc_parm));
				}
			//
			//	IF
			//
			else if ( idx == kwIF )	{
				// from here, we can scan for inline IF
				if	( bc_scan_inline_if(last_cmd) )	{
					// inline-IFs
					return;
					}
				else	{
					block_level ++; block_id ++;
					bc_push();	bc_add1(&bc_prog,idx);	bc_add1i(&bc_prog,0);	bc_add1i(&bc_prog,0);
					bc_scan_expr(bc_parm, 0);
					bc_add1(&bc_prog,kwTYPE_EOC);	//bc_eoc();
					}
				}
			//
			//	ON x GOTO|GOSUB ...
			//
			else if ( idx == kwON )	{
				char	*p;
				int		keep_ip, count;
				char_p_t pars[64];
				int		i;
			
				idx = kwONJMP;		// WARNING!

				bc_push();
				bc_add1(&bc_prog,idx);
				bc_add1i(&bc_prog,0); bc_add1i(&bc_prog,0);	// true/false ip (pass2)

				if	( (p = strstr(bc_parm, " GOTO ")) != NULL )	{
					bc_add1(&bc_prog, kwGOTO);	// the command
					*p = '\0'; p += 6;
					keep_ip = bc_prog.count;
					bc_add1(&bc_prog, 0);			// the counter

					//count = bc_scan_label_list(p);
					count = bc_getlist(p, pars, ",", 64);
					for ( i = 0; i < count; i ++ )	
						bc_add1i(&bc_prog, bc_get_label_id(pars[i]));

					if	( count == 0 )
						sc_raise("ON x GOTO WHERE?");
					else	
						bc_prog.ptr[keep_ip] = count;

					bc_scan_expr(bc_parm, 0);	// the expression
					bc_eoc(&bc_prog);
					}
				else if	( (p = strstr(bc_parm, " GOSUB ")) != NULL )	{
					bc_add1(&bc_prog,kwGOSUB);	// the command
					*p = '\0';	p += 7;
					keep_ip = bc_prog.count;
					bc_add1(&bc_prog,0);			// the counter

					//count = bc_scan_label_list(p);
					count = bc_getlist(p, pars, ",", 64);
					for ( i = 0; i < count; i ++ )	
						bc_add1i(&bc_prog, bc_get_label_id(pars[i]));

					if	( count == 0 )
						sc_raise("ON x GOSUB WHERE?");
					else	
						bc_prog.ptr[keep_ip] = count;

					bc_scan_expr(bc_parm, 0);	// the expression
					bc_eoc(&bc_prog);
					}
				else
					sc_raise("ON WHAT?");
				}
			//
			//	FOR
			//
			else if ( idx == kwFOR )	{
				char	*p = strchr(bc_parm, '=');
				char	*p_lev;
				char	*n;
			
				block_level ++; block_id ++;
				bc_push();	
				bc_add1(&bc_prog, kwFOR);	
				bc_add1i(&bc_prog, 0);
				bc_add1i(&bc_prog, 0);

				if	( !p )	
					sc_raise("FOR: MISSING '='");
				else	{
					*p = '\0';
					n = p;

					strcpy(bc_name, bc_parm);
					str_alltrim(bc_name);
					if	( !is_alpha(*bc_name) )
						sc_raise("FOR: %s IS NOT A VARIABLE", bc_name);
					else	{
						p_lev = bc_name;
						while ( is_alnum(*p_lev) || *p_lev == ' ' )	p_lev ++;
						if	( *p_lev == '(' )	
							sc_raise("FOR: %s IS AN ARRAY", bc_name);
						else	{
							bc_add2i(&bc_prog, kwTYPE_VAR, bc_get_var_id(bc_name));

							*n = '=';
							bc_scan_expr(n+1, 0);
							}
						}
					}
				}
			//
			//	WHILE - REPEAT
			//
			else if ( idx == kwWHILE || idx == kwREPEAT )	{
				// WHILE & REPEAT DOES NOT USE STACK 
				block_level ++; block_id ++;
				bc_push();	bc_add1(&bc_prog,idx);	bc_add1i(&bc_prog,0);	bc_add1i(&bc_prog,0);
				bc_scan_expr(bc_parm, 0);
				}
			else if ( idx == kwELSE || idx == kwELIF )	{
				bc_push();	bc_add1(&bc_prog,idx);	bc_add1i(&bc_prog,0);	bc_add1i(&bc_prog,0);
				bc_scan_expr(bc_parm, 0);
				}
			else if ( idx == kwENDIF || idx == kwNEXT )	{
				bc_push();	bc_add1(&bc_prog,idx);	bc_add1i(&bc_prog,0);	bc_add1i(&bc_prog,0);
				block_level --;
				}
			else if ( idx == kwWEND || idx == kwUNTIL )	{
				bc_push();	bc_add1(&bc_prog,idx);	bc_add1i(&bc_prog,0);	bc_add1i(&bc_prog,0);
				// WHILE & REPEAT DOES NOT USE STACK
				block_level --;
				bc_scan_expr(bc_parm, 0);
				}
			else if (  idx == kwSTEP || idx == kwTO || idx == kwTHEN 
					|| idx == kwCOS  || idx == kwSIN || idx == kwLEN || idx == kwLOOP  )		// functions...
				{
				sc_raise("%s: WRONG POSITION", bc_name);
				}
			else if ( idx == kwRESTORE )	{
				bc_push();
				bc_add2i(&bc_prog, idx, bc_get_label_id(bc_parm));
				}
			else if ( idx == kwEND )	{
				if	( bc_proc_level )	{
					char	*dol;

					// UDP/F RETURN
					dol = strrchr(bc_proc, '/');
					if	( dol )
						*dol = '\0';
					else
						*bc_proc = '\0';

					bc_push();
					bc_add1(&bc_prog, kwTYPE_RET);

					bc_proc_level --;
					block_level --; block_id ++;
					}
				else	{
					// END OF PROG
					bc_add1(&bc_prog, idx);
					}
				}
			else if ( idx == kwSTOP )
				bc_add1(&bc_prog, idx);
			else if ( idx == kwDATA )	
				bc_scan_data(bc_parm);
			else if ( idx == kwINPUT && sharp )	{
				bc_add1(&bc_prog, kwFILEINPUT);
				bc_scan_expr(bc_parm, 0);
				}
			else if ( idx == kwPRINT && sharp )	{
				bc_add1(&bc_prog, kwFILEPRINT);
				bc_scan_expr(bc_parm, 0);
				}
			else	{
				bc_add1(&bc_prog, idx);
				bc_scan_expr(bc_parm, 0);
				}
			}
		else	{
			int		udp;

			udp = bc_get_proc_id(bc_name);
			if	( udp == -1 )
				sc_raise("%s: UNKNOWN COMMAND", bc_name);
			else	{
				bc_push();
				bc_add2i(&bc_prog, kwTYPE_CALL_UDP, udp);
				bc_add1i(&bc_prog, 0);
				bc_add1(&bc_prog, kwTYPE_LEVEL_BEGIN);
				bc_scan_expr(bc_parm, 0);
				bc_add1(&bc_prog, kwTYPE_LEVEL_END);
				}
			}
		}

	if	( *p == ':' )	{
		// command separator
		bc_eoc(&bc_prog);
		p ++;
		bc_scan_cmd(p);
		}
}

/*
*	skip command bytes
*/
word	bc_nextcmd(word ip) SEC(BCSCAN);
word	bc_nextcmd(word ip)
{
	word	code;
	word	len;

	code = bc_prog.ptr[ip];
	ip ++;

	switch ( code )	{
	case	kwEXIT:
		if	( bc_prog.ptr[ip] == kwFOR || bc_prog.ptr[ip] == kwLOOP ||
		      bc_prog.ptr[ip] == kwPROC || bc_prog.ptr[ip] == kwFUNC )
			ip ++;
		break;
	case	kwTYPE_SEP:
	case	kwTYPE_LOGOPR:
	case	kwTYPE_CMPOPR:
	case	kwTYPE_ADDOPR:
	case	kwTYPE_MULOPR:
	case	kwTYPE_POWOPR:
	case	kwTYPE_UNROPR:
		ip ++;
		break;
	case	kwLET:
	case	kwTYPE_LINE:
	case	kwLABEL:
	case	kwGOSUB:
	case	kwRESTORE:
	case	kwTYPE_VAR:
	case	kwTYPE_CALL_UDP:
	case	kwTYPE_CALL_UDF:
		ip += 2;
		break;
	case	kwGOTO:
		ip += 3;
		break;
	case	kwTYPE_CRVAR:
		len = bc_prog.ptr[ip];
		ip += (len * 2) + 1;
		break;
	case	kwTYPE_PARAM:
		len = bc_prog.ptr[ip];
		ip += (len * 3) + 1;
		break;
	case	kwONJMP:
		ip += 5;
		ip += (bc_prog.ptr[ip] << 1);
		break;
	case	kwTYPE_INT:
		ip += 4;
		break;
	case	kwTYPE_NUM:
		ip += 8;
		break;
	case	kwTYPE_STR:
		memcpy(&len, bc_prog.ptr+ip, 2);
		len += 2;
		ip += len;
		break;
	case	kwIF:		case	kwFOR: 		case	kwWHILE:	case	kwREPEAT:
	case	kwELSE:		case	kwELIF:
	case	kwENDIF:	case	kwNEXT:		case	kwWEND:		case	kwUNTIL:
		ip += 4;
		break;
		};
	return ip;
}

/*
*	search for command (in byte-code)
*/
word	bc_search(word ip, byte code)
{
	word	i = ip;

	do	{
		if	( code == bc_prog.ptr[i] )
			return i;

		i = bc_nextcmd(i);
		} while ( i < bc_prog.count );
	return 0xFFFF;
}

/*
*	search for End-Of-Command mark
*/
word	bc_search_eoc(word ip) SEC(BCSCAN);
word	bc_search_eoc(word ip)
{
	word	i = ip;
	word	code;

	do	{
		code = bc_prog.ptr[i];
		if	( code == kwTYPE_EOC || code == kwTYPE_LINE )
			return i;

		i = bc_nextcmd(i);
		} while ( i < bc_prog.count );
	return bc_prog.count;
}

/*
*	search stack
*/
word	bc_search_stack(word start, word code, word level) SEC(BCSCAN);
word	bc_search_stack(word start, word code, word level)
{
	word		i;
	pass_node_t	node;

	for ( i = start; i < stk_count; i ++ )	{
		dbt_read(bc_stack, i, &node, sizeof(pass_node_t));

		if	( node.level == level )	{
			if	( bc_prog.ptr[node.pos] == code )
				return node.pos;
			}
		}
	return 0xFFFF;
}

/*
*	search stack backward
*/
word	bc_search_stack_backward(word start, word code, word level) SEC(BCSCAN);
word	bc_search_stack_backward(word start, word code, word level)
{
	word		i = start;
	pass_node_t	node;

	for ( ; i < stk_count; i -- )	{	// WARNING: ITS UNSIGNED, SO WE'LL SEARCH IN RANGE [0..STK_COUNT]
		dbt_read(bc_stack, i, &node, sizeof(pass_node_t));
		if	( node.level == level )	{
			if	( bc_prog.ptr[node.pos] == code )
				return node.pos;
			}
		}
	return 0xFFFF;
}

/*
*	PASS 2 (write jumps for IF/FOR/WHILE/REPEAT)
*/
void	bc_pass2_scan(void) SEC(BCSCAN);
void	bc_pass2_scan()
{
	word	i, j, true_ip, false_ip, label_id, w;
	word	a_ip, b_ip, c_ip, count;
	byte	code, level;
	pass_node_t	node;
	label_t	label;

	dev_printf("\rPASS2: Node %d/%d", i, stk_count);

	for ( i = 0; i < stk_count; i ++ )	{

		if	( (i % 32) == 0 )
			dev_printf("\rPASS2: Node %d/%d", i, stk_count);

		dbt_read(bc_stack, i, &node, sizeof(pass_node_t));

		scan_line = node.line;
		strcpy(bc_sec, node.sec);

		code = bc_prog.ptr[node.pos];

		if	(  code != kwGOTO && code != kwRESTORE 
		    && code != kwTYPE_CALL_UDP && code != kwTYPE_CALL_UDF 
			&& code != kwPROC && code != kwFUNC && code != kwTYPE_RET )	{
			true_ip = bc_search_eoc(node.pos+5);
			memcpy(bc_prog.ptr+node.pos+1, &true_ip, 2);
			}

		switch ( code )	{
		case kwPROC:
		case kwFUNC:
			// update start's GOTO
			true_ip = bc_search_stack(i+1, kwTYPE_RET, node.level) + 1;
			memcpy(bc_prog.ptr+node.pos-3, &true_ip, 2);
			break;

		case kwRESTORE:
			memcpy(&label_id, bc_prog.ptr+node.pos+1, 2);