M2000 Compiler Task

One module compile, including lexical analyzer, syntax analyzer, code generator and virtual machine interpreter. The VM running using lambda functions, which include in an inventory (a kind of map), so each byte code is a key to this inventory, and the vm loop is just three lines. Normally functions (including lambda functions) and modules have own name space, but we can call functions with a L Call Local statement, which place the same name space of the caller (subroutines get always name space from the caller). Each module get a string (the (a$) is a syntactic sugar, interpreter insert a Read a$ when module added to modules/function list), and place a string to the stack of values. So we have to put one module after the other to do all the process.

The stack of values internal is a collection, which we can add to top (using Push) or to bottom (using Data) and we can pop values using Read, or peak values using ItemStack() and ItemStack$() for strings. A module get the parent stack of value, a function in an expression has own stack of value. We can switch temporary to a new stack using a Stack New { } statement, and at the end of this the previous object attach to "process object". (modules and functions run on separate process objects, subs are implemented in execution code, they are not objects).

Enum variables can return the name of value using a Eval$(enum_name_or_variable), So we can store values as Enum types, and handle them as numbers and as strings (using Eval$()). Functions Eval() and Eval$() do many things, depends of the first argument.

Generator save the byte code to a byte buffer. In a buffer bytes, integer, long are unsigned numbers. We have to use Uint(a) to place a signed value, and Sint() to get the signed from buffer. Also we can read from bytes offsets using casting to integer or to long, which we done here to get the long value after the operand (like in jmp or in fetch).

lambda functions can get closures as copies. In lexical analyzer the Scanner variable is a pointer to a buffer, so the copy is a reference. Lambda functions are not reference type, but a value type. We can pass a lambda as a closure too.

Select Case is a mystery in M2000. We can have one line after Case or a Block but no blank lines. This happen because interpreter execute code every time from source; Only look ahead to find if an expression is a string or number which is very fast because, strings functions and variables have $ at the end of name. Maybe some day interpreter find a lexical/syntax analyzer, but for this time works as one function which consume source code.

Image

New Version (2022) with a menu for 7 examples, and a messagebox for choosing virtual machine or transpiler to M2000 language (much faster).

M2000 Interpreter

Module CompilerExample {
	Set Fast !
	Module lexical_analyzer (a$){
		lim=Len(a$)
		LineNo=1
		ColumnNo=1
		Document Output$
		Buffer Scanner as Integer*lim
		Return Scanner, 0:=a$
		offset=0
		buffer1$=""
		flag_rem=true
		Ahead=lambda Scanner (a$, offset)->{
			=false
			Try {
				// second parameter is the offset in buffer units
				// third parameter is length in bytes
				=Eval$(Scanner, offset,2*len(a$))=a$
			}
		}
		Ahead2=lambda Scanner (a$, offset)->{
			=false
			Try {
				=Eval$(Scanner, offset,2) ~ a$
			}
		}
		const nl$=chr$(13)+chr$(10), quo$="""", er$="@", Ansi=3
		Try {
			Do
			If Ahead("/*", offset) Then {
				offset+=2 : ColumnNo+=2
				While not Ahead("*/", offset)
					If Ahead(nl$, offset) Then
						lineNo++: ColumnNo=1 : offset+=2
					Else
						offset++ : ColumnNo++
					End If
					if offset>lim then
						Error "End-of-file in comment. Closing comment characters not found"+er$
					End if
				End While
				offset+=2 : ColumnNo+=2
			} Else.if Ahead(nl$, offset) Then{
				LineNo++: ColumnNo=1
				offset+=2
			} Else.if Ahead(quo$, offset) Then {
				Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				strin=offset
				While not Ahead(quo$, offset)
					If Ahead("/", offset) Then
						offset+=2 : ColumnNo+=2
					else
						offset++ : ColumnNo++
					End if
					checkerror()
				End While
				Output$="String "+quote$(Eval$(Scanner, strin, (offset-strin)*2))+nl$
				offset++ : ColumnNo++
			} Else.if Ahead("'", offset) Then {
				Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				strin=offset
				While not Ahead("'", offset)
					If Ahead("/", offset) Then
						offset+=2 : ColumnNo+=2
					else
						offset++ : ColumnNo++
					End if
					checkerror()
				End While
				lit$=format$(Eval$(Scanner, strin, (offset-strin)*2))
				select case len(lit$)
				case 1
					Output$="Integer "+str$(asc(lit$),0)+nl$
				case >1
					{Error "Multi-character constant."+er$}
				case 0
					{Error "Empty character constant."+er$}
				end select
				offset++ : ColumnNo++
			} Else.if Ahead2("[a-z]", offset) Then {
				strin=offset
				Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				While Ahead2("[a-zA-Z0-9_]", offset)
					offset++ : ColumnNo++
				End While
				Keywords(Eval$(Scanner, strin, (offset-strin)*2))
			} Else.if Ahead2("[0-9]", offset) Then {
				strin=offset
				Output$=format$("{0::-10}{1::-10} Integer ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				While Ahead2("[0-9]", offset)
					offset++ : ColumnNo++
				End While
				if Ahead2("[a-zA-Z_]", offset) then  
					{Error " Invalid number. Starts like a number, but ends in non-numeric characters."+er$}
				else
					Output$=Eval$(Scanner, strin, (offset-strin)*2)+nl$
				end if
			} Else {
				Symbols(Eval$(Scanner, Offset, 2))	      
				offset++ : ColumnNo++
			}
			Until offset>=lim
		}
		er1$=leftpart$(error$,er$)
		if er1$<>"" then
			Print
			Report "Error:"+er1$
			Output$="(Error)"+nl$+"Error:"+er1$
		else
			Output$=format$("{0::-10}{1::-10}", LineNo, ColumnNo)+" End_of_Input"+nl$
		end if
		Push Output$
		Exit
		Clipboard Output$
		Save.Doc Output$, "lex.t", Ansi
		document lex$
		Load.Doc lex$,"lex.t", Ansi
		Report lex$
 
		Sub Keywords(a$)
			select case a$
			case "if"
				a$="Keyword_if"
			case "else"
				a$="Keyword_else"
			case "while"
				a$="Keyword_while"
			case "print"
				a$="Keyword_print"
			case "putc"
				a$="Keyword_putc"
			else case
				a$="Identifier "+a$
			end select
			Output$=a$+nl$
		End sub
		Sub Symbols(a$)
			select case a$
			case " ", chr$(9)
				a$=""
			case "("
				a$="LeftParen"
			case ")"
				a$="RightParen"
			case "{"
				a$="LeftBrace"
			case "}"
				a$="RightBrace"
			case ";"
				a$="Semicolon"
			case ","
				a$="Comma"
			case "*"
				a$="Op_multiply"
			case "/"
				a$="Op_divide"
			case "+"
				a$="Op_add"
			case "-"
				a$="Op_subtract"
			case "%"
				a$="Op_mod"
			case "<"
			{	if Ahead("=", offset+1) Then
					offset++
					a$="Op_lessequal"
					ColumnNo++
				else
					a$="Op_less"
				end if
			}
			case ">"
			{	if Ahead("=", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_greaterequal"
				else
					a$="Op_greater"
				end if
			}
			case "="
			{	if Ahead("=", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_equal"
				else
					a$="Op_assign"
				end if
			}
			case "!"
			{	if Ahead("=", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_notequal"
				else
					a$="Op_not"
				end if
			}
			case "&"
			{	if Ahead("&", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_and"
				else
					a$=""
				end if
			}
			case "|"
			{	if Ahead("|", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_or"
				else
					a$=""
				end if
			}
			else case
				{Error "Unrecognized character."+er$}
			end select
			if a$<>"" then
			Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)+a$+nl$
			end if
		End Sub
		Sub checkerror()
			if offset>lim then {
				Error "End-of-line while scanning string literal. Closing string character not found before end-of-line."+er$
			} else.if  Ahead(nl$,offset) then {
				Error "End-of-file while scanning string literal. Closing string character not found."+er$
			}
		End Sub
	}
	Module syntax_analyzer (b$){
		enum tokens {
			Op_add, Op_subtract, Op_not=5, Op_multiply=10, Op_divide, Op_mod, 
			Op_negate,  Op_less, Op_lessequal, Op_greater, Op_greaterequal,
			Op_equal, Op_notequal, Op_and, Op_or, Op_assign=100, Keyword_if=110,
			Keyword_else, Keyword_while, Keyword_print, Keyword_putc, LeftParen, RightParen,
			LeftBrace, RightBrace, Semicolon, Comma, Identifier, Integer, String, End_of_input
		}
 
		Inventory precedence=Op_multiply:=13, Op_divide:=13, Op_mod:=13, Op_add:=12, Op_subtract:=12
		Append  precedence, Op_negate:=14, Op_not:=14, Op_less:=10, Op_lessequal:=10, Op_greater:=10 
		Append  precedence, Op_greaterequal:=10, Op_equal:=9, Op_notequal:=9, Op_assign:=-1, Op_and:=5
		Append  precedence, Op_or:=4
 
		Inventory symbols=Op_multiply:="Multiply", Op_divide:="Divide", Op_mod:="Mod", Op_add:="Add"
		Append  symbols, Op_negate:="Negate", Op_not:="Not", Op_less:="Less", Op_subtract:="Subtract"
		Append  symbols, Op_lessequal:="LessEqual", Op_greater:="Greater", Op_greaterequal:="GreaterEqual"
		Append  symbols, Op_equal:="Equal", Op_notequal:="NotEqual",  Op_and:="And", Op_or:="Or" 
 
		def lineNo, ColumnNo, m, line$, a, lim, cur=-1
		const nl$=chr$(13)+chr$(10), Ansi=3
		Dim lex$()
		lex$()=piece$(b$,chr$(13)+chr$(10)) 
		lim=dimension(lex$(),1)-1
		op=End_of_input
		flush
		k=0
		Try {
			push (,)   ' Null
			getone(&op)
			repeat
			stmt(&op)
			shift 2  ' swap two top items
			push ("Sequence", array, array)
			k++
			until op=End_of_Input
		}
		er$=error$
		if er$<>"" then print er$ : flush: break
		Print "Ast"
		Document Output$
		prt_ast()
		Push Output$
		exit
		clipboard Output$
		Save.Doc Output$, "parse.t", Ansi
		document parse$
		Load.Doc parse$,"parse.t", Ansi
		Report parse$
 
		sub prt_ast(t)
			if len(t)<1 then
				Output$=";"+nl$
			else.if len(t)=3 then
				Output$=t#val$(0) +nl$
				prt_ast(t#val(1)) : prt_ast(t#val(2))
			else
				Output$=t#val$(0) +nl$
			end if
		end sub
		sub expr(p)   ' only a number
			local x=(,), prev=op
			if  op>=Identifier then
				x=(line$,)
				getone(&op)
			else.if op=LeftParen then
				paren_exp()
				x=array
			else.if op<10 then
				getone(&op)
				expr(precedence(int(Op_negate)))
				read local y
				if prev=Op_add then
					x=y
				else
					if prev=Op_subtract then prev=Op_negate
					x=(symbols(prev), y,(,))
				End if
			else
				 {error "??? "+eval$(op)}
			end if
			local prec
			while exist(precedence, int(op))
				prev=op : prec=eval(precedence)
				if prec<14 and prec>=p else exit
				getone(&op)
				expr(prec+1)  ' all operators are left associative (use prec for right a.)
				x=(symbols(int(prev)), x, array)
			End While
			Push x
		end sub
		sub paren_exp()
			expected(LeftParen)
			getone(&op)
			expr(0)
			expected(RightParen)
			getone(&op)
		end sub
		sub stmt(&op)
			local t=(,)
			if op=Identifier then
				t=(line$)
				getone(&op)
				expected(Op_assign)
				getone(&op) 
				expr(0)
				read local rightnode
				Push ("Assign",t,rightnode)
				expected(Semicolon)
				getone(&op)
			else.if op=Semicolon then
				getone(&op)
				Push (";",)
			else.if op=Keyword_print then
				getone(&op)
				expected(LeftParen)
				repeat
					getone(&op)
					if op=String then
						Push ("Prts",(line$,),(,))
						getone(&op)
					else
						expr(0)
						Push ("Prti", array,(,))
					end if
					t=("Sequence", t, array)
				until op<>Comma
				expected(RightParen)
				getone(&op)
				expected(Semicolon)
				getone(&op)
				push t
			else.if op=Keyword_while then
				getone(&op)
				paren_exp()
				stmt(&op)
				shift 2
				Push ("While",array, array)
			else.if op=Keyword_if then
				getone(&op)
				paren_exp()
				stmt(&op)
				local s2=(,)
				if op=Keyword_else then
					getone(&op)
					stmt(&op)
					read s2
				end if
				shift 2
				Push ("If",array ,("If",array,s2))
			else.if op=Keyword_putc then
				getone(&op)
				paren_exp()
				Push ("Prtc",array,t)
				expected(Semicolon)
				getone(&op)
			else.if op=LeftBrace then
				Brace()
			else
				error "Unkown Op"
			end if
		end sub
		Sub Brace()
				getone(&op)
				while op<>RightBrace and op<>End_of_input
					stmt(&op)
					t=("Sequence", t, array)
				end while
				expected(RightBrace)
				getone(&op)
				push t
		End Sub
		Sub expected(what)
			if not op=what then {Error "Expected "+eval$(what)+str$(LineNo)+","+Str$(ColumnNo)}
		End Sub
		sub getone(&op)
			op=End_of_input
			while cur<lim
			cur++
			line$=trim$(lex$(cur))
			if line$<>"" then exit
			end while
			if cur=lim then exit sub
			LineNo=Val(line$,"int",m)
			line$=mid$(line$, m)
			ColumnNo=Val(line$,"int",m)
			line$=trim$(mid$(line$, m))
			Rem : Print LineNo, ColumnNo
			m=instr(line$," ")
			if m>0 then op=Eval("."+leftpart$(line$, " ")) else op=Eval("."+line$)
		end sub
	}
	Module CodeGenerator (s$){
		Function code$(op$) {
			=format$("{0::-6} {1}", pc, op$)
			pc++
		}
		Function code2$(op$, n$) {
			=format$("{0::-6} {1} {2}", pc, op$, n$)
			pc+=5
		}
		Function code3$(op$,pc, st, ed) {
			=format$("{0::-6} {1} ({2}) {3}", pc, op$, ed-st-1, ed)
		}
 
		Enum tok {
			gneg, gnot, gmul, gdiv, gmod, gadd, gle, gsub, glt
			gle, ggt, gge, geq, gne, gand, gor, gprtc, gprti, gprts,
			gif, gwhile, gAssign, gSeq, gstring, gidentifier, gint, gnone
		}
 
		// Inventories are lists with keys, or keys/data (key must be unique)
		// there is one type more the Invetory Queue which get same keys.
		// But here not used.
		Inventory symb="Multiply":=gmul, "Divide":=gdiv, "Mod":=gmod, "Add":=gadd
		Append  symb, "Negate":=gneg, "Not":=gnot,"Less":=glt,"Subtract":=gsub
		Append  symb, "LessEqual":=gle, "Greater":=ggt, "GreaterEqual":=gge, "Sequence":=gSeq
		Append  symb, "Equal":=geq, "NotEqual":=gne,  "And":=gand, "Or":=gor, "While":=gwhile
		Append  symb, "Prtc":=gprtc,"Prti":=gprti,"Prts":=gprts, "Assign":=gAssign, "If":=gif
		Append  symb, "String":=gstring, "Identifier":=gidentifier, "Integer":=gint, ";", gnone
 
		Inventory DataSet
		// We set string as key. key maybe an empty string, a string or a number.
		// so we want eash string to saved one time only.
		Inventory Strings
 
		Const nl$=chr$(13)+chr$(10), Ansi=3
		Def z$, lim, line$, newvar_ok, i=0
		Document message$=nl$
		Global pc     // functions have own scope, so we make it global, for this module, and childs.
 
		Dim lines$()
		s$=filter$(s$,chr$(9))   // exclude tabs
		Lines$()=piece$(s$,nl$) // break to lines
		lim=len(Lines$())
		Flush ' empty stack (there is a current stack of values which we use here)
 
		Load_Ast()
		If not stack.size=1 Then Flush : Error "Ast not loaded"
		AST=array   // pop the array from stack
		Document Assembly$, Header$
 
		// all lines of assembly goes to stack. Maybe not in right order.
		// Push statement push to top, Data statement push to bottom of stack
 
		CodeGenerator(Ast)
		Data  code$("halt") ' append to end of stack
		// So now we get all data (letters) from stack
		While not empty
			Assembly$=letter$+nl$
		end while
		// So now we have to place them in order
		Sort Assembly$
 
		// Let's make the header
		Header$=format$("Datasize: {0} Strings: {1}", Len(Dataset),Len(strings))
		// we use an iterator object, str^ is the counter, readonly, but Eval$() use it from object.
		str=each(strings)    
		While str
			Header$=nl$+Eval$(str)
		End while
		Assembly$=nl$
		// insert to line 1 the Header
		Insert 1 Assembly$=Header$
		// Also we check for warnings
		If len(message$)>2 then Assembly$="Warnings: "+nl$+message$
		// So now we get a report
		// (at each 3/4 of window's lines, the printing stop and wait for user response, any key)
		Push Assembly$
		Exit
		Report Assembly$
		Clipboard Assembly$
		Save.Doc Assembly$, "code.t", Ansi
		End
		// subs have 10000 limit for recursion but can be extended to 1000000 or more.
		Sub CodeGenerator(t)
 
			If len(t)=3 then
				select case  t#val(0)
				Case gSeq
					CodeGenerator(t#val(1)) : CodeGenerator(t#val(2))
				Case gwhile
				{
					local spc=pc
					CodeGenerator(t#val(1)) 
					local pc1=pc
					pc+=5 ' room for jz
					CodeGenerator(t#val(2))
					data code3$("jz",pc1, pc1, pc+5)
					data code3$("jmp",pc,  pc, spc)
					pc+=5  ' room for jmp
				}
				Case gif
				{
					CodeGenerator(t#val(1)) 
					local pc1=pc, pc2
					pc+=5
					CodeGenerator(t#val(2)#val(1)) 
					If len(t#val(2)#val(2))>0 then
						pc2=pc
						pc+=5
						data code3$("jz",pc1, pc1, pc)
						CodeGenerator(t#val(2)#val(2))
						data code3$("jmp",pc2, pc2, pc)
					else
						data code3$("jz",pc1, pc1, pc)
					end If	  
				}
				Case gAssign
				{
					CodeGenerator(t#val(2))
					local newvar_ok=true
					CodeGenerator(t#val(1))
				}
				case gneg to gnot, gprtc to gprts
					CodeGenerator(t#val(1)) : data code$(mid$(eval$(t#val(0)),2))
				case gmul to gor
				{
					CodeGenerator(t#val(1))
					CodeGenerator(t#val(2))
					data code$(mid$(eval$(t#val(0)),2))
				}
				End select
			Else.if len(t)=2 then
				select case  t#val(0)
				Case gString
				{
					local spos
					If exist(strings,t#val$(1)) then
						spos=eval(strings!)
					else
						append strings, t#val$(1)	       
						spos=len(strings)-1
					end If
					Push code2$("push",str$(spos,0))
				}
				Case gInt
					Push code2$("push",t#val$(1), pc)
				Case gIdentifier
				{
					local ipos
					If exist(dataset,t#val$(1)) then
						ipos=Eval(dataset!)  ' return position
					else.if newvar_ok then
						Append dataset, t#val$(1)
						ipos=len(dataset)-1
					else
						message$="Variable "+t#val$(1)+" not initialized"+nl$
 
					end If
					If newvar_ok then
						Push code2$("store","["+str$(ipos, 0)+"]")
					else
						Push code2$("fetch","["+str$(ipos, 0)+"]")
					end If
				}
				end select
			End If
		End Sub
		Sub Load_Ast()
				If i>=lim then Push (,) : exit sub
				do
				line$=Trim$(lines$(i))
				I++
				tok$=piece$(line$," ")(0)
				until line$<>"" or i>=lim
				If tok$="Identifier" then
					Push (gidentifier,trim$(Mid$(line$,11)))
				else.if tok$="Integer" then
					long n=Val(Mid$(line$,8))  ' check overflow
					Push (gint, Trim$(Mid$(line$,8)))
				else.if tok$="String" then
					Push (gstring,Trim$(Mid$(line$,7)))
				else.if tok$=";" then
					Push (,)
				Else
					local otok=symb(tok$)
					Load_Ast() 
					Load_Ast()
					Shift 2
					Push (otok,array, array)
				End If
		End Sub
	}
	Module Virtual_Machine_Interpreter (a$){
		// function to extract string, replacing escape codes.
		Function GetString$(a$) {
			s=instr(a$, chr$(34))
			m=rinstr(a$,chr$(34))-s
			if m>1 then
				// process escape codes
				=format$(mid$(a$, s+1, m-1))
			else
				=""
			end if
		}
 		const nl$=chr$(13)+chr$(10)
		// we can set starting value to any number  n where 0<=n<=232
		enum op {	halt_=232, add_, sub_, mul_, div_, mod_, not_, neg_, and_, or_, lt_,
			    	gt_, le_, ge_, ne_, eq_, prts_, prti_, prtc_, store_, fetch_, push_,
				jmp_, jz_
	    	}
	     	exit_now=false
		Inventory  func=halt_:=lambda->{exit_now=true}
		Append  func, push_:=lambda->{sp--:return stack_, sp:=eval(code_, pc as long):pc+=4}
		Append  func, jz_:=lambda->{
			sp++: if eval(stack_, sp-1)=0 then pc=eval(code_, pc as long) else pc+=4
		}
		Append  func, jmp_:=lambda->{pc=eval(code_, pc as long)}
		Append  func, fetch_:=lambda->{sp--:Return stack_, sp:=eval(stack_, eval(code_, pc as long)):pc+=4}
		Append  func, store_:=lambda->{Return stack_, eval(code_, pc as long):=eval(stack_, sp):sp++:pc+=4}
		Append  func, add_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))+sint(eval(stack_, sp))):sp++}
		Append  func, sub_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))-sint(eval(stack_, sp))):sp++}
		Append  func, mul_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))*sint(eval(stack_, sp))):sp++}
		Append  func, div_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1)) div sint(eval(stack_, sp))):sp++}
		Append  func, mod_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1)) mod sint(eval(stack_, sp))) :sp++}
		Append  func, not_:=lambda->{Return stack_, sp:=if(eval(stack_, sp)=0->uint(-1),0)}
		Append  func, neg_:=lambda->{Return stack_, sp:=uint(-sint(eval(stack_, sp)))}
		Append  func, and_:=lambda->{Return stack_, sp+1:=binary.and(eval(stack_, sp+1),eval(stack_, sp)):sp++	}
		Append  func, or_:=lambda->{Return stack_, sp+1:=binary.or(eval(stack_, sp+1),eval(stack_, sp)):sp++	}
		Append  func, lt_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))<sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, gt_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))>sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, le_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))<=sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, ge_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))>=sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, ne_:=lambda->{Return stack_, sp+1:=uint(if(eval(stack_, sp+1)<>eval(stack_, sp)->-1, 0)):sp++}
		Append  func, eq_:=lambda->{Return stack_, sp+1:=uint(if(eval(stack_, sp+1)=eval(stack_, sp)->-1, 0)):sp++}
		Append  func, prts_:=lambda->{Print #-2, strings$(eval(stack_,sp));: Refresh:sp++}
		Append  func, prti_:=lambda->{Print #-2, str$(sint(eval(stack_,sp)),0);: Refresh:sp++}
		Append  func, prtc_:=lambda->{Print #-2, chrcode$(eval(stack_,sp));: Refresh:sp++}
		Rem : Form 120, 60 ' change console width X height to run Ascii Mandlebrot example
		// change Report with Print #-2,   (report stop when scrolling 3/4 of height of console, waiting key or mouse key to continue)
		Print #-2,  "Virtual Assembly Code:"+{
		}+a$
		Print "Prepare Byte Code"
 
		// get datasize
		a$=rightpart$(a$, "Datasize:")
		m=0
		data_size=val(a$, "int", m)
		a$=mid$(a$, m)
		// make stack
		if data_size>0 then Buffer Clear stack_ as long*data_size
		// dim or redim buffer append 1000 long as is.
		Buffer stack_ as long*(1000+data_size)
		// get strings
		a$=rightpart$(a$, "Strings:")
		m=0
		strings=val(a$, "int", m)
		a$=rightpart$(a$, nl$)
 
		if strings>0 then
			Dim strings$(strings)
			for i=0 to strings-1
				strings$(i)=GetString$(leftpart$(a$, nl$))
				a$=rightpart$(a$, nl$)
			Next i
		End if
		buffer clear code_ as byte*1000
		do
			m=0
			offset=val(a$,"int", m)
			if m<0 then exit
			a$=mid$(a$,m)
			line$=trim$(leftpart$(a$,nl$))
			if line$="" then line$=trim$(a$) else a$=trim$(rightpart$(a$, nl$))
			op$=if$(instr(line$," ")>0->leftpart$(line$," "), line$)
			if not valid(eval(op$+"_")) then exit
			opc=eval(op$+"_")
			Return code_, offset:=opc
			if opc>=store_ then
				line$=rightpart$(line$," ")
				select case opc
				case store_, fetch_
					Return code_, offset+1:=val(rightpart$(leftpart$(line$,"]"),"[")) as long : offset+=4
				case push_
					Return code_, offset+1:=uint(val(line$)) as long : offset+=4
				case jz_, jmp_
					Return code_, offset+1:=val(rightpart$(line$,")")) as long : offset+=4
				end select 
			end if
		Always
		Print "Press any key" : Push key$ : Drop
		// Prepare VM
		profiler
		let pc=0, sp=len(stack_) div 4
		do
			b=func(eval(code_, pc))
			pc++
			call local b()
		until exit_now
		Print
		Print "", round(Timecount/1000,2),"s"
	}
	Module Transpiler_to_M2000 (code$){
		Print #-2,  "Virtual Assembly Code:"+{
		}+code$
		Print "Prepare M2000 Code"
		Flush
		prolog$={Global z
			Module Halt {Error "stop"}
			Module neg {push -number}
			Module not {push number=0}
			Module and {push sint(binary.and(uint(number), uint(number)))}
			Module or {push sint(binary.or(uint(number), uint(number)))}
			Module gt {push number<number}
			Module lt {push number>number}
			Module ge {push number<=number}
			Module le {push number>=number}
			Module ne {push number<>number}
			Module eq {push number=number}
			Module mul {push number*number}
			Module div {shift 2 : push number div number}
			Module mod {shift 2 : push number mod number}
			Module sub {shift 2 : push number - number}
			Module add {push number + number}
			Module prtc {Print #-2, chrcode$(number);:Refresh}
			Module prts {Print #-2, format$(var$(number));:Refresh}
			Module prti {Print #-2, str$(number, 0);:Refresh}
			}
		Variable$=lambda$ (many, Name$, glob as boolean=false)->{
			if many else exit
			if glob then
				="Global "+name$+"(0 to "+str$(many,0)+")"+{
				}
			else
				="Dim Base 0, "+name$+"("+str$(many,0)+")"+{
				}
			end if
		}
		firstline$=leftpart$(code$,13)
		code$=rightpart$(code$, 10)
		firstline$=rightpart$(firstline$, ": ")
		Vars=val(firstline$)
		firstline$=rightpart$(firstline$, ": ")
		Strings=val(firstline$)
		document feedstrings$
		if Strings Then
		for i=0 to Strings-1
			firstline$=Trim$(leftpart$(code$,13))
			code$=rightpart$(code$, 10)
			feedstrings$="var$("+str$(i,0)+") = "+firstline$+{
			}
		next
		end if
		stack new {
			{
				g$=leftpart$(code$, " (")
				if g$="" or code$="" then
					data code$ : code$="": exit
				end if
				data g$
				code$=rightpart$(code$, 41)
				loop
			}
			while not empty{
				read g$
				code$+=g$
			}
		}
		code$=replace$("]", ")", code$)
		code$=replace$("fetch [", "fetch(", code$)
		code$=replace$("store [", "store(", code$)
		code$=replace$("jmp ", "goto ", code$)
		code$=replace$("jz", "if number else ", code$)
		Subs$={
			End
			Sub store(x)
				Read var(x)
			End Sub
			Sub fetch(x)
				Push  var(x)
			End Sub
		}
		document M2000Code$="Module Run {" +prolog$ + Variable$(Vars,"var")
		M2000Code$=Variable$(Strings,"var$", true) +feedstrings$ + "Try {" + {
		} + code$+"}"+Subs$+"}"
		//clipboard M2000code$
		//exit
		Inline M2000Code$
		Print "Press any key" : Push key$ : Drop
		profiler
		Run
		Print
		Print round(Timecount/1000,2),"s"
	}
	print "choose example",
	menu "Mandelbrot", "primes","test case 4", "99 Bottles of Beer", "FizzBuzz", "fibonacci of 44 is 701408733", "12 factorial is 479001600"
	if menu then print menu$(menu) else exit
	select case menu
	case 1
		{
			Push {
			{
				/*
				This is an integer ascii Mandelbrot generator
				*/
				left_edge= -420;
				right_edge=300;
				top_edge=300;
				bottom_edge = -300;
				x_step=7;
				y_step=15;
				
				max_iter=200;
				
				y0 = top_edge;
				while (y0 > bottom_edge) {
					x0 = left_edge;
					while (x0 < right_edge) {
						y = 0;
						x = 0;
						the_char = ' ';
						i = 0;
						while (i < max_iter) {
							x_x = (x * x) / 200;
							y_y = (y * y) / 200;
							if (x_x + y_y > 800 ) {
								the_char = '0' + i;
								if (i > 9) {
									the_char = '@';
								}
								i = max_iter;
							}
							y = x * y / 100 + y0;
							x = x_x - y_y + x0;
							i = i + 1;
						}
						putc(the_char);
						x0 = x0 + x_step;
					}
					putc('\n');
					y0 = y0 - y_step;
				}
			}
			} 
		}
	case 2
		{
			push {
			/*
			Simple prime number generator
			*/
			count = 1;
			n = 1;
			limit = 100;
			while (n < limit) {
				k=3;
				p=1;
				n=n+2;
				while ((k*k<=n) && (p)) {
					p=n/k*k!=n;
					k=k+2;
				}
				if (p) {
					print(n, " is prime\n");
					count = count + 1;
				}
			}
			print("Total primes found: ", count, "\n");
			} 
		}
	case 3
	{
		push {
		/*** test printing, embedded \n and comments with lots of '*' ***/ print(42); print("\nHello World\nGood Bye\nok\n"); print("Print a slash n - \\n.\n");
		}
	}
	case 4
	{
		push {
		 /* 99 bottles */ bottles = 99; while (bottles > 0) {
			print(bottles, " bottles of beer on the wall\n");
			print(bottles, " bottles of beer\n");
			print("Take one down, pass it around\n");
			bottles = bottles - 1;
			print(bottles, " bottles of beer on the wall\n\n");
			}
		}
	}
	case 5
	{
		push {
		/* FizzBuzz */ i = 1; while (i <= 100) {

			if (!(i % 15))
				print("FizzBuzz");
			else if (!(i % 3))
				print("Fizz");
			else if (!(i % 5))
				print("Buzz");
			else
				print(i);
				print("\n");
				i = i + 1;
			} 
		}
	}
	case 6
	{
		push {
			/* fibonacci of 44 is 701408733 */
			
			n = 44; i = 1; a = 0; b = 1; while (i < n) {
			
				w = a + b;
				a = b;
				b = w;
				i = i + 1;
			} print(w, "\n"); 
		}
	}
	case 7
	{
		push {
			/* 12 factorial is 479001600 */
			
			n = 12; result = 1; i = 1; while (i <= n) {
			
			result = result * i;
			i = i + 1;
			} print(result); 
		}
	}
	end select
	Form! 104, 60
	Refresh
	Print "Lexical Analyzer" : Refresh
	lexical_analyzer
	if not islet then exitr
	Print "Syntax Analyzer" : Refresh
	syntax_analyzer
	if not islet then exit
	Print "Code Generator" : Refresh
	CodeGenerator
	if not islet then exit
	if ask("Choose execution style", "Info", "Virtual Machine", "*M2000 Transpiler")=1 then
		Virtual_Machine_Interpreter
	else
		Transpiler_to_M2000
	end if
	Print "done"
	Set Fast 'restore speed setting
}
CompilerExample