rem ==================================================================
rem A BASIC compiler, targeting the NaaLaa Virtual Machine (NVM).
rem
rem This is very experimental stuff.
rem
rem 2012-04-25
rem   * Parser for numeric expressions.
rem
rem 2012-04-27
rem   * Floating point constants.
rem   * Absolute values of numeric expressions in the form |<expr>|
rem     rather than abs(<expr>). That's fun, right?
rem   * Standard math functions.
rem   * String constants.
rem   * String expressions.
rem 
rem 2012-04-28
rem   * Boolean expressions.
rem   * Selection with If-statements.
rem
rem 2012-04-29
rem   * Line endings and counting.
rem   * Keyboard input with INPUT <var> [, <var>[, ...]]
rem   * Disabled parenthesis for string expressions as it complicates
rem     things too much when predicting the type of an arbitrary
rem     expression.
rem   * Output with PRINT <expr> [, <expr>[, ...]] .
rem   * Comments with REM or ' character.
rem 
rem 2012-04-30
rem   * While/Wend
rem   * Do/Loop
rem   * Do Until/Loop
rem   * Do While/Loop
rem   * Do/Loop Until
rem   * Do/Loop While
rem
rem By Marcus.
rem ==================================================================

rem NVM contains all available instructions.
import "NVM.lib"

rem System mostly contains crap, but there's also a bunch of system
rem call constants.
import "System.lib"

constant:
	IN_FILE 0
	OUT_FILE	1

rem Types.
constant:
	TYPE_EOF					0;		rem End of file.
	TYPE_EOL					1;		rem End of line.
	TYPE_CHAR				2; 	rem Character.
	TYPE_CONST_INT			3;		rem Integer constant.
	TYPE_CONST_FLOAT		4;		rem Floating point constant.
	TYPE_CONST_STRING		5;		rem String constant.
	TYPE_GLOBAL_NUMBER	6;		rem Global number.
	TYPE_GLOBAL_STRING	7;		rem Global string.
	TYPE_LOCAL_NUMBER		8;		rem Local number.
	TYPE_LOCAL_STRING		9;		rem Local string.
	TYPE_RESERVED			10;	rem Reserved.

constant:
	BRANCH_UNDEF	0
	BRANCH_ENDIF	1
	BRANCH_WEND		2
	BRANCH_LOOP		3
	BRANCH_LOOP_FROM_CRAP_DO 2

rem Reserved words, indexes.
constant:
	rem Boolean.
	RES_AND		0
	RES_OR		1
	RES_NOT		2

	rem Math functions.
	RES_COS		3
	RES_SIN		4
	RES_TAN		5
	RES_ACOS		6
	RES_ASIN		7
	RES_ATAN		8
	RES_SQR		9
	RES_ABS		10

	rem If.
	RES_IF		11
	RES_THEN		12
	RES_ELSE		13
	RES_END		14

	rem Output and input.
	RES_PRINT	15
	RES_INPUT	16

	rem Loops.
	RES_WHILE	17
	RES_WEND		18
	RES_DO		19
	RES_LOOP		20
	RES_UNTIL	21
	RES_FOR		22
	RES_TO		23
	RES_STEP		24
	RES_NEXT		25

	rem Comment.
	RES_REM		26
	

visible:
	rem Last read character in IN_FILE.
	vFileChar = 0

	rem Reserved words.
	vReserved$[27]

	rem Instructions.
	vInstructions[100][5]
	vInstructionCount = 1; rem First instruction is ALLOC_GLOBAL

	rem Global variables.
	vGlobal?[100]
	vGlobalCount = 1

	rem Subroutines.
	vSubroutines?[100]
	vSubroutineCount = 0
	vCurrentSubroutine = -1

	rem Local variables.
	vLocal?[100]
	vLocalCount = 1; rem Index 0 is reserved for args array.

	rem Float constants.
	vFloatConsts#[100]
	vFloatConstCount = 0

	rem String constants.
	vStringConsts$[100]
	vStringConstCount = 0

	rem Branches.
	vBranches[100]
	vBranchCount = 0
	vBranchLooks[100][2]
	vBranchLookCount = 0
	vIfCount = 0
	vEndIfs[100]
	vBreakLevel = 0

	rem Current thing.
	vThing?

	rem Line count, for error messages and runtime errors.
	vLineCount = 1

hidden:

rem Set reserved words.

rem Boolean.
vReserved[RES_AND] = "and"
vReserved[RES_OR] = "or"
vReserved[RES_NOT] = "not"

rem Maths.
vReserved[RES_COS] = "cos"
vReserved[RES_SIN] = "sin"
vReserved[RES_TAN] = "tan"
vReserved[RES_ACOS] = "arccos"
vReserved[RES_ASIN] = "arcsin"
vReserved[RES_ATAN] = "arctan"
vReserved[RES_SQR] = "sqr"
vReserved[RES_ABS] = "abs"

rem Selection.
vReserved[RES_IF] = "if"
vReserved[RES_THEN] = "then"
vReserved[RES_ELSE] = "else"
vReserved[RES_END] = "end"

rem Output and input.
vReserved[RES_INPUT] = "input"
vReserved[RES_PRINT] = "print"

rem Loops.
vReserved[RES_WHILE] = "while"
vReserved[RES_WEND] = "wend"
vReserved[RES_DO] = "do"
vReserved[RES_LOOP] = "loop"
vReserved[RES_UNTIL] = "until"
vReserved[RES_FOR] = "for"
vReserved[RES_TO] = "to"
vReserved[RES_STEP] = "step"
vReserved[RES_NEXT] = "next"

rem Comment.
vReserved[RES_REM] = "rem"

rem Open input file.
if sizeof(args) < 2
	open file IN_FILE, "test.bas", true
else
	open file IN_FILE, args[1], true
endif

if not file(0) then proc Error "No input"

rem Some settings.

rem Floating point output format, no decimal values.
proc AddInstruction NVM_MOVE_RC, 0, 0, 0
proc AddInstruction NVM_MOVE_RC, 1, 0, 0
proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_SET_DECIMALS, 0

do
	vThing? = GetNext()

	rem End of file.
	if vThing.type = TYPE_EOF then break

	if vThing.type = TYPE_GLOBAL_NUMBER
		rem Assignment to global numeric variable.
		proc GlobalNumericAssignment

	elseif vThing.type = TYPE_GLOBAL_STRING
		rem Assignment to global string variable.
		proc GlobalStringAssignment

	elseif vThing.type = TYPE_RESERVED
		rem If.
		if vThing.word = RES_IF
			vThing = GetNext()
			proc If

		rem End, end if.
		elseif vThing.word = RES_END
			vThing = GetNext()
			if vThing.type = TYPE_RESERVED and vThing.word = RES_IF
				rem End if.
				vThing = GetNext()
				proc EndIf
			else
				rem End program.
				rem Free allocated memory and terminate.
				proc AddInstruction NVM_FREE_GLOBAL, 0, 0, 0
				proc AddInstruction NVM_EXIT, 0, 0, 0
			endif			

		rem Else, else if.
		elseif vThing.word = RES_ELSE
			vThing = GetNext()
			if vThing.type = TYPE_RESERVED and vThing.word = RES_IF
				vThing = GetNext()
				proc ElseIf
			else
				proc Else
			endif

		rem While <expr>.
		elseif vThing.word = RES_WHILE
			vThing = GetNext()
			proc While

		rem Wend.
		elseif vThing.word = RES_WEND
			vThing = GetNext()
			proc Wend

		rem Do.
		elseif vThing.word = RES_DO
			vThing = GetNext()
			if vThing.type = TYPE_RESERVED
				rem Do While <expr>.
				if vThing.word = RES_WHILE
					vThing = GetNext()
					proc DoWhile

				rem Do Until <expr>.
				elseif vThing.word = RES_UNTIL
					vThing = GetNext()
					proc DoUntil
				endif
			else
				proc Do
			endif

		rem Loop.
		elseif vThing.word = RES_LOOP
			vThing = GetNext()
			if vThing.type = TYPE_RESERVED
				rem Loop While <expr>			
				if vThing.word = RES_WHILE
					vThing = GetNext()
					proc LoopWhile
				
				rem Loop Until <expr>
				elseif vThing.word = RES_UNTIL
					vThing = GetNext()
					proc LoopUntil
				endif
			else
				proc Loop
			endif

		rem Input.
		elseif vThing.word = RES_INPUT
			vThing = GetNext()
			proc Input

		rem Output.
		elseif vThing.word = RES_PRINT
			vThing = GetNext()
			proc Print
		
		rem Comment.
		elseif vThing.word = RES_REM
			vThing = GetNext()
			proc Remark
		else
			proc Error "Syntax error"
		endif
	endif

	if not (vThing.type = TYPE_EOL or vThing.type = TYPE_EOF)
		proc Error "Expected end of line"
	endif
loop

rem Output an error if we're still expecting something.
if vBranchLookCount > 0
	proc Error "Unexpected end of file"
endif

rem Bind branches.
for i = 0 to vInstructionCount - 1
	cmd = vInstructions[i][0]
	if cmd = NVM_JMP or cmd = NVM_JFL or cmd = NVM_JTR
		vInstructions[i][2] = vBranches[vInstructions[i][2]] - 1
	endif
next

rem Close input file..
free file IN_FILE

rem Make a system call to wait for any key to be pressed.
proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_WAIT_KEY, 0

rem Free allocated memory and terminate.
proc AddInstruction NVM_FREE_GLOBAL, 0, 0, 0
proc AddInstruction NVM_EXIT, 0, 0, 0

rem Create bytecode and run it.
if CreateBinary("temp.nvm")
	wln "Press any key to run program ..."
	wait keydown
	set color 0, 0, 0
	cls
	set color 255, 255, 255
	run "temp.nvm"
else
	proc Error "Could not create binary"
endif

rem ==================================================================
rem Create binary nvm file.
rem ==================================================================
function CreateBinary(name$)
	create file OUT_FILE, name, true
	if file(OUT_FILE)
		rem Float constants.
		write32 OUT_FILE, vFloatConstCount
		for i = 0 to vFloatConstCount - 1
			writef OUT_FILE, vFloatConsts[i]
		next

		rem String constants.
		write32 OUT_FILE, vStringConstCount
		for i = 0 to vStringConstCount - 1
			proc WriteStringConstant vStringConsts[i]
		next

		rem Number of instructions.
		write32 OUT_FILE, vInstructionCount

		rem Modify first instruction, allocate memory for globals.
		proc SetInstruction 0, NVM_ALLOC_GLOBAL, 0, vGlobalCount, 0

		rem Write instructions.
		for i = 0 to vInstructionCount - 1
			for j = 0 to 4
				write32 OUT_FILE, vInstructions[i][j]
			next
		next
		free file OUT_FILE
	else
		return false
	endif
endproc

rem ==================================================================
rem Assignment to global numeric variable.
rem ==================================================================
procedure GlobalNumericAssignment()
	index = vThing.index
	vThing = GetNext()
	proc Match "="
	proc Expression
	proc AddInstruction NVM_MOVEF_GR, index, 0, 0
endproc

rem ==================================================================
rem Assignment to global string variable.
rem ==================================================================
procedure GlobalStringAssignment()
	index = vThing.index
	vThing = GetNext()
	proc Match "="
	proc StringExpression
	proc AddInstruction NVM_STR_TO_G, index, 0, 0
endproc

rem ==================================================================
rem Load numeric expression into register 0.
rem ==================================================================
procedure Expression()
	proc Term
	while vThing.type = TYPE_CHAR and (vThing.char$ = "+" or vThing.char$ = "-")
		proc AddInstruction NVM_PUSH_R, 0, 0, 0
		if vThing.char$ = "+"
			vThing = GetNext()
			proc Add
		else
			vThing = GetNext()
			proc Sub
		endif
	wend
endproc

rem ==================================================================
rem Get term.
rem ==================================================================
procedure Term()
	proc SignedFactor
	while vThing.type = TYPE_CHAR and (vThing.char$ = "*" or vThing.char$ = "/" or vThing.char$ = "%")
		proc AddInstruction NVM_PUSH_R, 0, 0, 0
		if vThing.char$ = "*"
			vThing = GetNext()
			proc Multiply
		elseif vThing.char$ = "/"
			vThing = GetNext()
			proc Divide
		else
			proc Error "Not implemented"
		endif
	wend
endproc

rem ==================================================================
rem Load factor into register 0.
rem ==================================================================
procedure Factor()
	if vThing.type = TYPE_CHAR and vThing.char$ = "("
		vThing = GetNext()
		proc Expression
		proc Match ")"
	elseif vThing.type = TYPE_CHAR and vThing.char$ = "|"
		rem Absolute value in the form |<expr>|
		vThing = GetNext()
		proc Expression
		proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_FLOAT_ABS, 0
		proc Match "|"
	elseif vThing.type = TYPE_GLOBAL_NUMBER
		proc AddInstruction NVM_MOVEF_RG, 0, vThing.index, 0
		vThing = GetNext()
	elseif vThing.type = TYPE_CONST_INT
		proc AddInstruction NVM_MOVE_RC, 0, vThing.integer, 0
		proc AddInstruction NVM_ITOF_R, 0, 0, 0
		vThing = GetNext()
	elseif vThing.type = TYPE_CONST_FLOAT
		proc AddInstruction NVM_MOVEGF_R, 0, vThing.index, 0	
		vThing = GetNext()
	elseif NumericSystemCall()
		rem Mathematical system function.
		rem vThing = GetNext()
	else
		proc Error "Expected integer expression"
	endif
endproc

rem ==================================================================
rem If current thing is a numeric system call, add it and return true.
rem ==================================================================
function NumericSystemCall()
	if vThing.type = TYPE_RESERVED
		rem All the system math functions operates on the value of
		rem register 0 and overwrite it with the result.
		if vThing.word = RES_COS
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_COS, 0
		elseif vThing.word = RES_SIN
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_SIN, 0
		elseif vThing.word = RES_TAN
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_TAN, 0
		elseif vThing.word = RES_ACOS
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_ACOS, 0
		elseif vThing.word = RES_ASIN
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_ASIN, 0
		elseif vThing.word = RES_ATAN
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_ATAN, 0
		elseif vThing.word = RES_SQR
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_SQR, 0
		elseif vThing.word = RES_ABS
			vThing = GetNext()
			proc Match "("
			proc Expression
			proc Match ")"
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_FLOAT_ABS, 0
		endif
	else
		return false
	endif
endfunc

rem ==================================================================
rem Get signed factor.
rem ==================================================================
procedure SignedFactor()
	if vThing.type = TYPE_CHAR and (vThing.char$ = "+" or vThing.char$ = "-")
		if vThing.char$ = "+"
			vThing = GetNext()
		else
			vThing = GetNext()
			proc Factor
			proc AddInstruction NVM_NEGF_R, 0, 0, 0
		endif
	else
		proc Factor
	endif
endproc

rem ==================================================================
rem Add operation.
rem ==================================================================
procedure Add()
	proc Term
	proc AddInstruction NVM_ADDF_RS, 0, 0, 0
endproc

rem ==================================================================
rem Sub operation.
rem ==================================================================
procedure Sub()
	proc Term
	proc AddInstruction NVM_SUBF_RS, 0, 0, 0
	proc AddInstruction NVM_NEGF_R, 0, 0, 0
endproc

rem ==================================================================
rem Multiply operation.
rem ==================================================================
procedure Multiply()
	proc SignedFactor
	proc AddInstruction NVM_MULF_RS, 0, 0, 0
endproc

rem ==================================================================
rem Divide operation.
rem ==================================================================
procedure Divide()
	proc SignedFactor
	proc AddInstruction NVM_POP_R, 1, 0, 0
	proc AddInstruction NVM_DIVF_RR, 1, 0 ,0
	proc AddInstruction NVM_MOVE_RR, 0, 1, 0
endproc

rem ==================================================================
rem Boolean expression.
rem ==================================================================
procedure BooleanExpression()
	proc SingleBoolean

	while vThing.type = TYPE_RESERVED and (vThing.word = RES_AND or vThing.word = RES_OR)
		if vThing.word = RES_AND
			rem And.
			vThing = GetNext()

			rem Short circuit if current expression is false.
			shortJump = vBranchCount
			vBranchCount = vBranchCount + 1
			proc AddInstruction NVM_JFL, 0, shortJump, 0

			rem Push current to stack and get next expression.
			rem NVM_AND_SRR pops the old expression from the stack,
			rem makes an "or" with the expression in register 0 and
			rem also puts the result in register 0.
			proc AddInstruction NVM_PUSH_R, 0, 0, 0
			proc SingleBoolean
			proc AddInstruction NVM_AND_SRR, 0, 0, 0
			
			rem This is where we end up on the short circuit.
			vBranches[shortJump] = vInstructionCount

		else
			rem Or.
			vThing = GetNext()

			rem Short circuit if current expression is true.
			shortJump = vBranchCount
			vBranchCount = vBranchCount + 1
			proc AddInstruction NVM_JTR, 0, shortJump, 0

			proc AddInstruction NVM_PUSH_R, 0, 0, 0
			proc SingleBoolean
			proc AddInstruction NVM_OR_SRR, 0, 0, 0

			vBranches[shortJump] = vInstructionCount
		endif
	wend
endproc

rem ==================================================================
rem Single boolean.
rem ==================================================================
procedure SingleBoolean()
	if vThing.type = TYPE_RESERVED and vThing.word = RES_NOT
		vThing = GetNext()
		proc BooleanExpression
		proc AddInstruction NVM_NOT_R, 0, 0, 0
	elseif vThing.type = TYPE_CHAR and vThing.char$ = "("
		vThing = GetNext()
		proc BooleanExpression
		proc Match ")"
	else
		proc BooleanTerm
	endif
endproc

rem ==================================================================
rem Boolean term.
rem ==================================================================
procedure BooleanTerm()
	if vThing.type = TYPE_CONST_STRING or vThing.type = TYPE_GLOBAL_STRING
		rem String expression.

		proc StringExpression

		if vThing.type = TYPE_CHAR and (vThing.char$ = "<" or vThing.char$ = "=")
			proc AddInstruction NVM_PUSH_R, 0, 0, 0
			if vThing.char$ = "<"
				vThing = GetNext()
				if vThing.type = TYPE_CHAR and vThing.char$ = ">"
					vThing = GetNext()
					proc StringNotEqual
				else
					proc Error "Not a valid string operator"
				endif
			elseif vThing.char$ = "="
				vThing = GetNext()
				proc StringEqual
			endif
		else
			rem Strings require.
			proc Error "Not a boolean expression"
		endif
		
	else
		rem Numeric expression.
		proc Expression

		if vThing.type = TYPE_CHAR and (vThing.char$ = "<" or vThing.char$ = ">" or vThing.char$ = "=")
			proc AddInstruction NVM_PUSH_R, 0, 0, 0
			if vThing.char$ = ">"
				vThing = GetNext()
				if vThing.type = TYPE_CHAR and vThing.char$ = "="
					vThing = GetNext()
					proc GreaterThanOrEqual
				else
					proc GreaterThan
				endif
			elseif vThing.char$ = "<"
				vThing = GetNext()
				if vThing.type = TYPE_CHAR and vThing.char$ = "="
					vThing = GetNext()
					proc LessThanOrEqual
				elseif vThing.type = TYPE_CHAR and vThing.char$ = ">"
					vThing = GetNext()
					proc NotEqual
				else
					proc LessThan				
				endif
			elseif vThing.char$ = "="
				vThing = GetNext()
				proc Equal
			endif
		endif
	endif
endproc

rem ==================================================================
rem Greater than or equal, boolean operator.
rem ==================================================================
procedure GreaterThanOrEqual()
	proc Expression
	proc AddInstruction NVM_SGQ_SRR, 0, 0, 0
endproc

rem ==================================================================
rem Greater than, boolean operator.
rem ==================================================================
procedure GreaterThan()
	proc Expression
	proc AddInstruction NVM_SGE_SRR, 0, 0, 0
endproc

rem ==================================================================
rem Less than or equal, boolean operator.
rem ==================================================================
procedure LessThanOrEqual()
	proc Expression
	proc AddInstruction NVM_SLQ_SRR, 0, 0, 0
endproc

rem ==================================================================
rem Less than, boolean operator.
rem ==================================================================
procedure LessThan()
	proc Expression
	proc AddInstruction NVM_SLE_SRR, 0, 0, 0
endproc

rem ==================================================================
rem Not equal, boolean operator.
rem ==================================================================
procedure NotEqual()
	proc Expression
	proc AddInstruction NVM_SNE_SRR, 0, 0, 0
endproc

rem ==================================================================
rem Equal, boolean operator.
rem ==================================================================
procedure Equal()
	proc Expression
	proc AddInstruction NVM_SEQ_SRR, 0, 0, 0
endproc


rem ==================================================================
rem String not equal, boolean operator.
rem ==================================================================
procedure StringNotEqual()
	proc StringExpression
	proc AddInstruction NVM_MOVE_STR_RR, 2, 0, 0
	proc AddInstruction NVM_POP_STR_R, 1, 0, 0
	proc AddInstruction NVM_STR_NE_RR, 1, 2, 0
	proc AddInstruction NVM_DEL_STR_R, 1, 0, 0
	proc AddInstruction NVM_DEL_STR_R, 2, 0, 0
endproc

rem ==================================================================
rem String equal, boolean operator.
rem ==================================================================
procedure StringEqual()
	proc StringExpression
	proc AddInstruction NVM_MOVE_STR_RR, 2, 0, 0
	proc AddInstruction NVM_POP_STR_R, 1, 0, 0
	proc AddInstruction NVM_STR_EQ_RR, 1, 2, 0
	proc AddInstruction NVM_DEL_STR_R, 1, 0, 0
	proc AddInstruction NVM_DEL_STR_R, 2, 0, 0
endproc

rem ==================================================================
rem Load string expression into register 0.
rem ==================================================================
procedure StringExpression()
	rem Clear/allocate string in register 0.
	proc AddInstruction NVM_DEL_STR_R, 0 ,0, 0

	rem Get String.
	proc StringFactor

	while vThing.type = TYPE_CHAR and (vThing.char$ = "+" or vThing.char$ = "-")
		rem Push current string to stack.
		proc AddInstruction NVM_PUSH_R, 0, 0 ,0

		if vThing.char$ = "+"
			rem Addition.
			vThing = GetNext()
			proc StringAdd	
		else
			rem Subtraction. This is a naalaa instruction. It removes all
			rem ocurrences of one string from another.
			vThing = GetNext()
			proc StringSub
		endif
	wend
endproc

rem ==================================================================
rem String factor.
rem ==================================================================
procedure StringFactor()
	rem if vThing.type = TYPE_CHAR
		rem Parenthesis?
	rem	if vThing.char$ = "("
	rem		vThing = GetNext()
	rem		proc StringExpression
	rem		proc Match ")"
	rem	else
	rem		proc Error "Expected string expression"
	rem	endif
	if vThing.type = TYPE_CONST_STRING
		rem String constant.
		proc AddInstruction NVM_CPY_GSTR, 0, vThing.index, 0
		vThing = GetNext()
	elseif vThing.type = TYPE_GLOBAL_STRING
		rem Global string variable.
		proc AddInstruction NVM_CPY_STR, 0, vThing.index, 0
		vThing = GetNext()
	elseif StringSystemCall()
		rem String system call.
	else
		proc Error "Expected string expression"
	endif
endproc

rem ==================================================================
rem If current thing is a string system call, add it and return true.
rem ==================================================================
function StringSystemCall()
	return false
endfunc

rem ==================================================================
rem String add operation.
rem ==================================================================
procedure StringAdd()
	rem Get new string.
	proc StringFactor

	rem Concatenate: move new string to register 1, pop old
	rem string from stack to register 0, add them and delete
	rem the string in register 1.
	proc AddInstruction NVM_MOVE_STR_RR, 1, 0, 0
	proc AddInstruction NVM_POP_STR_R, 0, 0, 0
	proc AddInstruction NVM_ADD_STR_RR, 0, 1, 0
	proc AddInstruction NVM_DEL_STR_R, 1, 0, 0
endproc

rem ==================================================================
rem String subtract operation.
rem ==================================================================
procedure StringSub()
	rem Get new string.
	proc StringFactor

	rem Subtract: move new string to register 1, pop old
	rem string from stack to register 0, subtract and delete
	rem the string in register 1.
	proc AddInstruction NVM_MOVE_STR_RR, 1, 0, 0
	proc AddInstruction NVM_POP_STR_R, 0, 0, 0
	proc AddInstruction NVM_SUB_STR_RR, 0, 1, 0
	proc AddInstruction NVM_DEL_STR_R, 1, 0, 0
endproc

rem ==================================================================
rem If.
rem ==================================================================
procedure If()
	proc BooleanExpression
	proc OptMatchReserved RES_THEN
	
	proc AddInstruction NVM_JFL, 0, vBranchCount, 0

	vIfCount = vIfCount + 1
	vEndIfs[vIfCount] = 1
	
	proc PushBranch BRANCH_ENDIF
endproc

rem ==================================================================
rem End if.
rem ==================================================================
procedure EndIf()
	for i = 0 to vEndIfs[vIfCount] - 1
		if not PopBranch(BRANCH_ENDIF) then proc Error "Unexpected 'End If'"
	next
	vIfCount = vIfCount - 1
endproc

rem ==================================================================
rem Else.
rem ==================================================================
procedure Else()
	proc AddInstruction NVM_JMP, 0, vBranchCount, 0
	if not PopBranch(BRANCH_ENDIF) then proc Error "Unexpected 'Else'"
	proc PushBranch(BRANCH_ENDIF)
endproc

rem ==================================================================
rem Else if.
rem ==================================================================
procedure ElseIf()
	proc AddInstruction NVM_JMP, 0, vBranchCount, 0

	if not PopBranch(BRANCH_ENDIF) then	proc Error "Unexpected 'Else If'"
	proc PushBranch BRANCH_ENDIF

	proc BooleanExpression
	proc OptMatchReserved RES_THEN
	proc AddInstruction NVM_JFL, 0, vBranchCount, 0

	vEndIfs[vIfCount] = vEndIfs[vIfCount] + 1

	proc PushBranch BRANCH_ENDIF	
endproc

rem ==================================================================
rem While.
rem ==================================================================
procedure While()
	rem Increase jump level for BREAK command.
	vBreakLevel = vBreakLevel + 1

	rem Setup jump for logic evaluation.
	vBranchLooks[vBranchLookCount][0] = vBranchCount
	vBranchLooks[vBranchLookCount][1] = BRANCH_UNDEF
	vBranches[vBranchCount] = vInstructionCount
	vBranchCount = vBranchCount + 1
	vBranchLookCount = vBranchLookCount + 1

	proc BooleanExpression
	rem Jump to end of WEND.
	proc AddInstruction NVM_JFL, 0, vBranchCount, 0
	proc PushBranch BRANCH_WEND
endproc

rem ==================================================================
rem Do.
rem ==================================================================
procedure Do()
	vBreakLevel = vBreakLevel + 1
	vBranchLooks[vBranchLookCount][0] = vBranchCount
	vBranchLooks[vBranchLookCount][1] = BRANCH_LOOP
	vBranches[vBranchCount] = vInstructionCount
	vBranchCount = vBranchCount + 1
	vBranchLookCount = vBranchLookCount + 1
endproc

rem ==================================================================
rem Do while.
rem    Exactly the same as While, but expect loop.
rem ==================================================================
procedure DoWhile()
	rem Increase jump level for BREAK command.
	vBreakLevel = vBreakLevel + 1

	rem Setup jump for logic evaluation.
	vBranchLooks[vBranchLookCount][0] = vBranchCount
	vBranchLooks[vBranchLookCount][1] = BRANCH_UNDEF
	vBranches[vBranchCount] = vInstructionCount
	vBranchCount = vBranchCount + 1
	vBranchLookCount = vBranchLookCount + 1

	proc BooleanExpression
	proc AddInstruction NVM_JFL, 0, vBranchCount, 0
	proc PushBranch BRANCH_LOOP_FROM_CRAP_DO
endproc

rem ==================================================================
rem Do until.
rem    Inverted Do While ...
rem ==================================================================
procedure DoUntil()
	rem Increase jump level for BREAK command.
	vBreakLevel = vBreakLevel + 1

	rem Setup jump for logic evaluation.
	vBranchLooks[vBranchLookCount][0] = vBranchCount
	vBranchLooks[vBranchLookCount][1] = BRANCH_UNDEF
	vBranches[vBranchCount] = vInstructionCount
	vBranchCount = vBranchCount + 1
	vBranchLookCount = vBranchLookCount + 1

	proc BooleanExpression
	proc AddInstruction NVM_JTR, 0, vBranchCount, 0
	proc PushBranch BRANCH_LOOP_FROM_CRAP_DO
endproc

rem ==================================================================
rem Loop.
rem ==================================================================
procedure Loop()
	if vBranchLookCount >= 2 and vBranchLooks[vBranchLookCount - 1][1] = BRANCH_LOOP_FROM_CRAP_DO
		proc Wend
	else
		vBranchLookCount = vBranchLookCount - 1
		if vBranchLookCount < 0 or vBranchLooks[vBranchLookCount][1] <> BRANCH_LOOP
			proc Error "Unexpected 'loop'"
		endif
		proc AddInstruction NVM_JMP, 0, vBranchLooks[vBranchLookCount][0], 0
		proc BindBreaks
	endif
endproc

rem ==================================================================
rem Wend.
rem ==================================================================
procedure Wend()
	rem Not even enough branch look ups?
	if vBranchLookCount < 2 then proc Error "Unexpected 'wend'"

	rem Jump back to while evaluation.
	proc AddInstruction NVM_JMP, 0, vBranchLooks[vBranchLookCount - 2][0], 0

	rem Pop branch, so that we end up here when while expression evaluates to false.
	if not PopBranch(BRANCH_WEND) then proc Error "Unexpected 'wend'"

	vBranchLookCount = vBranchLookCount - 1

	proc BindBreaks
endproc


rem ==================================================================
rem Loop until.
rem ==================================================================
procedure LoopUntil()
	vBranchLookCount = vBranchLookCount - 1
	if vBranchLooks[vBranchLookCount][1] <> BRANCH_LOOP
		proc Error "Unexpected 'loop until'"
	endif
	proc BooleanExpression
	proc AddInstruction NVM_JFL, 0, vBranchLooks[vBranchLookCount][0], 0
	proc BindBreaks
endproc

rem ==================================================================
rem Loop while.
rem ==================================================================
procedure LoopWhile()
	vBranchLookCount = vBranchLookCount - 1
	if vBranchLooks[vBranchLookCount][1] <> BRANCH_LOOP
		proc Error "Unexpected 'loop while'"
	endif
	proc BooleanExpression
	proc AddInstruction NVM_JTR, 0, vBranchLooks[vBranchLookCount][0], 0
	proc BindBreaks
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure BindBreaks()
endproc

rem ==================================================================
rem Input one or more values from keyboard.
rem ==================================================================
procedure Input()
	do
		if vThing.type = TYPE_GLOBAL_NUMBER
			rem Load global numeric value with input from keyboard.

			rem The READLN system call uses a calling conventioned used
			rem by SOME system calls in naalaa. Other system calls use
			rem registers for parameter passing.
			rem   Before calling any function like this, you should push
			rem the value of register 7 to the stack, because it it is
			rem used as a base in the stack for parameters and local
			rem variables. Then you should push all parameters to the
			rem stack. After calling the sub routine, use the
			rem instruction SUB_SC with the number of parameters as
			rem source value. SUB_SC does some housekeeping, such as
			rem cleaning up temporary strings and arrays on the stack
			rem while decrasing the stack pointer.
			proc AddInstruction NVM_PUSH_R, 0, 7, 0
			proc AddInstruction NVM_MOVE_RC, 0, 0, 0
			proc AddInstruction NVM_PUSH_R, 0, 0, 0
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_READLN, 0
			proc AddInstruction NVM_SUB_SC, 0, 1, 0
			proc AddInstruction NVM_POP_R, 7, 0, 0 
			
			proc AddInstruction NVM_ITOF_R, 0, 0, 0
			proc AddInstruction NVM_MOVEF_GR, vThing.index, 0, 0

		elseif vThing.type = TYPE_GLOBAL_STRING
			rem Load global string with input from keyboard.
			proc AddInstruction NVM_PUSH_R, 0, 7, 0
			proc AddInstruction NVM_MOVE_RC, 0, 0, 0
			proc AddInstruction NVM_PUSH_R, 0, 0, 0
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_SREADLN, 0
			proc AddInstruction NVM_SUB_SC, 0, 1, 0
			proc AddInstruction NVM_POP_R, 7, 0, 0 
			
			proc AddInstruction NVM_STR_TO_G, vThing.index, 0, 0
	
		elseif vThing.type = TYPE_CONST_STRING
			rem Output a constant string without CR.
			proc AddInstruction NVM_CPY_GSTR, 0, vThing.index, 0
			proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_PRINT, 0

		endif

		vThing = GetNext()
		if vThing.type = TYPE_CHAR and vThing.char$ = ","
			vThing = GetNext()
		else
			break
		endif
	loop
endproc

rem ==================================================================
rem Output a list of expressions.
rem ==================================================================
procedure Print()
	proc AddInstruction NVM_CLR_STR, 0, 0, 0

	if not (vThing.type = TYPE_EOL or vThing.type = TYPE_EOF)
		proc AddInstruction NVM_PUSH_STR, 0, 0, 0
		do
			rem String expression?
			if vThing.type = TYPE_CONST_STRING or vThing.type = TYPE_GLOBAL_STRING
				proc StringExpression

			rem Numeric expression.
			else
				proc Expression
				rem Convert to string.
				proc AddInstruction NVM_FTOS_R, 0, 0, 0
			endif

			rem Concatenate.
			proc AddInstruction NVM_MOVE_STR_RR, 1, 0, 0
			proc AddInstruction NVM_POP_STR_R, 0, 0, 0
			proc AddInstruction NVM_ADD_STR_RR, 0, 1, 0
			proc AddInstruction NVM_DEL_STR_R, 1, 0, 0

			rem More expressions to come?
			if vThing.type = TYPE_CHAR and vThing.char$ = ","
				vThing = GetNext()
				proc AddInstruction NVM_PUSH_STR, 0, 0, 0
			else
				break
			endif
		loop
	endif

	rem Output.
	proc AddInstruction NVM_SYSTEM_CALL, 0, SYS_PRINTLN, 0
endproc

rem ==================================================================
rem Comment.
rem ==================================================================
procedure Remark()
	while not (vThing.type = TYPE_EOL or vThing.type = TYPE_EOF)
		vThing = GetNext()
	wend
endproc

rem ==================================================================
rem Push a branch type to stack.
rem ==================================================================
procedure PushBranch(type)
	vBranchLooks[vBranchLookCount][0] = vBranchCount
	vBranchLooks[vBranchLookCount][1] = type
	vBranchCount = vBranchCount + 1
	vBranchLookCount = vBranchLookCount + 1
endproc

rem ==================================================================
rem Pop a branch of a certain type from stack. Return false if the
rem type is incorrect.
rem ==================================================================
function PopBranch(type)
	vBranchLookCount = vBranchLookCount - 1
	if vBranchLookCount < 0 or vBranchLooks[vBranchLookCount][1] <> type
		vBranchLookCount = vBranchLookCount + 1
		return false
	else
		vBranches[vBranchLooks[vBranchLookCount][0]] = vInstructionCount
		return true
	endif
endfunc

rem ==================================================================
rem Expect a certain character.
rem ==================================================================
procedure Expect(char$)
	thing? = GetNext()
	if not (thing.type = TYPE_CHAR and thing.char$ = char)
		proc Error "Expected character " + char
	endif
endproc

rem ==================================================================
rem Expect current thing to be a certain character and get next.
rem ==================================================================
procedure Match(char$)
	if not (vThing.type = TYPE_CHAR and vThing.char$ = char)
		proc Error "Expected character '" + char + "'"
	endif
	vThing = GetNext()
endproc

rem ==================================================================
rem Expect current thing to be a certain reserved word and get next.
rem ==================================================================
procedure MatchReserved(word)
	if not (vThing.type = TYPE_RESERVED and vThing.word = word)
		proc Error "Expected '" + vReserved[word] + "'"
	endif
	vThing = GetNext()
endproc

rem ==================================================================
rem Optionally match a certain reserved word.
rem ==================================================================
procedure OptMatchReserved(word)
	if vThing.type = TYPE_RESERVED and vThing.word = word
		vThing = GetNext()
	endif
endproc

rem ==================================================================
rem Get next thing from input file.
rem ==================================================================
function GetNext?()
	thing?

	rem Init.
	if vFileChar = 0 then vFileChar = read8(IN_FILE)

	rem Eat dirt.
	rem while vFileChar = 32 or vFileChar = 9 or vFileChar = 10 or vFileChar = 13
	while vFileChar = 32 or vFileChar = 9
		vFileChar = read8(IN_FILE)
	wend

	rem End of file.
	if eof(IN_FILE)
		thing.type = TYPE_EOF
		return thing
	endif

	rem Check type.
	if IsAlpha(vFileChar)
		rem Alphabetical, reserved or variable.
		name$
		do
			name = name + chr$(vFileChar)
			vFileChar = read8(IN_FILE)
		until eof(IN_FILE) or not (IsAlpha(vFileChar) or IsDigit(vFileChar))

		rem Not case sensitive.
		name = lower$(name)

		rem Reserved?
		reserved = ReservedWord(name)
		if reserved >= 0
			thing.type = TYPE_RESERVED
			thing.word = reserved
		else
			thing = Variable(name)
		endif
		thing.name$ = name

	elseif IsDigit(vFileChar)
		rem A number.
		number$
		hasPoint = false
		do
			if vFileChar = 46 then hasPoint = true
			number = number + chr$(vFileChar)
			vFileChar = read8(IN_FILE)
		until eof(IN_FILE) or not (IsDigit(vFileChar) or (vFileChar = 46 and hasPoint = false))
		rem Floating point or integer constant?
		if hasPoint
			rem Float constants are cached and written to the binary.
			thing.type = TYPE_CONST_FLOAT
			thing.index = FloatConstant(float(number))
		else
			rem Integer constants can be put directly in the instructions..
			thing.type = TYPE_CONST_INT
			thing.integer = int(number)
		endif

	elseif vFileChar = 34
		rem A string constant.
		thing.type = TYPE_CONST_STRING
		rem Read string.
		vFileChar = read8(IN_FILE)
		string$ = ""
		while not (eof(IN_FILE) or vFileChar = 34)
			string = string + chr$(vFileChar)
			vFileChar = read8(IN_FILE)
		wend
		vFileChar = read8(IN_FILE)
		rem String constants are cached and written to the binary
		thing.index = StringConstant(string)

	elseif vFileChar = 13 or vFileChar = 59; rem CR or ; character.
		rem New line.
		if not vFileChar = 59 then vLineCount = vLineCount + 1
		thing.type = TYPE_EOL
		vFileChar = read8(IN_FILE)
		rem Remove LF if present
		if vFileChar = 10 then vFileChar = read8(IN_FILE)

	elseif vFileChar = 39
		rem Single quote character works like REM.
		thing.type = TYPE_RESERVED
		thing.word = RES_REM
		vFileChar = read8(IN_FILE)
	else
		rem A character.
		thing.type = TYPE_CHAR
		thing.char$ = chr$(vFileChar)
		vFileChar = read8(IN_FILE)
	endif

	return thing
endfunc

rem ==================================================================
rem Return index of reserved word if 'name' is reserved, else return
rem -1.
rem ==================================================================
function ReservedWord(name$)
	for i = 0 to sizeof(vReserved) - 1
		if name = vReserved[i] then break
	next
	if i = sizeof(vReserved) then return -1
	return i
endfunc

rem ==================================================================
rem Get variable.
rem ==================================================================
function Variable?(name$)
	thing?.name$ = name

	rem Check g
	for i = 1 to vGlobalCount - 1
		if name = vGlobal[i].name$ then break
	next
	if i = vGlobalCount
		rem Create new global variable.
		if chr$(vFileChar) = "$"
			proc Expect "$"
			thing.type = TYPE_GLOBAL_STRING
		else
			thing.type = TYPE_GLOBAL_NUMBER
		endif
		thing.index = NewGlobal(name, thing.type)
	else
		rem Variable already exists.
		thing.type = vGlobal[i].type
		thing.index = i

		if thing.type = TYPE_GLOBAL_STRING
			proc Expect "$"
		endif
	endif

	return thing
endfunc

rem ==================================================================
rem Create new global variable and return index.
rem ==================================================================
function NewGlobal(name$, type)
	rem Increase array size?
	if vGlobalCount >= sizeof(vGlobal)
		tmp?[] = vGlobal
		vGlobal[vGlobalCount + 100]
		for i = 0 to vGlobalCount - 1
			vGlobal[i] = tmp[i]
		next
	endif

	vGlobal[vGlobalCount].name$ = name
	vGlobal[vGlobalCount].type = type
	vGlobalCount = vGlobalCount + 1

	return vGlobalCount - 1
endfunc

rem ==================================================================
rem Return index for float constant. The constants are cached.
rem ==================================================================
function FloatConstant(value#)
	rem Check cache.
	for i = 0 to vFloatConstCount - 1
		if vFloatConsts[i] = value then break
	next
	if i = vFloatConstCount
		rem Create new.

		rem Increase array size?
		if vFloatConstCount >= sizeof(vFloatConsts)
			tmp#[] = vFloatConsts
			vFloatConsts[vFloatConstCount + 100]
			for j = 0 to vFloatConstCount - 1
				vFloatConsts[j] = tmp[j]
			next
		endif

		vFloatConsts[vFloatConstCount] = value
		vFloatConstCount = vFloatConstCount + 1
		return vFloatConstCount - 1
	else
		rem Return cached.
		return i
	endif
endfunc

rem ==================================================================
rem Return index for string constant. The constants are cached.
rem ==================================================================
function StringConstant(string$)
	rem Check cache.
	for i = 0 to vStringConstCount - 1
		if vStringConsts[i] = string then break
	next
	if i = vStringConstCount
		rem Create new.
		
		rem Increase array size?
		if vStringConstCount >= sizeof(vStringConsts)
			tmp$[] = vStringConsts
			vStringConsts[vStringConstCount + 100]
			for j = 0 to vStringConstCount - 1
				vStringConsts[j] = tmp[j]
			next
		endif

		vStringConsts[vStringConstCount] = string
		vStringConstCount = vStringConstCount + 1
		return vStringConstCount - 1
	else
		rem Return cached.
		return i
	endif
endfunc

rem ==================================================================
rem Return true if 'char' is alphabetical.
rem ==================================================================
function IsAlpha(char)
	if (char >= 65 and char <= 90) or (char >= 97 and char <= 122)
		return true
	else
		return false
	endif
endfunc

rem ==================================================================
rem Return true if 'char' is a digit.
rem ==================================================================
function IsDigit(char)
	if char >= 48 and char <= 57
		return true
	else
		return false
	endif
endfunc

rem ==================================================================
rem Write string constant to OUT_FILE.
rem ==================================================================
procedure WriteStringConstant(s$)
	write32 OUT_FILE, len(s$)
	for i = 0 to len(s$) - 1
		write8 OUT_FILE, asc(mid$(s$, i))
	next
endproc

rem ==================================================================
rem Add instruction.
rem ==================================================================
procedure AddInstruction(instruction, dst, src, extra)
	rem Increase array size?
	if vInstructionCount >= sizeof(vInstructions, 0)
		tmp[][] = vInstructions
		vInstructions[vInstructionCount + 100][5]
		for i = 0 to vInstructionCount - 1
			for j = 0 to 4
				vInstructions[i][j] = tmp[i][j]
			next
		next
	endif

	vInstructions[vInstructionCount][0] = instruction
	vInstructions[vInstructionCount][1] = dst
	vInstructions[vInstructionCount][2] = src
	vInstructions[vInstructionCount][3] = extra
	vInstructions[vInstructionCount][4] = 0
	vInstructionCount = vInstructionCount + 1
endproc

rem ==================================================================
rem Set (or rather Change) instruction.
rem ==================================================================
procedure SetInstruction(index, instruction, dst, src, extra)
	vInstructions[index][0] = instruction
	vInstructions[index][1] = dst
	vInstructions[index][2] = src
	vInstructions[index][3] = extra
	vInstructions[index][4] = vLineCount
endproc

rem ==================================================================
rem Write error message and quit.
rem ==================================================================
procedure Error(msg$)
	if file(IN_FILE) then free file IN_FILE
	if file(OUT_FILE) then free file OUT_FILE
	wln "Error on line ", vLineCount, ": ", msg
	wln
	wln "Press any key to exit ..."
	wait keydown
	end
endproc
