Σάββατο, 13 Απριλίου 2019

Compiler Task

This is a program for Rossetacode.org and first published here




Modules have a stack of values, and when we call a module we pass any argument in this stack, but stack is the current stack, from the caller. So from a module we can return results to same stack. So in console we have a current stack, and a Push 10, "ok"  make two items, one at position 1 of stack as "ok" and a second at position 2 as 10 (default type double). To observe the stack we can use the Stack statement with no arguments. Its good first to flush the stack (to make it empty) using the Flush statement:

Flush
Push 10, "ok"
Stack ' show "ok" 1
Read a$, x
Print a$, x, empty=true ' yes is true
Push 10 : Push "ok"
Data 20 ' this goes to end of stack
Stack ' show "ok" 10 20
Data 1,2,"end"
Stack ' show "ok" 10 20 1 2 "end"
Module Consume { Stack : Read x : Drop x}
Consume 3 ' show 3 "ok" 10 20 1 2 "end"
Stack  ' show 1 2 "end"
Print Match("NNS")=True
Drop Stack.Size ' same as Flush
Print Empty=True ' true


When we call a user function in an expression, interpreter give a fresh new stack of values, so any value on stack at the exit of function just removed as stack destroyed.

Stack pass values by value, and reference type by pointer (a reference is something else from a pointer). Reference type is an array, so if we push an array three time we push only three pointers. If we change the array after the push, then when we read the array we get the changed array. We can use Cons() function to make a copy of one or a copy of the merging of two or more arrays), and pass this new pointer as the array to stack, so only one pointer exist, and this only to stack.

So the following program use the stack, to shared by these modules:

lexical_analyzer, syntax_analyzer, CodeGenerator, Virtual_Machine_Interpreter 


Also we use Set Fast ! and Set Fast, one for changing the way which interpreter control screen refresh, the "Extreme" Fast !, and the "Normal" Fast (there is also the Set Slow). We use Set to send the line of code to command line interpreter (global name space). We can use Fast !, Fast and Slow in M2000 console without Set statement.

The example program (783 lines) get a string in stack of values using a Push statement, and a string in curly brackets (including line separator the two characters crlf) with a context of a program written in a simple language, (which draw a Mandelbrot ascii image), and pass it to lexical analyzer, then to syntax analyzer then to code generator and then to virtual machine. All in one program, with one module the CompilerExample. (M2000 identifiers are not case sensitive, ecxept for labels, for using with goto and gosub - the BASIC type statements).

About scope in M2000. Each module and user function has own scope. A local variable always shadow a global one with the same name. We can use closures to lambda functions, passing them as copies. We can alter the value of a closure inside the lambda function. M2000 can use OOP but here not needed for this task. A subroutine is a code private to a module or and a function. In a subroutine we have the same scope as module or function, so we have to use Local to shadow any module's variable with same name, or when we call again (recursion, or mutual recursion happen). Subs have a limit of 10000 calls for private in module return stack, but we can change that to million calls, using the Recursion.Limit statement (or using Recursion.limit 0 for no limit until we get out of memory, including virtual memory), Modules and Functions have three number to indicate the recursion level, which are the three type of calls, in M2000, the simple call of a module using only the name (6354 calls, but no recursion allowed, so we have to use mutual recursion for global modules), the call using the Call statement for functions and modules (also stack of values are the same for each call, so we get about 5422 calls) and functions calls in expressions (we have new stack of values for every call, about 3233 calls). Arguments passed to stack of values when we call something, not to the return stack. When interpreter loaded to execute, check the length of stack, so we can get these values for calls, using Monitor statement from console. So interpreter has one return stack (size defined in M2000.exe), and for each execution object (modules and functions have execution objects) there is also a subroutine stack. Modules also have a pointer to parent stack of values, and functions (if called in expressions) hold own stack of values. Except return stack, all other stacks are kept in heap.

Local Scope. In Virtual_Machine_Interpreter we use a Call Local to call a lambda function. The Call Local place the current scope to the function which we call. We can use this call for modules and normal functions. When we use arguments we have to use new before the first argument to make the Read new arg1, arg2 ... so we can shadow same name variables. In subroutines these happen automatic. So a call local is like a call to subroutine. Calling a lambda function is a kind of indirect call. A lambda function is a value type. So each time we use a copy (see b=func(eval(code_, pc)) where b get a copy from inventory func() when we pass an opcode from buffer code_ at offset pc)


Use of Tuple. M2000 use a kind of array as tuple. So a (,) is the empty tuple (also called auto array). A ((1,2),(3,4)) is a tuple with two tuples as items. A (1,) is a tuple with one item. A (1) is number 1.  A a=("a","b", (1,2), 100#) is a tuple with strings as the two first items amd a tuple as third and a currency type number as fourth item. Print a#val(2)#val(1)=2 because item 2 is the third item which is a tuple, and item 1 is number 2 (if we want the string value we have to use last val as val$). We make, in the compiler task an AST tree as Tuple in Tuple. The variable a is a pointer to tuple. We can push a tuple to stack and pop it or pick it (we can peek a value from stack using Stackitem() for top or item 1, or we can peek from another position, say 3 we use StackItem(3), and we can use Stacktype$(3) to check for type in a more dynamic perspective)


Print (1,2,3,"a","b")#max()=3 'true
Print (1,2,3,"a","b")#max$()="b" ' true


We use some ready made objects, like Invetories (a type of vector), enum types, Buffer (memory block). Also we use Form ! 120, 60  (for TV to use safe area we use this !, but we can use Form 120, 60 without it for a monitor), which give us a console with 120 characters per line, for 60 lines. We want big width for characters in a line to use it for drawing with ascii. M2000 console works for graphics. Using Move 6000,6000 : Circle 3000 we make a circle of 3000 twips, with a center at 6000twips from left side, and 6000twips from upper side. But for the task we use ascii drawing. We didn't use the Print ordinary statement, but a variant which is like to send unicode characters to a file, but we use #-2 to send it to console screen. The ordinary Print not process CR and LF from chars (the print as spaces), because we use @() to move the cursor to print. Also normal Print statement use columns, so Print #-2 bypass columns, and print to the next. Both Print and Print #-2  use the ; for not using a new line as the last action of statement.




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 numbern 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, string$(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
                let pc=0, sp=len(stack_) div 4
                do
                        b=func(eval(code_, pc))
                        pc++
                        call local b()
                until exit_now
                Print "done"
        }
        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;
                }
        }
        } 
 
        Form ! 120, 60
        Refresh
        Print "Lexical Analyzer" : Refresh
        lexical_analyzer
        Print "Syntax Analyzer" : Refresh
        syntax_analyzer
        Print "Code Generator" : Refresh
        CodeGenerator
        Virtual_Machine_Interpreter
        Set Fast 'restore speed setting
}
CompilerExample