// eval6.cpp

#include <ctype.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <signal.h>	// signal()
#include <float.h>	// FPE_... signal codes
//#include <dir.h>	// MAXPATH

#include "eval6.h"

#define debug
#ifdef debug
static int	indent = 0;
#define InitDebug			indent = 0
#define enter(proc)			char *ProcName = proc; printf ("%10s %2d  %*s>%s\n", token, indent, indent+1, " ", ProcName); ++indent
#define leave				--indent;              printf ("%10s %2d  %*s<%s\n", token, indent, indent+1, " ", ProcName)
#define ShowTok				{ printf ("{%s}\n", (TokenType==ident_tok)?"ident":(TokenType==label_tok)?"label":token); }
#define DeclareTmpIndent	int TmpIndent
#define SaveIndent			TmpIndent = indent
#define RestoreIndent		indent = TmpIndent
#else
#define InitDebug
#define enter(proc)
#define leave
#define ShowTok
#endif

// Support routines. -----------------------------------------------------------

bool proglet_t::equal (token_t a, token_t b) {
	if (!a && !b) return false;
	if (!a || !b) return true;
	return strcmp (a, b) == 0;
}

void proglet_t::error (severity_t severity, char *msg1, char *msg2, char *msg3) {
	if (msg3 != 0) {
		printf ("%s, '%s', '%s'\n", msg1, msg2, msg3);
	} else if (msg2 != 0) {
		printf ("%s, '%s'\n", msg1, msg2);
	} else {
		printf ("%s\n", msg1);
	}
	if (severity != warn_e) {
		throw severity;		// Raise an exception which will be caught in main().
	}
}

// Look up a symbol.
proglet_t::symbol_t *proglet_t::FindSymbol (token_t name) {
	int	i;
	
	for (i = 0 ; i < NumSymbols && !equal (name, symbols[i].name) ; ++i)
		/* Scan through the symbol table. */ ;
		if (i < NumSymbols) {
			return &symbols[i];
		} else {
			return 0;
		}
}

proglet_t::symbol_t *proglet_t::CreateSymbol (token_t name, SymType_t type, value_t value) {
	if (NumSymbols == MaxSymbols) error (stop_e, "No room for more symbols at", name);
	// Assume that the symbol doesn't exist already.
	strcpy (symbols[NumSymbols].name, name);
	symbols[NumSymbols].type  = type;
	symbols[NumSymbols].value = value;
	++NumSymbols;
	return &symbols[NumSymbols-1];
}

proglet_t::value_t proglet_t::GetValue (token_t name, bool AllowFunctions) {
	symbol_t *sym = FindSymbol (name);
	if (sym == 0) error (stop_e, "symbol not found", name);
	if (!AllowFunctions && sym->type == function_e) {
		error (stop_e, "not a value", name);
	}
	return sym->value;		// Constants and variables are always allowed.
}

void proglet_t::InitSymbolTable (void) {
	static const value_t	PI = 3.14159265358979323846,
							E  = 2.71828182845904523536;
	static const int		NumPredefinedFunctions = 9,
							NumPredefinedSymbols   = 5;
	static struct {
		token_t	name;
		value_t	value;
	} PredefinedFunctions[NumPredefinedFunctions] = {
		{"rand",	0.0},
		{"abs",		1.0},
		{"sin",		1.0},
		{"cos",		1.0},
		{"tan",		1.0},
		{"asin",	1.0},
		{"acos",	1.0},
		{"atan",	1.0},
		{"atan2",	2.0}
	},
		PredefinedSymbols[NumPredefinedSymbols] = {
			{"e",		E},
			{"pi",		PI},
			{"deg",		180.0/PI},
			{"rad",		PI/180.0},
			{"time",	0.0},
	};
	
	NumFunctions = NumPredefinedFunctions;
	NumSymbols = 0;		// Incremented with each symbol created.
	for (int i = 0 ; i < NumPredefinedFunctions ; ++i) {
		CreateSymbol (PredefinedFunctions[i].name, function_e, PredefinedFunctions[i].value);
	}
	for (i = 0 ; i < NumPredefinedSymbols; ++i) {
		CreateSymbol (PredefinedSymbols[i].name, variable_e, PredefinedSymbols[i].value);
	}
}


// Overloaded functions for building up the program. ---------------------------

void proglet_t::AddInstr (instr_t instr) {
	if (ProgLen >= MaxProgLen) error (stop_e, "Program too big.");
	prog[ProgLen].instr = instr;
	++ProgLen;
}

void proglet_t::AddInstr (value_t num) {
	if (ProgLen >= MaxProgLen-1) error (stop_e, "Program too big.");
	prog[ProgLen].instr = PushNum_instr;	// Only possibility with numeric operand.
	++ProgLen;
	prog[ProgLen].num = num;
	++ProgLen;
}

void proglet_t::AddInstr (instr_t instr, symbol_t *sym) {
	if (ProgLen >= MaxProgLen-1) error (stop_e, "Program too big.");
	prog[ProgLen].instr = instr;	// May either assign to, or push value of symbols.
	++ProgLen;
	prog[ProgLen].sym = sym;
	++ProgLen;
}

void proglet_t::AddInstr (instr_t instr, int addr) {
	if (ProgLen >= MaxProgLen-1) error (stop_e, "Program too big.");
	prog[ProgLen].instr = instr;
	++ProgLen;
	prog[ProgLen].address = addr;
	++ProgLen;
}

// Lexical analysis. -----------------------------------------------------------

proglet_t::TokenType_t proglet_t::FollowedBy (char next, char follow1, TokenType_t op1, char follow2, TokenType_t op2, TokenType_t op3) {
	if (next == follow1) {
		token[1] = next; token[2] = 0;
		++StmtIndex;
		return op1;
	} else if (next == follow2) {
		token[1] = next; token[2] = 0;
		++StmtIndex;
		return op2;
	} else {
		token[1] = 0;
		return op3;
	}
}

proglet_t::TokenType_t proglet_t::FollowedBy (char next, char follow1, TokenType_t op1, TokenType_t op2) {
	if (next == follow1) {
		token[1] = next; token[2] = 0;
		++StmtIndex;
		return op1;
	} else {
		token[1] = 0;
		return op2;
	}
}

void proglet_t::GetNextToken (void) {
	int	TokenLen;
	
	// Skip leading whitespace.
	while ((StmtIndex < StmtLen) && (strchr (" \t\n", statement[StmtIndex]) != 0) ){
		++StmtIndex;
	}
	if (StmtIndex >= StmtLen) {
		//error (stop_e, "No more tokens to get");
		token[0] = 0;
		TokenType = null_tok;
		return;
	}
	token[0] = statement[StmtIndex];
	TokenLen = 1;
	++StmtIndex;
	
	TokenType = unknown_tok;
	if (isalpha (token[0])) {
		int			i;
		const int	NumKeywords = 14;
		static struct {
			token_t		name;
			TokenType_t	value;
		} keywords[NumKeywords] = {
			{"if",		if_tok},
			{"then",	then_tok},
			{"else",	else_tok},
			{"endif",	endif_tok},
			{"loop",	loop_tok},
			{"endloop", endloop_tok},
			{"exit",	exit_tok},
			{"when",	when_tok},
			{"unless",	unless_tok},
			{"print",	print_tok},
			{"run",		run_tok},
			{"rem",		rem_tok},
			{"mod",		mod_tok},
			{"include",	include_tok}
		};
		
		// Token is probably an identifier, but could still be a keyword or operator.
		// Read in the remainder of the name.
		while (	StmtIndex < StmtLen					// Are there any more characters?
				&& TokenLen < MaxTokenLen			// Have we room for more characters?
				&& isalnum (statement[StmtIndex])	// Do we want them?
		) {
			token[TokenLen] = statement[StmtIndex];
			++TokenLen;
			++StmtIndex;
		}
		if (	StmtIndex < StmtLen					// Is another character available?
			&& TokenLen == MaxTokenLen				// Have we run out of room for it?
			&&	isalnum (statement[StmtIndex])		// Did we want it?
			) {
			token[TokenLen-1] = 0;	// Terminate the partial token so that we can print it,
			error (stop_e, "Identifier too long for token buffer", token);
		}
		token[TokenLen] = 0;	// Terminate token string.
		// Now check to see if it is a label, keyword, operator or identifier.
		if (statement[StmtIndex] == ':') {
			TokenType = label_tok;
			++StmtIndex;
			// Don't add this to the LabelName though.
		} else {
			for (i = 0 ; i < NumKeywords && !equal (token, keywords[i].name) ; ++i) /* empty */ ;
			if (i < NumKeywords) {
				TokenType = keywords[i].value;	// Includes 'rem' and 'mod' operators.
			} else {
				TokenType = ident_tok;
			}
		}
	} else if (isdigit (token[0])) {
		TokenType = number_tok;
		// Token is a number - a 'literal numerical constant'.
		--StmtIndex;	// Back up a character and read the whole number in.
		if (sscanf (&statement[StmtIndex], "%lf%n", &TokenValue, &TokenLen) == 1) {
			strncpy (token, &statement[StmtIndex], sizeof (token)-2);
			token[TokenLen] = 0;
			StmtIndex = StmtIndex + TokenLen;
		} else {
			error (stop_e, "program error - couldn't read number", &statement[StmtIndex-1]);
		}
	} else {
		// Hopefully an operator of some kind.
		token[1] = 0;
		switch (token[0]) {
			case '<':	TokenType = FollowedBy (statement[StmtIndex], '=', le_tok, '<',   Lshift_tok, lt_tok);	break;
			case '>':	TokenType = FollowedBy (statement[StmtIndex], '=', ge_tok, '>',   Rshift_tok, gt_tok);	break;
			case '=':	TokenType = FollowedBy (statement[StmtIndex], '=', eq_tok,        asgn_tok);			break;
			case '!':	TokenType = FollowedBy (statement[StmtIndex], '=', ne_tok,        BoolNot_tok);			break;
			case '&':	TokenType = FollowedBy (statement[StmtIndex], '&', BoolAnd_tok,   BitAnd_tok);			break;
			case '|':	TokenType = FollowedBy (statement[StmtIndex], '|', BoolOr_tok,    BitOr_tok);			break;
			case '+':	TokenType = FollowedBy (statement[StmtIndex], '=', PlusAsgn_tok,  plus_tok);			break;
			case '-':	TokenType = FollowedBy (statement[StmtIndex], '=', MinusAsgn_tok, minus_tok);			break;
			case '*':	TokenType = mul_tok;		break;
			case '/':	TokenType = div_tok;		break;
			case '~':	TokenType = BitNot_tok;		break;
			case '^':	TokenType = pow_tok;		break;
			case '(':	TokenType = Lpar_tok;		break;
			case ')':	TokenType = Rpar_tok;		break;
			case ',':	TokenType = comma_tok;		break;
			case ';':	TokenType = StmtDelim_tok;	break;
			case '.':	TokenType = dot_tok;		break;
			default:	token[1] = 0; error (stop_e, "Unexpected character", token);break;
		}
	}
	ShowTok;
}

void proglet_t::InitLexer (char *line) {
	// Initialise lexical bits.
	statement = line;
	StmtLen = strlen (line);
	StmtIndex = 0;
	
	GetNextToken ();
}

// Syntax analysis. ------------------------------------------------------------

int proglet_t::ParseArithExprList (TokenType_t EndToken) {
	int	NumArgs = 0;
	
	enter ("ParseArithExprList");
	while (TokenType != EndToken) {
		NumArgs = NumArgs + 1;
		ParseArithExpr ();		// and leave the result on the stack.
		if (TokenType == comma_tok) {
			GetNextToken ();
		}
	}
	if (TokenType != EndToken) {
		error (stop_e, "',' or ')' expected in argument list.  Found", token);
	}
	leave;
	return NumArgs;
}

void proglet_t::ParsePrimary (void) {
	token_t	name;
	
	enter ("ParsePrimary");
	switch (TokenType) {
		case number_tok:
			AddInstr (TokenValue);
			GetNextToken ();
			break;
			
		case ident_tok:
			strcpy (name, token);
			
			GetNextToken ();
			if (TokenType == Lpar_tok) {	// Does it look like a function name?
				symbol_t *sym = FindSymbol (name);
				if (sym == 0) {
					error (stop_e, "Unrecognised function", name);
				}
				if (sym->type != function_e) {
					error (stop_e, "Not a function", name);
				}
				GetNextToken ();
				if (ParseArithExprList (Rpar_tok) == (int)(GetValue(name, true) + 0.1)) {	// Correct number of arguments?
					if      (equal (name, "rand"))	AddInstr (rand_instr);
					else if (equal (name, "abs"))	AddInstr (abs_instr);
					else if (equal (name, "sin"))	AddInstr (sin_instr);	// Messy, but necessary given
					else if (equal (name, "cos"))	AddInstr (cos_instr);	// the simplistic way we have
					else if (equal (name, "tan"))	AddInstr (tan_instr);	// declared the functions.
					else if (equal (name, "asin"))	AddInstr (asin_instr);
					else if (equal (name, "acos"))	AddInstr (acos_instr);
					else if (equal (name, "atan"))	AddInstr (atan_instr);
					else if (equal (name, "atan2"))	AddInstr (atan2_instr);
					else {
						// We've got some tables out of step.  It shouldn't be possible to get here.
						error (stop_e, "Programming error for function", name);
					}
				} else {
					error (stop_e, "Incorrect number of arguments given for", name);
				}
				GetNextToken ();	// Discard ")".
			} else {
				symbol_t *sym = FindSymbol (name);
				if (sym == 0) error (stop_e, "No such symbol to read from", name);
				AddInstr (PushSym_instr, sym);
			}
			break;
			
		default:
			if (isprint (token[0])) {
				error (stop_e, "unexpected token", token);
			} else {
				error (stop_e, "unexpected token");
			}
			break;
	}
	leave;
}

void proglet_t::ParseNegExpr (void) {
	instr_t	op = unknown_instr;
	
	enter ("ParseNegExpr");
	if (TokenType == plus_tok) {
		// Just ignore unary pluses and they'll go away.
		GetNextToken ();
	} else if (TokenType == minus_tok) {
		op = UnaryMinus_instr;	// We have to do something about unary minuses though...
		GetNextToken ();
	} else if (TokenType == BitNot_tok) {
		op = BitNot_instr;		// .. and bit-wise negation.
		GetNextToken ();
	}
	
	if (TokenType == Lpar_tok) {
		GetNextToken ();
		ParseArithExpr ();
		if (TokenType != Rpar_tok) error (stop_e, "')' expected.  Found", token);
		GetNextToken ();		// Discard Rpar.
	} else {
		ParsePrimary ();
	}
	
	if (op != unknown_tok) AddInstr (op);
	leave;
}

void proglet_t::ParseMulExpr (void) {
	enter ("ParseMulExpr");
	ParseNegExpr ();
	while (TokenType == mul_tok || TokenType == div_tok) {
		TokenType_t op = TokenType;
		
		GetNextToken ();
		ParseNegExpr ();
		
		if (op == mul_tok)	AddInstr (mul_instr);
		else				AddInstr (div_instr);
	}
	leave;
}

void proglet_t::ParseAddExpr (void) {
	enter ("ParseAddExpr");
	ParseMulExpr ();
	while (TokenType == plus_tok || TokenType == minus_tok) {
		TokenType_t op;
		
		op = TokenType;
		GetNextToken ();
		ParseMulExpr ();
		
		if (op == plus_tok)	AddInstr (add_instr);
		else				AddInstr (sub_instr);
	}
	leave;
}

void proglet_t::ParseBitAndExpr (void) {
	enter ("ParseBitAndExpr");
	ParseAddExpr ();
	while (TokenType == BitAnd_tok) {
		GetNextToken ();
		ParseAddExpr ();
		AddInstr (BitAnd_instr);
	}
	leave;
}

void proglet_t::ParseBitOrExpr (void) {
	enter ("ParseBitOrExpr");
	ParseBitAndExpr ();
	while (TokenType == BitOr_tok) {
		GetNextToken ();
		ParseBitAndExpr ();
		AddInstr (BitOr_instr);
	}
	leave;
}

void proglet_t::ParseBoolPrimaryExpr (void) {
	enter ("ParseBoolPrimaryExpr");
	ParseArithExpr ();
	// NOT a while statement.  Primary boolean expressions only have one operator.
	if (TokenType == lt_tok || TokenType == le_tok ||
		TokenType == eq_tok || TokenType == ne_tok ||
		TokenType == gt_tok || TokenType == ge_tok
		) {
		TokenType_t op = TokenType;
		
		GetNextToken ();
		ParseArithExpr ();
		switch (op) {
			case lt_tok:	AddInstr (lt_instr);	break;
			case le_tok:	AddInstr (le_instr);	break;
			case eq_tok:	AddInstr (eq_instr);	break;
			case ne_tok:	AddInstr (ne_instr);	break;
			case gt_tok:	AddInstr (gt_instr);	break;
			case ge_tok:	AddInstr (ge_instr);	break;
		}
	}
	leave;
}

void proglet_t::ParseBoolNegExpr (void) {
	bool  negate = false;
	
	enter ("ParseBoolNegExpr");
	if (TokenType == BoolNot_tok) {
		negate = true;
		GetNextToken ();
	}
	
	ParseBoolPrimaryExpr ();
	if (negate) AddInstr (BoolNot_instr);
	leave;
}

void proglet_t::ParseBoolAndExpr (void) {
	enter ("ParseBoolAndExpr");
	ParseBoolNegExpr ();
	while (TokenType == BoolAnd_tok) {
		GetNextToken ();
		ParseBoolNegExpr ();
		AddInstr (BoolAnd_instr);
	}
	leave;
}

void proglet_t::ParseBoolOrExpr (void) {
	enter ("ParseBoolOrExpr");
	ParseBoolAndExpr ();
	while (TokenType == BoolOr_tok) {
		GetNextToken ();
		ParseBoolAndExpr ();
		AddInstr (BoolOr_instr);
	}
	leave;
}

void proglet_t::ParseAssignment (void) {
	token_t		name;
	symbol_t	*sym;
	TokenType_t	op;
	
	enter ("ParseAssignment");
	if (TokenType != ident_tok) error (stop_e, "Name expected in assignment. Found", token);
	strcpy (name, token);
	GetNextToken ();
	if (TokenType != asgn_tok && TokenType != PlusAsgn_tok && TokenType != MinusAsgn_tok) {
		error (stop_e, "'=', '+=' or '-=' expected in assignment.  Found", token);
	}
	op = TokenType;
	GetNextToken ();
	ParseArithExpr ();
	sym = FindSymbol (name);
	if (sym == 0) {
		sym = CreateSymbol (name, variable_e);
	} else {
		if (sym->type != variable_e) error (stop_e, "Attempt to assign to non-variable", name);
	}
	switch (op) {
		case asgn_tok:		AddInstr (asgn_instr,     sym);	break;
		case PlusAsgn_tok:	AddInstr (PlusAsgn_instr, sym);	break;
		case MinusAsgn_tok:	AddInstr (MinusAsgn_instr,sym);	break;
	}	// We know it's one of these three, so there's no need for a 'default:'
	leave;
}

void proglet_t::ParsePrint (void) {
	enter ("ParsePrint");
	GetNextToken ();
	ParseArithExpr ();
	AddInstr (print_instr);
	leave;
}

void proglet_t::ParseExit (void) {
	token_t	label;
	int		LoopIndex;
	
	enter ("ParseExit");
	GetNextToken ();	// Skip 'exit'.
	
	LoopIndex = LoopDepth-1;	// Start looking for the relevant loop here.
	if (TokenType == ident_tok) {
		strcpy (label, token);
		
		while (LoopIndex >= 0 && !equal (label, LoopStack[LoopIndex].name)) {
			--LoopIndex;
		}
		if (LoopIndex < 0) error (stop_e, "No loop called", label);
		GetNextToken ();	// Skip label.
	} else {
		label[0] = 0;
		if (LoopIndex < 0) error (stop_e, "No loop to exit", label);
	}
	// Fetch end-of-loop address from start-of-loop at run-time.
	
	if (TokenType == when_tok) {
		GetNextToken ();	// Skip 'when'
		ParseBoolExpr ();
		AddInstr (when_instr, LoopStack[LoopIndex].StartAddress);
	} else if (TokenType == unless_tok) {
		GetNextToken ();	// Skip 'unless'
		ParseBoolExpr ();
		AddInstr (unless_instr, LoopStack[LoopIndex].StartAddress);
	} else {
		// Unconditional exit.
		AddInstr (exit_instr, LoopStack[LoopIndex].StartAddress);
	}
	leave;
}

void proglet_t::ParseLoop (void) {
	int	patch;
	
	enter ("ParseLoop");
	
	if (LoopDepth >= MaxLoopDepth) error (stop_e, "Exceeded maximum loop-nesting depth.");
	if (TokenType == label_tok) {
		strcpy (LoopStack[LoopDepth].name, token);	// Named loop.
		GetNextToken ();
		if (TokenType != loop_tok) error (stop_e, "'loop' expected after label. Found", token);
	} else {
		LoopStack[LoopDepth].name[0] = 0;			// Anonymous loop.
	}
	LoopStack[LoopDepth].StartAddress = ProgLen;
	++LoopDepth;
	
	GetNextToken ();	// Skip 'loop' token.
	
	AddInstr (loop_instr, -1);
	patch = ProgLen - 1;
	ParseStmtList ();
	if (TokenType != endloop_tok) error (stop_e, "'endloop' expected.  Found", token);
	AddInstr (jump_instr, patch+1);	// At end of loop, jump to start-of-loop.
	prog[patch].address = ProgLen;	// Patch the end-of-loop address.
	GetNextToken ();				// Skip 'endloop' token.
	if (LoopStack[LoopDepth-1].name[0] != 0 && TokenType == ident_tok) {
		// Only check endloop-labels for named loops.
		if (equal (token, LoopStack[LoopDepth].name)) {
			GetNextToken ();
		} else {
			//error (stop_e, "End-of-loop label doesn't match start-of-loop label", LoopStack[LoopDepth].name, token);
			// Could be start of next statement.
			// If we have an end-of-statement marker such as ';', we could restore the error message.
		}
	}
	
	--LoopDepth;
	
	leave;
}

void proglet_t::ParseIf (void) {
	int	patch;
	
	enter ("ParseIf");
	// We have to evaluate the condition first, then test the result.
	GetNextToken ();
	ParseBoolExpr ();
	if (TokenType != then_tok) error (stop_e, "'then' expected.  Found", token);
	AddInstr (if_instr, -1);			// Patch this later.
	patch = ProgLen - 1;				// Remember address to patch.
	GetNextToken ();					// Skip 'then'.
	ParseStmtList ();					// Parse 'then' block.
	if (TokenType == else_tok) {
		AddInstr (jump_instr, -1);		// At end of 'then' block, jump over 'else' block.
		prog[patch].address = ProgLen;	// Patch the 'if' jump address.
		patch = ProgLen - 1;			// Note where to patch the end-of-'then' jump.
		GetNextToken ();				// Skip 'else'
		ParseStmtList ();				// Parse 'else' block.
	}
	prog[patch].address = ProgLen;		// Patches either the 'if' or end-of-'then' jump address.
	if (TokenType != endif_tok) error (stop_e, "'endif' expected.  Found", token);
	GetNextToken ();	// Skip 'endif'.
	leave;
}

void proglet_t::ParseInclude (void) {
	char	filename[_MAX_PATH];
	int		len;
	
	GetNextToken ();
	if (TokenType != ident_tok) error (stop_e, "Filename expected, found", token);
	strncpy (filename, token, MaxTokenLen);
	len = strlen (token);
	GetNextToken ();
	if (TokenType == dot_tok) {
		strncat (&filename[len], token, sizeof (filename) - len);
		len = strlen (filename);
		GetNextToken ();
		if (TokenType != ident_tok) error (stop_e, "File extension expected, found", token);
		strncat (&filename[len], token, sizeof (filename) - len);
	} else {
		// Add default file extension?
	}
	if (ParseFile (filename) != WantMore_e) error (stop_e, "Can't cope with end of included file.");
	GetNextToken ();
}

bool proglet_t::ParseStatement (void) {
	bool success = true;
	
	enter ("ParseStatement");
	switch (TokenType) {
		case if_tok:		ParseIf ();			break;
		case label_tok:		// Fall through to loop_tok.
		case loop_tok:		ParseLoop ();		break;
		case exit_tok:		ParseExit ();		break;
		case print_tok:		ParsePrint ();		break;
		case ident_tok:		ParseAssignment ();	break;
		case include_tok:	ParseInclude ();	break;
		case StmtDelim_tok:	/* Null stmt */		break;
							// 'run' is special, so don't include it here.
		default:			success = false;	break;	// Failed to identify statement type.
	}
	
	leave;
	return success;
}

void proglet_t::ParseStmtList (void) {
	bool	InList;
	
	enter ("ParseStmtList");
	do {
		InList = ParseStatement ();
		//if (TokenType == StmtDelim_tok) GetNextToken ();	// Optional StmtDelim.
		if (InList) {										// Compulsory StmtDelim.
			if (TokenType == StmtDelim_tok) {
				GetNextToken ();
			} else {
				error (stop_e, "Statement delimiter expected.  Found", token);
			}
		}
	} while (InList);
	leave;
}

// Run-time support. -----------------------------------------------------------

bool proglet_t::dump (program_t *prog, int ProgLen) {
	bool	success = true;
	
	for (int pc = 0 ; pc < ProgLen && success ; ++pc) {
		printf ("%3d: ", pc);
		switch (prog[pc].instr) {
			case PushNum_instr:	++pc; printf ("push %g\n", prog[pc].num);			break;
			case PushSym_instr:	++pc; printf ("push '%s'\n", prog[pc].sym->name);	break;
				
				// Plain arithmetic operators.
			case UnaryMinus_instr:			printf ("negate\n");	break;
			case BitNot_instr:				printf ("~\n");			break;
			case mul_instr:					printf ("*\n");			break;
			case add_instr:					printf ("+\n");			break;
			case BitAnd_instr:				printf ("&\n");			break;
			case BitOr_instr:				printf ("|\n");			break;
			case pow_instr:					printf ("^\n");			break;
			case mod_instr:					printf ("mod\n");		break;
			case div_instr:					printf ("/\n");			break;
			case sub_instr:					printf ("-\n");			break;
			case rem_instr:					printf ("rem\n");		break;
			case Lshift_instr:				printf ("<<\n");		break;
			case Rshift_instr:				printf (">>\n");		break;
				// Boolean operations.
			case BoolOr_instr:				printf ("||\n");		break;
			case BoolAnd_instr:				printf ("&&\n");		break;
			case eq_instr:					printf ("==\n");		break;
			case ne_instr:					printf ("!=\n");		break;
			case lt_instr:					printf ("<\n");			break;
			case le_instr:					printf ("<=\n");		break;
			case gt_instr:					printf (">\n");			break;
			case ge_instr:					printf (">=\n");		break;
				// Arithmetic functions.
			case rand_instr:				printf ("rand\n");		break;
			case abs_instr:					printf ("abs\n");		break;
			case sin_instr:					printf ("sin\n");		break;
			case cos_instr:					printf ("cos\n");		break;
			case tan_instr:					printf ("tan\n");		break;
			case asin_instr:				printf ("asin\n");		break;
			case acos_instr:				printf ("acos\n");		break;
			case atan_instr:				printf ("atan\n");		break;
			case atan2_instr:				printf ("atan2\n");		break;
				// Statements.
			case print_instr:				printf ("print\n");		break;
			case exit_instr:		++pc;	printf ("exit (%d)\n",				prog[pc].address);		break;
			case when_instr:		++pc;	printf ("exit when (%d)\n",			prog[pc].address);		break;
			case unless_instr:		++pc;	printf ("exit unless (%d)\n",		prog[pc].address);		break;
			case loop_instr:		++pc;	printf ("loop (%d)\n",				prog[pc].address);		break;
			case if_instr:			++pc;	printf ("if (else %d)\n",			prog[pc].address);		break;
			case jump_instr:		++pc;	printf ("jump %d\n",				prog[pc].address);		break;
			case asgn_instr:		++pc;	printf ("assign to '%s'\n",			prog[pc].sym->name);	break;
			case PlusAsgn_instr:	++pc;	printf ("add & assign to '%s'\n",	prog[pc].sym->name);	break;
			case MinusAsgn_instr:	++pc;	printf ("sub & assign to '%s'\n",	prog[pc].sym->name);	break;
			default:
				printf ("Unknown instruction encountered in dump.");
				success = false;
				break;
		}
	}
	return success;
}

void proglet_t::push (value_t v) {
	if (StackDepth < MaxStackDepth) {
		stack[StackDepth] = v;
		++StackDepth;
	} else {
		error (stop_e, "stack overflow");
	}
}

proglet_t::value_t proglet_t::pop (void) {
	if (StackDepth < 1) error (stop_e, "stack underflow");
	--StackDepth;
	return stack[StackDepth];
}

void proglet_t::CheckStackDepth (char *OpName) {
	if (StackDepth > 1) error (stop_e, "Final stack too deep in", OpName);
	if (StackDepth < 1) error (stop_e, "No final value on stack for", OpName);
}

int SigCode, SubCode;				// Global variable for passing back error info from handler() to run().
void (*OldArithErrHandler)(int);	// Pointer to old handler.  Restore after run().
void ArithErrHandler (int sig, int sub) {
	SigCode = sig;
	SubCode = sub;	// Could choose to ignore FPE_UNDERFLOW here.
}

// Perform as many checks as possible when parsing
// so that we can avoid run-time overheads.
bool proglet_t::run (program_t *prog, int ProgLen) {
	bool	success = true;
	value_t	a, b;
	
	SigCode = 0;	// To catch errors that raise signals.
	errno = 0;		// To catch errors that don't raise signals.
	OldArithErrHandler = signal (SIGFPE, (void (*)(int))ArithErrHandler);
	
	for (int pc = 0 ; pc < ProgLen && success ; ++pc) {
		// Where instructions have an operand, increment the program counter to point to it.
		switch (prog[pc].instr) {
			case PushNum_instr:		++pc;	push (prog[pc].num);				break;
			case PushSym_instr:		++pc;	push (prog[pc].sym->value);			break;
				
				// Plain arithmetic operators.
			case UnaryMinus_instr:			push (-     pop ());				break;
			case BitNot_instr:				push (~(int)pop ());				break;
				// Commutative operators.
			case mul_instr:					push (pop () * pop ());				break;
			case add_instr:					push (pop () + pop ());				break;
			case BitAnd_instr:				push ((int)pop () & (int)pop ());	break;
			case BitOr_instr:				push ((int)pop () | (int)pop ());	break;
				// Non-commutative operators.
			case pow_instr:					b = pop (); a = pop (); push (pow  (a, b));			break;
			case mod_instr:					b = pop (); a = pop (); push (fmod (a, b));			break;
			case div_instr:					b = pop (); a = pop (); push (a / b);				break;
			case sub_instr:					b = pop (); a = pop (); push (a - b);				break;
			case rem_instr:					b = pop (); a = pop (); push ((int)a %  (int)b);	break;
			case Lshift_instr:				b = pop (); a = pop (); push ((int)a << (int)b);	break;
			case Rshift_instr:				b = pop (); a = pop (); push ((int)a >> (int)b);	break;
				
				// Boolean operations.
			case BoolOr_instr:				push (pop () || pop ());				break;
			case BoolAnd_instr:				push (pop () && pop ());				break;
			case eq_instr:					push (pop () == pop ());				break;
			case ne_instr:					push (pop () != pop ());				break;
			case lt_instr:					b = pop (); a = pop (); push (a <  b);	break;
			case le_instr:					b = pop (); a = pop (); push (a <= b);	break;
			case gt_instr:					b = pop (); a = pop (); push (a >  b);	break;
			case ge_instr:					b = pop (); a = pop (); push (a >= b);	break;
				
				// Arithmetic functions.
			case rand_instr:				push (rand ());			break;
			case abs_instr:					push (fabs (pop ()));	break;
			case sin_instr:					push (sin  (pop ()));	break;
			case cos_instr:					push (cos  (pop ()));	break;
			case tan_instr:					push (tan  (pop ()));	break;
			case asin_instr:				push (asin (pop ()));	break;
			case acos_instr:				push (acos (pop ()));	break;
			case atan_instr:				push (atan (pop ()));	break;
			case atan2_instr:
				b = pop ();
				a = pop ();
				push (atan2 (a, b));
				break;
				
				// Statements.
			case loop_instr:		++pc;																break;
				// Always subtract one from the desired jump address because pc is
				// always incremented at the end of the loop.
			case exit_instr:		++pc;	pc = prog[prog[pc].address + 1].address - 1;				break;
			case when_instr:		++pc;	if ( pop ()) pc = prog[prog[pc].address + 1].address - 1;	break;
			case unless_instr:		++pc;	if (!pop ()) pc = prog[prog[pc].address + 1].address - 1;	break;
			case if_instr:			++pc;	if (!pop ()) pc = prog[pc].address - 1;						break;
			case jump_instr:		++pc;	             pc = prog[pc].address - 1;						break;
			case print_instr:
				CheckStackDepth ("print");
				printf ("    %g\n", pop ());															break;
			case asgn_instr:				CheckStackDepth ("=");  ++pc; prog[pc].sym->value  = pop();	break;
			case PlusAsgn_instr:			CheckStackDepth ("+="); ++pc; prog[pc].sym->value += pop();	break;
			case MinusAsgn_instr:			CheckStackDepth ("-="); ++pc; prog[pc].sym->value -= pop();	break;
			default:
				printf ("Unknown instruction encountered in run.");
				success = false;
				break;
		}
		// One of these ought to catch most errors.
		if (errno != 0) {
			success = false;
			perror ("eval");
		}
		if (SigCode != 0) {
			success = false;
			switch (SigCode) {
				// VC++ doesn't seem to allow these error conditions to be distinguished.
				//case FPE_INTOVFLOW:  printf ("Interrupt on overflow.\n");         break;   // int
				//case FPE_INTDIV0:    printf ("Integer divide by zero.\n");        break;   // int
				//case FPE_INVALID:    printf ("Invalid operation.\n");             break;
				//case FPE_ZERODIVIDE: printf ("Floating point divide by zero.\n"); break;
				//case FPE_OVERFLOW:   printf ("Numeric overflow.\n");              break;
				//case FPE_UNDERFLOW:  printf ("Numeric underflow.\n");             break;
				//case FPE_INEXACT:    printf ("Precision error.\n");               break;
				//case FPE_EXPLICITGEN:printf ("Explicit SIGFPE error.\n");         break;
				//case FPE_STACKFAULT: printf ("Floating point stack overflow.\n"); break;
			case SIGFPE:	printf ("Floating point error.\n"); break;
			default:		printf ("Unrecognised signal code %d.\n", SigCode); break;
			}
		}
	}
	signal (SIGFPE, OldArithErrHandler);
	return success;
}

// Public interface. -----------------------------------------------------------

void proglet_t::reinit (void) {
	InitSymbolTable ();
	ProgLen = 0;
}

proglet_t::proglet_t () {
	prog = new program_t [MaxProgLen];
	reinit ();
}

proglet_t::~proglet_t () {
	delete[] prog;
}

proglet_t::ParseStatus_t proglet_t::ParseFile (char *filename, int *MaxArgs, value_t *args) {
	ParseStatus_t	status = SyntaxError_e;
	FILE			*f;
	
	enter ("ParseFile");
	if (equal ("-", filename)) {
		f = stdin;
	} else {
		f = fopen (filename, "r");
	}
	
	if (f == 0) {
		printf ("Couldn't open '%s'.\n", filename);
	} else {
		char	*block;
		int		BlockSize = 1000,
				size;
		char	*TmpStatement;
		int		TmpStmtLen,
				TmpStmtIndex;
				DeclareTmpIndent;
		
		do {
			block = new char[BlockSize+1];
			if (block == 0) {
				printf ("Insufficient memory to read %d bytes of '%s'.", BlockSize, filename);
				return SyntaxError_e;
			}
			size = fread (block, 1, BlockSize, f);
			if (size == BlockSize) {
				delete[] block;			// Throw away this chunk and try again ...
				block = 0;
				BlockSize *= 2;			// ... with a buffer twice as large.
				fseek (f, 0, SEEK_SET);	// Reposition at start of file.
			}
		} while (block == 0);
		block[size] = 0;
		fclose (f);
		
		// Store current source block info.
		TmpStatement = statement;
		TmpStmtLen   = StmtLen;
		TmpStmtIndex = StmtIndex;
		SaveIndent;
		InitLexer (block);
		try {
			ParseStmtList ();
			if (TokenType == run_tok) {
				int	NumArgs,
					ActualProgLen;
				
				GetNextToken ();
				ActualProgLen = ProgLen;
				NumArgs = ParseArithExprList (null_tok);
				if (NumArgs > *MaxArgs) error (stop_e, "Too many arguments give for 'run'");
				// It's probably safe to evaluate the 'run' arguments now.
				//            dump (&prog[ActualProgLen], ProgLen - ActualProgLen);
				run  (&prog[ActualProgLen], ProgLen - ActualProgLen);
				ProgLen = ActualProgLen;
				*MaxArgs = NumArgs;
				while (NumArgs > 0) {
					--NumArgs;
					args[NumArgs] = pop ();
				}
				status = run_e;
			} else {
				status = WantMore_e;
			}
		}
		catch (severity_t severity) {
			// status = SyntaxError_e; // Probably.
		};
		// Restore source block info.
		statement = TmpStatement;
		StmtLen   = TmpStmtLen;
		StmtIndex = TmpStmtIndex;
		RestoreIndent;
	}
	leave;
	return status;
}

proglet_t::ParseStatus_t proglet_t::ParseBlock (char *line, int *MaxArgs, value_t *args) {
	ParseStatus_t	status;
	
	enter ("ParseBlock");
	try {
		InitLexer (line);
		StackDepth = 0;
		LoopDepth = 0;
		
		InitDebug;
		ParseStmtList ();
		if (TokenType == run_tok) {
			int	NumArgs,
				ActualProgLen;
			
			GetNextToken ();
			ActualProgLen = ProgLen;
			NumArgs = ParseArithExprList (null_tok);
			if (NumArgs > *MaxArgs) error (stop_e, "Too many arguments give for 'run'");
			// It's probably safe to evaluate the 'run' arguments now.
			//         dump (&prog[ActualProgLen], ProgLen - ActualProgLen);
			run  (&prog[ActualProgLen], ProgLen - ActualProgLen);
			ProgLen = ActualProgLen;
			*MaxArgs = NumArgs;
			while (NumArgs > 0) {
				--NumArgs;
				args[NumArgs] = pop ();
			}
			status = run_e;
		} else {
			status = WantMore_e;
		}
	}
	catch (severity_t severity) {
		status = SyntaxError_e; // Probably.
	};
	
	leave;
	return status;
}

bool proglet_t::dump (void) {
	return dump (prog, ProgLen);
}

bool proglet_t::run (value_t t) {	// Don't call the parameter 'time' or...?
	symbol_t *sym = FindSymbol ("time");
	
	if (sym == 0) error (stop_e, "Programming error.  'Time' symbol not found.");
	sym->value = t;					// Assumes some sort of compatibility between float and value_t.
	
	return run(prog, ProgLen);
}