constant ESTATE_NEW -3;
constant ESTATE_QUIT -2;
constant ESTATE_DANGEROUS -1;
constant ESTATE_NORMAL 0;
constant ESTATE_ERROR 1;

constant TYPE_INT = 0;
constant TYPE_STRING = 1;

constant STACK_NONE = 0;
constant STACK_FOR = 1;
constant STACK_REPEAT = 2;
constant STACK_WHILE = 3;
constant STACK_GOSUB = 4;

constant STACK_SIZE = 16;
array stack_type table STACK_SIZE;
array stack_cmd table STACK_SIZE;
array stack_line table STACK_SIZE;
global stack_ptr = 1;

global cmd;
global program_ptr = 0;
global program_lineno;

! An error has occurred.

[ error msg;
	print "^", (string) msg;
	if (program_ptr)
		print " at line ", program_lineno;
	print ".^";
];

! Miscellaneous errors.

[ error_nomore;		error("Token didn't expect more input"); ];
[ error_typemismatch;	error("Type mismatch"); ];
[ error_missingopenp;	error("Missing open parenthesis"); ];
[ error_missingclosep;	error("Missing close parenthesis"); ];
[ error_syntaxerror;	error("Syntax error"); ];
[ error_outofmemory;	error("Out of memory"); ];
[ error_notrunning;	error("Not running a program"); ];
[ error_stackoverflow;	error("Stack overflow"); ];

! End of statement token?

[ eos t;
	return ((t == TOKEN__EOL) || (t == TOKEN__COLON));
];

! Skip white space.

[ skipwhite;
	while (cmd->0 == TOKEN__SPACE)
		cmd++;
];

! Read and evaluate an lvalue.

[ eval_lvalue  varname i j val;
	skipwhite();

	varname = cmd;
	while ((cmd++)->0);

	skipwhite();
	if (cmd->0 ~= TOKEN__LPAREN)
	{
		! It's not an array, so we can return the raw name.
		return strdup(varname);
	}

	cmd++;
	val = eval_expression();
	if (val == 0)
		return 0;
	if (val-->0 ~= TYPE_INT)
	{
		error_typemismatch();
		mem_free(val);
		return 0;
	}
	i = val-->1;
	mem_free(val);
	val = i;
	
	skipwhite();
	if (cmd->0 == TOKEN__COMMA)
	{
		mem_free(val);
		error("Multidimensional arrays are not supported");
		return 0;
	}
	if (cmd->0 ~= TOKEN__RPAREN)
	{
		mem_free(val);
		error_syntaxerror();
		return 0;
	}
	cmd++;

	i = strlen(varname);
	j = mem_alloc(i+2);
	strcpy(j, varname);
	j->i = val;
	j->(i+1) = 0;

	return j;
];

! Read and evaluate a leaf expression.

[ eval_leaf  i j ret;
	skipwhite();

	i = ((cmd++)->0);
	switch (i)
	{
		TOKEN__NUMBER:
			ret = mem_alloc(4);
			ret-->0 = TYPE_INT;
			ret-->1 = cmd-->0;
			cmd = cmd + 2;
			return ret;

		TOKEN__STRING:
			ret = mem_alloc(4);
			ret-->0 = TYPE_STRING;
			ret-->1 = string_alloc(cmd+1, cmd->0);
			cmd = cmd + cmd->0 + 1;
			return ret;
			
		TOKEN__MINUS:
			ret = eval_leaf();
			if (ret-->0 ~= TYPE_INT)
			{
				mem_free(ret);
				error("Can only use - operator on strings");
				return 0;
			}
			ret-->1 = -(ret-->1);
			return ret;

		TOKEN__VAR:
			i = cmd;
			while ((cmd++)->0);
			skipwhite();
			if (cmd->0 ~= TOKEN__LPAREN)
			{
				ret = store_lookup(i);
				if (ret == 0)
				{
					error("Variable not found");
					return 0;
				}
				return ret;
			}
			cmd++;

			ret = eval_expression();
			if (ret == 0)
				return 0;
			if (ret-->0 ~= TYPE_INT)
			{
				mem_free(ret);
				error_typemismatch();
				return 0;
			}

			skipwhite();
			if ((cmd++)->0 ~= TOKEN__RPAREN)
			{
				mem_free(ret);
				error_syntaxerror();
				return 0;
			}
			
			j = mem_alloc(2+cmd-i);
			strcpy(j, i);
			i = strlen(j);
			j->i = ret-->1;
			j->(i+1) = 0;
			mem_free(ret);

			ret = store_lookup(j);
			mem_free(j);
			if (ret == 0)
			{
				error("Array or array index not found");
				return 0;
			}
			return ret;
		
		TOKEN__LPAREN:
			ret = eval_expression();
			if (ret == 0)
				return 0;
			if ((cmd++)->0 ~= TOKEN__RPAREN)
			{
				error_missingclosep();
				return 0;
			}
			return ret;

		! Simple function.

		TOKEN_RND, TOKEN_VAL:
			skipwhite();
			if ((cmd++)->0 ~= TOKEN__LPAREN)
			{
				error_missingopenp();
				return 0;
			}
			ret = eval_expression();
			if (ret == 0)
				return 0;
			if ((cmd++)->0 ~= TOKEN__RPAREN)
			{
				error_missingclosep();
				return 0;
			}

			switch (i)
			{
				TOKEN_RND:
					if (ret-->0 ~= TYPE_INT)
					{
						error_typemismatch();
						mem_free(ret);
						return 0;
					}

					ret-->1 = random(ret-->1) - 1;
					break;

				TOKEN_VAL:
					if (ret-->0 ~= TYPE_STRING)
					{
						error_typemismatch();
						mem_free(ret);
						return 0;
					}

					ret-->0 = TYPE_INT;
					ret-->1 = string_toint(ret-->1);
					break;
			}

			return ret;
	}

	error("Botched leaf expression");
	return 0;
];

! Evaluate an expression.

[ eval_expression  ret val i;
	ret = eval_leaf();
	if (ret == 0)
		return ret;
	skipwhite();

	i = cmd->0;
	switch (i)
	{
		TOKEN__EOL, TOKEN__COLON, TOKEN__SEMICOLON, TOKEN__COMMA, TOKEN__RPAREN,
		TOKEN_THEN, TOKEN_TO, TOKEN_STEP:
			return ret;

		! Operators that can work on any type.

		TOKEN__PLUS, TOKEN__LARROW, TOKEN__RARROW, TOKEN__EQUALS, TOKEN__NEQUAL:
			cmd++;
			val = eval_expression();
			if (val == 0)
				jump reterror;
			if (ret-->0 ~= val-->0)
				jump typemismatch;

			switch (ret-->0)
			{
				TYPE_INT:
					switch (i)
					{
						TOKEN__PLUS:
							ret-->1 = (ret-->1 + val-->1);
							break;

						TOKEN__LARROW:
							ret-->1 = (ret-->1 < val-->1);
							break;

						TOKEN__RARROW:
							ret-->1 = (ret-->1 > val-->1);
							break;

						TOKEN__EQUALS:
							ret-->1 = (ret-->1 == val-->1);
							break;

						TOKEN__NEQUAL:
							ret-->1 = (ret-->1 ~= val-->1);
							break;
					}
					break;

				TYPE_STRING:
					switch (i)
					{
						TOKEN__EQUALS:
							ret-->0 = TYPE_INT;
							ret-->1 = (string_compare(ret-->1, val-->1) == 0);
							break;

						TOKEN__NEQUAL:
							ret-->0 = TYPE_INT;
							ret-->1 = (string_compare(ret-->1, val-->1) ~= 0);
							break;

						TOKEN__PLUS, TOKEN__LARROW, TOKEN__RARROW:
							error("Unimplemented opcode");
							jump valreterror;
					}
					break;
			}
			mem_free(val);
			break;

		! Operators that only work on ints.
			
		TOKEN__MINUS, TOKEN__STAR, TOKEN__SLASH, TOKEN_AND, TOKEN_OR:
			cmd++;
			val = eval_expression();
			if (val == 0)
				jump reterror;
			if ((ret-->0 ~= TYPE_INT) || (val-->0 ~= TYPE_INT))
				jump typemismatch;

			switch (i)
			{
				TOKEN__MINUS:
					ret-->1 = ret-->1 - val-->1;
					break;

				TOKEN__STAR:
					ret-->1 = ret-->1 * val-->1;
					break;

				TOKEN__SLASH:
					if (val-->1 == 0)
					{
						error("Division by zero");
						jump valreterror;
					}
					ret-->1 = ret-->1 / val-->1;
					break;

				TOKEN_AND:
					ret-->1 = ret-->1 && val-->1;
					break;

				TOKEN_OR:
					ret-->1 = ret-->1 || val-->1;
					break;
			}
			mem_free(val);
			break;

		default:
			error("Botched complex expression");
			jump reterror;
	}

	return ret;

.typemismatch;
	error_typemismatch();
.valreterror;
	mem_free(val);
.reterror;
	mem_free(ret);
	return 0;
];

! List the current program.

[ cmd_list  val;
	skipwhite();
	if (eos(cmd->0) == 0)
		val = eval_expression();
	else
	{
		val = mem_alloc(4);
		val-->0 = TYPE_INT;
		val-->1 = 0;
	}

	if (val-->0 ~= TYPE_INT)
	{
		error_typemismatch();
		mem_free(val);
		return ESTATE_ERROR;
	}

	switch (val-->1)
	{
		-2:
			store_listvars();
			break;

		-1:
			store_listprogramhex();
			break;

		default:
			store_listprogram();
			break;
	}

	mem_free(val);
	return ESTATE_NORMAL;
];

! Prints out an expression.

[ cmd_print  val;
	while (1)
	{
		skipwhite();
		if (eos(cmd->0))
		{
			print "^";
			break;
		}

		val = eval_expression();
		if (val == 0)
			return ESTATE_ERROR;
		switch (val-->0)
		{
			TYPE_INT:
				print val-->1;
				break;

			TYPE_STRING:
				string_print(val-->1);
				break;

			default:
				mem_free(val);
				error("Internal error --- invalid type in print!");
				return ESTATE_ERROR;
		}
		mem_free(val);

		switch (cmd->0)
		{
			TOKEN__COMMA:
				print " ";
				cmd++;
				break;

			TOKEN__SEMICOLON:
				cmd++;
				if (eos(cmd->0))
					return ESTATE_NORMAL;
				break;
		}
	}

	return ESTATE_NORMAL;
];

! Invoke a script.

[ cmd_script  val id;
	skipwhite();
	if (eos(cmd->0))
	{
		script_list();
		return ESTATE_NORMAL;
	}
	val = eval_expression();
	if (val == 0)
		return ESTATE_ERROR;
	if (val-->0 ~= TYPE_INT)
	{
		mem_free(val);
		jump typemismatch;
	}
	id = val-->1;
	mem_free(val);
	! When we call this, it's entirely possible that the heap will be
	! trashed.
	return script_invoke(id);

.typemismatch;
	error_typemismatch();
	return ESTATE_ERROR;
];

! Variable assignment.

[ cmd_varassignment  varname val;
	varname = eval_lvalue();
	if (varname == 0)
		return ESTATE_ERROR;
	skipwhite();

	if ((cmd++)->0 ~= TOKEN__EQUALS)
	{
		mem_free(varname);
		error("Unrecognised keyword");
		return ESTATE_ERROR;
	}
	skipwhite();

	val = eval_expression();
	if (val == 0)
	{
		mem_free(varname);
		return ESTATE_ERROR;
	}

	store_assign(varname, val-->0, val-->1);
	mem_free(varname);
	mem_free(val);

	return ESTATE_NORMAL;
];
	
! Run the program.

[ cmd_run  i p;
	cmd_clear();
	stack_ptr = 1;
	stack_type-->1 = STACK_NONE;
	program_ptr = store_bottom;
	
	! As the program is already tokenised, we can directly run the
	! bytecode in the store.

	do {
		! Reached the end of the program?

		if (program_ptr->0 == 0)
		{
			i = ESTATE_NORMAL;
			break;
		}

		! Read in the line number and execute the line..

		p = program_ptr + 1;
		program_ptr = program_ptr + program_ptr->0;
		program_lineno = p-->0;
		p++;

		! Execute the line. Remember execute_command needs to be
		! pointed at the byte *before* the bytecode...

		i = execute_command(p);
	} until (i ~= ESTATE_NORMAL);

	program_ptr = 0;
	return i;
];

! Read in a string.

[ cmd_input  val varname buf;
	skipwhite();

	! Is there a label?

	if (cmd->0 == TOKEN__STRING)
	{
		val = eval_leaf();
		if (val == 0)
			return ESTATE_ERROR;
		if (val-->0 == TYPE_STRING)
			string_print(val-->1);
		else
		{
			error_typemismatch();
			mem_free(val);
			return ESTATE_ERROR;
		}
		mem_free(val);

		skipwhite();
		switch (cmd->0)
		{
			TOKEN__COMMA:
				print " ";
				break;

			TOKEN__SEMICOLON:
				break;

			default:
				error_syntaxerror();
				return ESTATE_ERROR;
		}
		cmd++;

		skipwhite();
	}
	else
		print "? ";

	! Get the variable name to put the result into.

	if ((cmd++)->0 ~= TOKEN__VAR)
	{
		error_syntaxerror();
		return ESTATE_ERROR;
	}
	varname = eval_lvalue();
	if (varname == 0)
		return ESTATE_ERROR;

	! Get the user's input.

	buf = mem_alloc(255);
	if (buf == 0)
	{
		mem_free(varname);
		error_outofmemory();
		return ESTATE_ERROR;
	}

	buf->0 = 255;
	read buf 0;

	! Assign to the variable.

	store_assign(varname, TYPE_STRING, string_alloc(buf+2, buf->1));

	! Free the temporary buffer.

	mem_free(varname);
	mem_free(buf);

	return ESTATE_NORMAL;
];

! Jump to a line number.

[ cmd_goto  val i;
	if (program_ptr == 0)
	{
		error_notrunning();
		return ESTATE_ERROR;
	}

	val = eval_expression();
	if (val == 0)
		return ESTATE_ERROR;
	if (val-->0 ~= TYPE_INT)
	{
		mem_free(val);
		error_typemismatch();
		return ESTATE_ERROR;
	}

	i = store_findline(val-->1);
	mem_free(val);
	if (i == 0)
	{
		error("No such line number");
		return ESTATE_ERROR;
	}

	program_ptr = i;
	return ESTATE_NORMAL;
];

		
! Conditional execution.

[ cmd_if  val;
	val = eval_expression();
	if (val == 0)
		return ESTATE_ERROR;
	skipwhite();
	if ((cmd++)->0 ~= TOKEN_THEN)
	{
		mem_free(val);
		error_syntaxerror();
		return ESTATE_ERROR;
	}

	if ((val-->0 == TYPE_INT) && (val-->1 == 0))
		cmd = 0;
	
	mem_free(val);
	return ESTATE_NORMAL;
];
		
! Top half of a FOR loop.

[ cmd_for  varname val initialval targetval stepval cmdptr;
	! FOR can only be used when running a program.

	if (program_ptr == 0)
	{
		error_notrunning();
		return ESTATE_ERROR;
	}

	! Store the address of the FOR instruction.

	cmdptr = cmd-1;

	! Read the variable name.

	skipwhite();
	if ((cmd++)->0 ~= TOKEN__VAR)
	{
		error_syntaxerror();
		return ESTATE_ERROR;
	}
	varname = eval_lvalue();
	if (varname == 0)
		return ESTATE_ERROR;

	! Skip over the =.

	skipwhite();
	if ((cmd++)->0 ~= TOKEN__EQUALS)
	{
		error_syntaxerror();
		jump varnameexit;
	}

	! Read the initial value.

	val = eval_expression();
	if (val == 0)
		jump varnameexit;
	if (val-->0 ~= TYPE_INT)
	{
		error_typemismatch();
		jump varnameexit;
	}
	initialval = val-->1;
	mem_free(val);

	! Read the TO.

	skipwhite();
	if ((cmd++)->0 ~= TOKEN_TO)
	{
		error_syntaxerror();
		return ESTATE_ERROR;
	}

	! Read the target value.

	val = eval_expression();
	if (val == 0)
		jump varnameexit;
	if (val-->0 ~= TYPE_INT)
	{
		error_typemismatch();
		jump varnameexit;
	}
	targetval = val-->1;
	mem_free(val);
	
	! Is there a STEP clause?

	skipwhite();
	if (cmd->0 == TOKEN_STEP)
	{
		cmd++;
		skipwhite();

		! Read the STEP value.

		val = eval_expression();
		if (val == 0)
			jump varnameexit;
		if (val-->0 ~= TYPE_INT)
		{
			error_typemismatch();
			jump valexit;
		}
		stepval = val-->1;
		mem_free(val);
	}
	else
	{
		! Otherwise, default to 1.

		stepval = 1;
	}

	! Is this a new loop?

	if (stack_type-->stack_ptr == STACK_NONE)
	{
		! Yes. Ensure there's room on the stack.

		if ((stack_ptr+1) >= STACK_SIZE)
		{
			error_stackoverflow();
			jump varnameexit;
		}
		stack_ptr-->stack_type = STACK_NONE;

		! ...and set the initial value.

		store_assign(varname, TYPE_INT, initialval);
	}
	else
	{
		! Otherwise, load the loop counter.

		val = store_lookup(varname);
		if (val == 0)
		{
			error("FOR loop counter has disappeared");
			jump varnameexit;
		}
		if (val-->0 ~= TYPE_INT)
		{
			error_typemismatch();
			jump valexit;
		}
		initialval = val-->1;
		mem_free(val);

		! Increment it.

		initialval = initialval + stepval;

		! Test.

		if (((stepval < 0) && (initialval < targetval)) ||
		    ((stepval >= 0) && (initialval > targetval)))
		{
			! Abort! The NEXT keyword has placed the pointer to
			! to the next instruction after the loop on the stack.

			cmd = stack_cmd-->stack_ptr;
			program_ptr = stack_line-->stack_ptr;
			stack_type-->stack_ptr = 0;
			return ESTATE_NORMAL;
		}
		else
		{
			! Write back the new loop counter.

			store_assign(varname, TYPE_INT, initialval);
		}
	}

	mem_free(varname);
	stack_type-->stack_ptr = STACK_FOR;
	stack_cmd-->stack_ptr = cmdptr;
	stack_line-->stack_ptr = program_ptr;
	stack_ptr++;
	return ESTATE_NORMAL;

.valexit;
	mem_free(val);
.varnameexit;
	mem_free(varname);
	return ESTATE_ERROR;
];

! Bottom half of a FOR loop.

[ cmd_next  i j;
	! NEXT can only be used when running a program.

	if (program_ptr == 0)
	{
		error_notrunning();
		return ESTATE_ERROR;
	}

	stack_ptr--;
	if ((stack_ptr == 0) || (stack_type-->stack_ptr ~= STACK_FOR))
	{
		error("NEXT without FOR");
		return ESTATE_ERROR;
	}

	i = stack_cmd-->stack_ptr;
	j = stack_line-->stack_ptr;
	stack_cmd-->stack_ptr = cmd;
	stack_line-->stack_ptr = program_ptr;
	cmd = i;
	program_ptr = j;

	return ESTATE_NORMAL;
];

! Top half of a REPEAT..UNTIL loop.

[ cmd_repeat;
	! REPEAT can only be used when running a program.

	if (program_ptr == 0)
	{
		error_notrunning();
		return ESTATE_ERROR;
	}

	if ((stack_ptr+1) >= STACK_SIZE)
	{
		error_stackoverflow();
		return ESTATE_ERROR;
	}

	stack_type-->stack_ptr = STACK_REPEAT;
	stack_cmd-->stack_ptr = cmd+1;
	stack_line-->stack_ptr = program_ptr;
	stack_ptr++;
	return ESTATE_NORMAL;
];

! Bottom half of a REPEAT..UNTIL loop.

[ cmd_until  val;
	! REPEAT can only be used when running a program.

	if (program_ptr == 0)
	{
		error_notrunning();
		return ESTATE_ERROR;
	}

	stack_ptr--;
	if ((stack_ptr == 0) || (stack_type-->stack_ptr ~= STACK_REPEAT))
	{
		error("UNTIL without REPEAT");
		return ESTATE_ERROR;
	}

	val = eval_expression();
	if (val == 0)
		return ESTATE_ERROR;
	if (val-->0 ~= TYPE_INT)
	{
		mem_free(val);
		error_typemismatch();
		return ESTATE_ERROR;
	}

	if (val-->1 == 0)
	{
		cmd = stack_cmd-->stack_ptr;
		program_ptr = stack_line-->stack_ptr;
		stack_ptr++;
	}
	else
		stack_type-->stack_ptr = STACK_NONE;
	
	return ESTATE_NORMAL;
];

! Execute a command.

[ execute_command _cmd  i;
	cmd = _cmd;
	cmd++;
	while (1)
	{
		i = (cmd++)->0;

		switch (i)
		{
			TOKEN__EOL:	return ESTATE_NORMAL;
			TOKEN__SPACE:	continue;

			TOKEN__NUMBER:
				i = cmd-->0;
				cmd = cmd + 2;
				if (store_addline(i, cmd, _cmd->0 - 4))
					return ESTATE_ERROR;
				! Don't execute anything else on this line.
				return ESTATE_DANGEROUS;
				
			TOKEN__VAR:
				i = cmd_varassignment();
				jump checkresult;

			TOKEN_CLEAR:
				i = cmd_clear();
				jump checkresult;

			TOKEN_CLS:
				@erase_window -1;
				break;
				
			TOKEN_FOR:
				i = cmd_for();
				jump checkresult;

			TOKEN_GOTO:
				i = cmd_goto();
				jump checkresult;

			TOKEN_IF:
				i = cmd_if();
				if (i ~= ESTATE_NORMAL)
					return i;
				if (cmd == 0)
					return ESTATE_NORMAL;
				continue;

			TOKEN_INPUT:
				i = cmd_input();
				jump checkresult;

			TOKEN_LIST:
				i = cmd_list();
				jump checkresult;

			TOKEN_LOAD:
				restore endofstatement;
				error("Load failed");
				return ESTATE_ERROR;

			TOKEN_NEW:
				return ESTATE_NEW;

			TOKEN_NEXT:
				i = cmd_next();
				if (i == ESTATE_NORMAL)
					continue;
				return i;

			TOKEN_PRINT:
				i = cmd_print();
				jump checkresult;

			TOKEN_QUIT:
				error("Quit");
				return ESTATE_QUIT;

			TOKEN_REPEAT:
				i = cmd_repeat();
				jump checkresult;
				
			TOKEN_RUN:
				i = cmd_run();
				return i;

			TOKEN_SAVE:
				save endofstatement;
				error("Save failed");
				return ESTATE_ERROR;

			TOKEN_SCRIPT:
				i = cmd_script();
				jump checkresult;

			TOKEN_STOP:
				error("Stop");
				return ESTATE_ERROR;

			TOKEN_UNTIL:
				i = cmd_until();
				if (i ~= ESTATE_ERROR)
					return i;
				continue;
				jump checkresult;

			default:
				error("Unimplemented token");
				return ESTATE_ERROR;

			.checkresult;
				if (i == ESTATE_ERROR)
					return ESTATE_ERROR;
				break;
		}

	.endofstatement;
		if (eos(cmd->0) == 0)
		{
			error_nomore();
			return ESTATE_ERROR;
		}

		if (cmd->0 == TOKEN__COLON)
			cmd++;
	}
	
	return ESTATE_NORMAL;
];

