Τετάρτη, 30 Ιανουαρίου 2019

The final task for a compiler written in M2000 for rosetta.org
Four parts:

  • Lexical_analyzer
  • Syntax_analyzer
  • CodeGenerator
  • Virtual_Machine_Interpreter
Open M2000.exe write Edit A paste the code below, press esc, and write A and press enter.In Rosetta.org you can find samples for this tiny language.


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 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
        }
        \\ module to print a string to console using codes, 13, 10, 9
        Module printsrv (a$) {
                for i=1 to len(a$)
                        select case chrcode(Mid$(a$,i,1))
                        case 13
                                cursor 0
                        case 10
                                cursor 0 : Print
                        case 9
                                cursor ((pos+tab) div tab)*tab
                        else case
                        {
                                m=pos :if pos>=width then Print : m=pos
                                Print Mid$(a$,i,1);
                                if m<=width then cursor m+1
                        }
                        end select
                next i
        }
        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_
        }
        Rem : Form 120, 60 ' change console width X height to run Ascii Mandlebrot examlpe
        Report "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 {
                func=eval(code_, pc)
                pc++     
                select case func 
                case halt_
                        exit
                case push_
                        sp--:return stack_, sp:=eval(code_, pc as long):pc+=4
                case jz_
                        sp++: if eval(stack_, sp-1)=0 then pc=eval(code_, pc as long) else pc+=4
                case jmp_
                        pc=eval(code_, pc as long)
                case fetch_
                        sp--:Return stack_, sp:=eval(stack_, eval(code_, pc as long)):pc+=4
                case store_
                        Return stack_, eval(code_, pc as long):=eval(stack_, sp):sp++:pc+=4
                case add_
                        Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))+sint(eval(stack_, sp))):sp++
                case sub_
                        Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))-sint(eval(stack_, sp))):sp++
                case mul_
                        Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))*sint(eval(stack_, sp))):sp++
                case div_
                        Return stack_, sp+1:=uint(sint(eval(stack_, sp+1)) div sint(eval(stack_, sp))):sp++
                case mod_
                        Return stack_, sp+1:=uint(sint(eval(stack_, sp+1)) mod sint(eval(stack_, sp))) :sp++
                case not_
                        Return stack_, sp:=if(eval(stack_, sp)=0->uint(-1),0)
                case neg_  \\ we can use neg(sint(value))+1 or uint(-sint(value))
                        Return stack_, sp:=uint(-sint(eval(stack_, sp)))
                case and_
                        Return stack_, sp+1:=binary.and(eval(stack_, sp+1),eval(stack_, sp)):sp++       
                case or_
                        Return stack_, sp+1:=binary.or(eval(stack_, sp+1),eval(stack_, sp)):sp++        
                case lt_
                        Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))<sint(eval(stack_, sp))->-1, 0)):sp++
                case gt_
                        Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))>sint(eval(stack_, sp))->-1, 0)):sp++
                case le_
                        Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))<=sint(eval(stack_, sp))->-1, 0)):sp++
                case ge_
                        Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))>=sint(eval(stack_, sp))->-1, 0)):sp++
                case ne_
                        Return stack_, sp+1:=uint(if(eval(stack_, sp+1)<>eval(stack_, sp)->-1, 0)):sp++
                case eq_
                        Return stack_, sp+1:=uint(if(eval(stack_, sp+1)=eval(stack_, sp)->-1, 0)):sp++
                case prts_
                        printsrv strings$(eval(stack_,sp)):sp++
                case prti_
                        printsrv str$(sint(eval(stack_,sp)),0):sp++
                case prtc_
                        printsrv chrcode$(eval(stack_,sp)):sp++
                else case
                        Error "Unkown op "+str$(func) 
                end select                      
        } always
        Print "done"
}
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
}
 
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
lexical_analyzer
syntax_analyzer
CodeGenerator
Virtual_Machine_Interpreter


Δεν υπάρχουν σχόλια:

Δημοσίευση σχολίου