M2000 Compiler Task: Difference between revisions
Content added Content deleted
mNo edit summary |
|||
Line 17: | Line 17: | ||
<lang M2000 Interpreter> |
<lang M2000 Interpreter> |
||
Module CompilerExample { |
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 |
|||
Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)+a$+nl$ |
|||
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-line while scanning string literal. Closing string character not found before end-of-line."+er$ |
|||
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$){ |
|||
} |
|||
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 |
|||
} |
|||
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 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" |
|||
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 |
|||
flush |
|||
k=0 |
|||
lex$()=piece$(b$,chr$(13)+chr$(10)) |
|||
Try { |
|||
lim=dimension(lex$(),1)-1 |
|||
push (,) ' Null |
|||
getone(&op) |
|||
repeat |
|||
stmt(&op) |
|||
shift 2 ' swap two top items |
|||
push ("Sequence", array, array) |
|||
k++ |
|||
until op=End_of_Input |
|||
} |
|||
shift 2 ' swap two top items |
|||
er$=error$ |
|||
push ("Sequence", array, array) |
|||
if er$<>"" then print er$ : flush: break |
|||
Print "Ast" |
|||
until op=End_of_Input |
|||
Document Output$ |
|||
prt_ast() |
|||
Push Output$ |
|||
if er$<>"" then print er$ : flush: break |
|||
exit |
|||
clipboard Output$ |
|||
Save.Doc Output$, "parse.t", Ansi |
|||
document parse$ |
|||
Load.Doc parse$,"parse.t", Ansi |
|||
Report parse$ |
|||
sub prt_ast(t) |
|||
Save.Doc Output$, "parse.t", Ansi |
|||
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 |
|||
Output$=t#val$(0) +nl$ |
|||
sub expr(p) ' only a number |
|||
prt_ast(t#val(1)) : prt_ast(t#val(2)) |
|||
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 |
|||
getone(&op) |
|||
sub paren_exp() |
|||
expr(prec+1) ' all operators are left associative (use prec for right a.) |
|||
expected(LeftParen) |
|||
getone(&op) |
|||
expr(0) |
|||
expected(RightParen) |
|||
getone(&op) |
|||
end sub |
|||
expected(LeftParen) |
|||
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) |
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 |
|||
else.if op=LeftBrace then |
|||
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 |
|||
t=("Sequence", t, array) |
|||
Sub expected(what) |
|||
end while |
|||
if not op=what then {Error "Expected "+eval$(what)+str$(LineNo)+","+Str$(ColumnNo)} |
|||
End Sub |
|||
getone(&op) |
|||
sub getone(&op) |
|||
op=End_of_input |
|||
while cur<lim |
|||
cur++ |
|||
if not op=what then {Error "Expected "+eval$(what)+str$(LineNo)+","+Str$(ColumnNo)} |
|||
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 |
|||
ColumnNo=Val(line$,"int",m) |
|||
} |
|||
line$=trim$(mid$(line$, m)) |
|||
Module CodeGenerator (s$){ |
|||
Rem : Print LineNo, ColumnNo |
|||
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) |
|||
} |
|||
=format$("{0::-6} {1} {2}", pc, op$, n$) |
|||
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. |
|||
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. |
|||
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. |
|||
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 |
|||
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. |
|||
\\ Push statement push to top, Data statement push to bottom of stack |
|||
CodeGenerator(Ast) |
|||
s$=filter$(s$,chr$(9)) \\ exclude tabs |
|||
Data code$("halt") ' append to end of stack |
|||
\\ 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$ |
|||
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 |
|||
\\ 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 |
|||
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 |
|||
\\ 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 have to place them in order |
|||
\\ 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) |
|||
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 |
|||
Sub CodeGenerator(t) |
|||
If len(t)=3 then |
|||
select case t#val(0) |
|||
Case gSeq |
|||
CodeGenerator(t#val(1)) : CodeGenerator(t#val(2)) |
|||
If len(message$)>2 then Assembly$="Warnings: "+nl$+message$ |
|||
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)) |
CodeGenerator(t#val(2)#val(2)) |
||
data code3$(" |
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$(" |
Push code2$("fetch","["+str$(ipos, 0)+"]") |
||
end If |
|||
} |
|||
end select |
|||
End If |
|||
End Sub |
|||
ipos=Eval(dataset!) ' return position |
|||
Sub Load_Ast() |
|||
else.if newvar_ok then |
|||
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 |
|||
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, 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->{ |
|||
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 |
|||
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$, 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 |
|||
{ |
|||
/* |
|||
Return code_, offset+1:=uint(val(line$)) as long : offset+=4 |
|||
This is an integer ascii Mandelbrot generator |
|||
*/ |
|||
Return code_, offset+1:=val(rightpart$(line$,")")) as long : offset+=4 |
|||
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 = ' '; |
|||
Push { |
|||
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; |
|||
} |
|||
} |
|||
} |
|||
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 |