M2000 Compiler Task: Difference between revisions

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

Revision as of 21:53, 18 July 2019

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

M2000 Interpreter

<lang 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, 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 "Syntaxl Analyzer" : Refresh syntax_analyzer Print "Code Generator" : Refresh CodeGenerator Virtual_Machine_Interpreter Set Fast 'restore speed setting } CompilerExample </lang>