|
<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$)
Subselect case Keywords(a$)
select case a$"if"
case a$="ifKeyword_if"
case a$="Keyword_ifelse"
case a$="elseKeyword_else"
case a$="Keyword_elsewhile"
case a$="whileKeyword_while"
case a$="Keyword_whileprint"
case a$="printKeyword_print"
case a$="Keyword_printputc"
case a$="putcKeyword_putc"
else a$="Keyword_putc"case
elsea$="Identifier case"+a$
end a$="Identifier "+a$select
end selectOutput$=a$+nl$
End Output$=a$+nl$sub
Sub End subSymbols(a$)
Subselect case Symbols(a$)
case " ", select case achr$(9)
case a$=" ", chr$(9)
case a$="("
case a$="(LeftParen"
case a$="LeftParen)"
case a$=")RightParen"
case a$="RightParen{"
case a$="{LeftBrace"
case a$="LeftBrace}"
case a$="}RightBrace"
case a$="RightBrace;"
case a$=";Semicolon"
case a$="Semicolon,"
case a$=",Comma"
case a$="Comma*"
case a$="*Op_multiply"
case a$="Op_multiply/"
case a$="/Op_divide"
case a$="Op_divide+"
case a$="+Op_add"
case a$="Op_add-"
case a$="-Op_subtract"
case a$="Op_subtract%"
case a$="%Op_mod"
case a$="Op_mod<"
{ if case Ahead("<=", offset+1) Then
{ if Ahead("=", offset+1) Then+
offset++a$="Op_lessequal"
a$="Op_lessequal"ColumnNo++
ColumnNo++else
elsea$="Op_less"
end a$="Op_less"if
end if}
case }">"
{ if case Ahead(">=", offset+1) Then
{ if Ahead("=", offset+1) Then+
offsetColumnNo++
ColumnNo++a$="Op_greaterequal"
a$="Op_greaterequal"else
elsea$="Op_greater"
end a$="Op_greater"if
end if}
case }"="
{ if case Ahead("=", offset+1) Then
{ if Ahead("=", offset+1) Then+
offsetColumnNo++
ColumnNo++a$="Op_equal"
a$="Op_equal"else
elsea$="Op_assign"
end a$="Op_assign"if
end if}
case }"!"
{ if case Ahead("!=", offset+1) Then
{ if Ahead("=", offset+1) Then+
offsetColumnNo++
ColumnNo++a$="Op_notequal"
a$="Op_notequal"else
elsea$="Op_not"
end a$="Op_not"if
end if}
case }"&"
{ if case Ahead("&", offset+1) Then
{ if Ahead("&", offset+1) Then+
offsetColumnNo++
ColumnNo++a$="Op_and"
a$="Op_and"else
elsea$=""
end a$=""if
end if}
case }"|"
{ if case Ahead("|", offset+1) Then
{ if Ahead("|", offset+1) Then+
offsetColumnNo++
ColumnNo++a$="Op_or"
a$="Op_or"else
elsea$=""
end a$=""if
end if}
else }case
else{Error case"Unrecognized character."+er$}
end {Error "Unrecognized character."+er$}select
if a$<>"" end selectthen
Output$=format$("{0::-10}{1::-10} ", LineNo, if ColumnNo)+a$<>"" then+nl$
end if
Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)+a$+nl$
End end ifSub
Sub End Subcheckerror()
Subif checkerror()offset>lim then {
ifError offset>lim"End-of-line thenwhile {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 else"End-of-file while scanning string literal.if Closing Ahead(nl$,offset)string thencharacter {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$){
}
Moduleenum syntax_analyzertokens (b$){
enumOp_add, tokensOp_subtract, Op_not=5, Op_multiply=10, Op_divide, Op_mod, {
Op_addOp_negate, Op_subtract, Op_not=5Op_less, Op_multiply=10Op_lessequal, Op_divideOp_greater, Op_modOp_greaterequal,
Op_equal, Op_negateOp_notequal, Op_lessOp_and, Op_lessequalOp_or, Op_greaterOp_assign=100, Op_greaterequalKeyword_if=110,
Op_equalKeyword_else, Op_notequalKeyword_while, Op_andKeyword_print, Op_orKeyword_putc, Op_assign=100LeftParen, Keyword_if=110RightParen,
LeftBrace, RightBrace, Keyword_elseSemicolon, Keyword_whileComma, Keyword_printIdentifier, Keyword_putcInteger, LeftParenString, RightParen,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, Inventory precedence=Op_multiplyOp_greaterequal:=1310, Op_divideOp_equal:=139, Op_modOp_notequal:=139, Op_addOp_assign:=12-1, Op_subtractOp_and:=125
Append precedence, Op_negateOp_or:=14, Op_not:=14, Op_less:=10, Op_lessequal:=10, Op_greater:=10 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, Inventory symbols=Op_multiplyOp_equal:="MultiplyEqual", Op_divideOp_notequal:="DivideNotEqual", Op_mod Op_and:="ModAnd", Op_addOp_or:="AddOr"
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_inputpush (,) ' Null
flushgetone(&op)
k=0repeat
Try {stmt(&op)
shift 2 ' swap two top push (,) ' Nullitems
push ("Sequence", array, getone(&oparray)
repeatk++
until stmt(&op)=End_of_Input
}
shift 2 ' swap two top items
er$=error$
push ("Sequence", array, array)
if er$<>"" then print er$ : flush: k++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
Documentclipboard Output$
Save.Doc Output$, "parse.t", prt_ast()Ansi
document Push Outputparse$
Load.Doc parse$,"parse.t", exitAnsi
Report clipboard Outputparse$
sub prt_ast(t)
Save.Doc Output$, "parse.t", Ansi
documentif parse$len(t)<1 then
Load.Doc parse Output$,="parse.t;", Ansi+nl$
Reportelse.if parse$len(t)=3 then
Output$=t#val$(0) +nl$
sub prt_ast(t#val(1)) : prt_ast(t#val(2))
if len(t)<1 thenelse
Output$=";"t#val$(0) +nl$
end else.if len(t)=3 then
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=(,), elseprev=op
if Output$op>=t#val$(0)Identifier +nl$then
end ifx=(line$,)
end sub getone(&op)
subelse.if expr(p)op=LeftParen ' only a numberthen
local x=paren_exp(,), prev=op
if op>x=Identifier thenarray
else.if op<10 x=(line$,)then
getone(&op)
else.if op=LeftParen thenexpr(precedence(int(Op_negate)))
read local paren_exp()y
if prev=Op_add x=arraythen
else.if op<10 then x=y
getone(&op)else
expr(precedence(int(if prev=Op_subtract then prev=Op_negate)))
read localx=(symbols(prev), y,(,))
End if prev=Op_add then
x=yelse
{error "??? else"+eval$(op)}
end if prev=Op_subtract then prev=Op_negate
local x=(symbols(prev), y,(,))prec
while exist(precedence, End ifint(op))
elseprev=op : prec=eval(precedence)
if prec<14 and prec>=p else {error "??? "+eval$(op)}exit
end ifgetone(&op)
localexpr(prec+1) ' all operators are left associative (use prec for right a.)
while existx=(symbols(precedence, int(opprev)), x, array)
End prev=op : prec=eval(precedence)While
Push if prec<14 and prec>=p else exitx
end sub
getone(&op)
sub paren_exp()
expr(prec+1) ' all operators are left associative (use prec for right a.)
x=expected(symbols(int(prev)), x, arrayLeftParen)
End Whilegetone(&op)
Push xexpr(0)
end subexpected(RightParen)
sub paren_expgetone(&op)
end sub
expected(LeftParen)
sub getonestmt(&op)
local exprt=(0,)
if op=Identifier expected(RightParen)then
getonet=(&opline$)
end sub getone(&op)
sub stmt expected(&opOp_assign)
local t=getone(,&op)
if op=Identifier thenexpr(0)
read local t=(line$)rightnode
Push getone(&op"Assign",t,rightnode)
expected(Op_assignSemicolon)
getone(&op)
else.if op=Semicolon expr(0)then
read local rightnodegetone(&op)
Push ("Assign;",t,rightnode)
else.if op=Keyword_print expected(Semicolon)then
getone(&op)
else.if op=Semicolon thenexpected(LeftParen)
getone(&op)repeat
Push getone(";",&op)
else.if op=Keyword_printString then
getone Push ("Prts",(line$,),(&op,))
expected getone(LeftParen&op)
repeatelse
getoneexpr(&op0)
ifPush op=String("Prti", thenarray,(,))
end Push ("Prts",(line$,),(,))if
t=("Sequence", t, getone(&oparray)
until elseop<>Comma
exprexpected(0RightParen)
Push ("Prti", array,getone(,)&op)
end ifexpected(Semicolon)
t=getone("Sequence", t, array&op)
push until op<>Commat
else.if op=Keyword_while expected(RightParen)then
getone(&op)
expectedparen_exp(Semicolon)
getonestmt(&op)
shift push t2
else.ifPush op=Keyword_while("While",array, thenarray)
else.if op=Keyword_if getone(&op)then
paren_expgetone(&op)
stmtparen_exp(&op)
shift 2stmt(&op)
local Push s2=("While",array, array)
else.if op=Keyword_ifKeyword_else then
getone(&op)
paren_expstmt(&op)
stmt(&op)read s2
end local s2=(,)if
shift if op=Keyword_else then2
Push ("If",array getone,(&op"If",array,s2))
else.if op=Keyword_putc stmt(&op)then
read s2getone(&op)
end ifparen_exp()
Push shift 2("Prtc",array,t)
Push ("If",array ,expected("If",array,s2)Semicolon)
else.if getone(&op=Keyword_putc then)
else.if op=LeftBrace getone(&op)then
paren_expBrace()
Push ("Prtc",array,t)else
error "Unkown Op" expected(Semicolon)
end getone(&op)if
end sub
else.if op=LeftBrace then
Sub Brace()
elsegetone(&op)
while op<>RightBrace and error "Unkown Op"op<>End_of_input
end if stmt(&op)
end sub t=("Sequence", t, array)
Sub Brace() end while
getoneexpected(&opRightBrace)
while op<>RightBrace and getone(&op<>End_of_input)
push stmt(&op)t
End Sub
t=("Sequence", t, array)
Sub expected(what)
end while
if not op=what then {Error "Expected expected"+eval$(what)+str$(LineNo)+","+Str$(RightBraceColumnNo)}
End Sub
getone(&op)
sub push tgetone(&op)
End Subop=End_of_input
Subwhile expected(what)cur<lim
cur++
if not op=what then {Error "Expected "+eval$(what)+str$(LineNo)+","+Str$(ColumnNo)}
End Subline$=trim$(lex$(cur))
subif getone(&op)line$<>"" then exit
end op=End_of_inputwhile
if cur=lim then exit while cur<limsub
cur++LineNo=Val(line$,"int",m)
line$=trimmid$(lexline$(cur), m)
if ColumnNo=Val(line$<>,"int" then exit,m)
line$=trim$(mid$(line$, end whilem))
Rem : Print LineNo, if cur=lim then exit subColumnNo
LineNom=Valinstr(line$,"int ",m)
if m>0 then op=Eval("."+leftpart$(line$, " ")) else line$op=mid$Eval("."+line$, m)
end sub
ColumnNo=Val(line$,"int",m)
}
line$=trim$(mid$(line$, m))
Module CodeGenerator (s$){
Rem : Print LineNo, ColumnNo
Function m=instrcode$(lineop$,") "){
if m>0 then op=Eval("."+leftpartformat$(line$, "{0::-6} {1}")), elsepc, op=Eval("."+line$)
end subpc++
}
Module CodeGeneratorFunction code2$(sop$, n$) {
Function code=format$("{0::-6} {1} {2}", pc, op$), {n$)
pc+=format$("{0::-6} {1}", pc, op$)5
pc++}
Function code3$(op$,pc, st, ed) }{
Function code2=format$("{0::-6} {1} ({2}) {3}", pc, op$, n$)ed-st-1, {ed)
}
=format$("{0::-6} {1} {2}", pc, op$, n$)
Enum tok pc+=5{
}gneg, gnot, gmul, gdiv, gmod, gadd, gle, gsub, glt
Functiongle, code3$(op$ggt,pc gge, stgeq, ed)gne, {gand, gor, gprtc, gprti, gprts,
gif, gwhile, gAssign, =format$("{0::-6} {1} ({2}) {3}"gSeq, pcgstring, op$gidentifier, ed-st-1gint, ed)gnone
}
\\ Inventories are lists with keys, or keys/data (key must be unique)
\\ there is one type more the Invetory EnumQueue tokwhich {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 Inventory DataSetlines$()
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 Stringslim=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 Document message$=nl$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 Dimpush lines$()to bottom of stack
CodeGenerator(Ast)
s$=filter$(s$,chr$(9)) \\ exclude tabs
Data Linescode$()=piece$(s$,nl$"halt") \\' breakappend to linesend of stack
\\ So now we get all data lim=len(Lines$(letters)) from stack
While not empty
Flush ' empty stack (there is a current stack of values which we use here)
Assembly$=letter$+nl$
end Load_Ast()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 Document Assembly$, Header$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
CodeGeneratorHeader$=nl$+Eval$(Aststr)
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 While not emptyHeader
Insert 1 Assembly$=letter$+nlHeader$
\\ Also we check for end whilewarnings
If len(message$)>2 then Assembly$="Warnings: "+nl$+message$
\\ So now we have to place them in order
\\ So now we get a Sort Assembly$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", While strAnsi
End
Header$=nl$+Eval$(str)
\\ subs have 10000 limit for recursion but can be extended to 1000000 or more.
End while
Sub Assembly$=nl$CodeGenerator(t)
\\If insertlen(t)=3 to line 1 the Headerthen
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
}
IfCase len(t)=3 thengif
select case t#val(0){
CaseCodeGenerator(t#val(1)) gSeq
local pc1=pc, CodeGenerator(t#val(1)) : CodeGenerator(t#val(2))pc2
Case gwhilepc+=5
{CodeGenerator(t#val(2)#val(1))
If len(t#val(2)#val(2))>0 local spc=pcthen
CodeGenerator(t#val(1)) pc2=pc
local pc1pc+=pc5
pc+=5data 'code3$("jz",pc1, roompc1, for jzpc)
CodeGenerator(t#val(2)#val(2))
data code3$("jzjmp",pc1pc2, pc1pc2, pc+5)
data code3$("jmp",pc, pc, spc)else
pc+=5data code3$("jz",pc1, 'pc1, room for jmppc)
}end If
Case gif}
Case {gAssign
CodeGenerator(t#val(1)) {
local pc1=pc, pc2CodeGenerator(t#val(2))
local pc+newvar_ok=5true
CodeGenerator(t#val(2)#val(1))
If len(t#val(2)#val(2))>0 then}
case gneg to gnot, gprtc to pc2=pcgprts
CodeGenerator(t#val(1)) : data pc+=5code$(mid$(eval$(t#val(0)),2))
case gmul to data code3$("jz",pc1, pc1, pc)gor
CodeGenerator(t#val(2)#val(2)){
data code3$CodeGenerator("jmp",pc2, pc2, pct#val(1))
elseCodeGenerator(t#val(2))
data code3code$("jz"mid$(eval$(t#val(0)),pc1, pc1, pc2))
end If }
End }select
Else.if len(t)=2 Case gAssignthen
select case {t#val(0)
Case CodeGenerator(t#val(2))gString
local newvar_ok=true{
local CodeGenerator(t#val(1))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
end CodeGenerator(t#val(1))If
Push CodeGeneratorcode2$(t#val"push",str$(2spos,0))
data code$(mid$(eval$(t#val(0)),2))}
Case }gInt
EndPush selectcode2$("push",t#val$(1), pc)
Else.ifCase len(t)=2 thengIdentifier
select case t#val(0){
Caselocal gStringipos
{If exist(dataset,t#val$(1)) then
localipos=Eval(dataset!) spos ' return position
else.if If exist(strings,t#val$(1))newvar_ok then
Append dataset, spos=evalt#val$(strings!1)
elseipos=len(dataset)-1
append strings, t#val$(1) else
message$="Variable "+t#val$(1)+" not spos=len(strings)-1initialized"+nl$
end If
If newvar_ok Push code2$("push",str$(spos,0))then
} Push code2$("store","["+str$(ipos, 0)+"]")
Case gIntelse
Push code2$("pushfetch",t#val"["+str$(1)ipos, pc0)+"]")
Caseend gIdentifierIf
{}
end local iposselect
End If exist(dataset,t#val$(1)) then
End Sub
ipos=Eval(dataset!) ' return position
Sub Load_Ast()
else.if newvar_ok then
If i>=lim then Push (,) : exit Append dataset, t#val$(1)sub
ipos=len(dataset)-1do
elseline$=Trim$(lines$(i))
message$="Variable "I+t#val$(1)+" not initialized"+nl$
tok$=piece$(line$," ")(0)
until line$<>"" or end Ifi>=lim
If newvar_oktok$="Identifier" then
Push code2$("store"gidentifier,"["+strtrim$(iposMid$(line$, 011))+"]")
else.if tok$="Integer" elsethen
long Push code2n=Val(Mid$("fetch","["+strline$(ipos, 08)+"]") ' check overflow
Push (gint, end IfTrim$(Mid$(line$,8)))
else.if tok$="String" }then
endPush select(gstring,Trim$(Mid$(line$,7)))
Endelse.if Iftok$=";" then
End Sub Push (,)
Sub Load_Ast() Else
Iflocal i>otok=lim then Push symb(,tok$) : exit sub
doLoad_Ast()
line$=Trim$Load_Ast(lines$(i))
I++Shift 2
tok$=piece$Push (line$otok,array," ")(0array)
End until line$<>"" or i>=limIf
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_lt_:=lambda->{sp--:returnReturn stack_, sp+1:=uint(if(sint(eval(code_stack_, pcsp+1))<sint(eval(stack_, assp))->-1, long0)):pcsp++=4}
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))<=0 then pc=sint(eval(code_stack_, pcsp))->-1, as long0) else pc):sp+=4+}
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_ne_:=lambda->{pcReturn stack_, sp+1:=uint(if(eval(code_stack_, pcsp+1)<>eval(stack_, assp)->-1, long0)):sp++}
Append func, fetch_eq_:=lambda->{sp--:Return stack_, sp+1:=uint(if(eval(stack_, sp+1)=eval(code_stack_, pcsp)->-1, as long0)):pcsp++=4}
Append func, store_prts_:=lambda->{ReturnPrint stack_#-2, evalstring$(code_, pc as long):=eval(stack_, sp));: Refresh:sp++:pc+=4}
Append func, add_prti_:=lambda->{ReturnPrint stack_#-2, sp+1:=uintstr$(sint(eval(stack_, sp+1))+sint(eval(stack_,0);: sp)))Refresh:sp++}}
Append func, sub_prtc_:=lambda->{ReturnPrint stack_#-2, sp+1:=uint(sintchrcode$(eval(stack_, sp+1))-sint(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:"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
This is an integer ascii Mandelbrot case jz_, jmp_generator
*/
Return code_, offset+1:=val(rightpart$(line$,")")) as long : offset+=4
left_edge= end select -420;
end ifright_edge=300;
Always top_edge=300;
\\Print "Press any key" :bottom_edge Push= key$ : Drop-300;
\\ Prepare VM x_step=7;
let pc=0, sp y_step=len(stack_)15; div 4
do max_iter=200;
y0 b=func(eval(code_, pc))top_edge;
while (y0 > bottom_edge) pc++{
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 the_char =300 '0' + i;
top_edge=300; if (i > 9) {
bottom_edge the_char = -300'@';
x_step=7; }
y_step i =15 max_iter;
}
max_iter y =200 x * y / 100 + y0;
x = x_x - y_y + x0;
y0 i = top_edgei + 1;
while (y0 > bottom_edge) { }
x0 = left_edge putc(the_char);
while (x0 <= x0 right_edge)+ {x_step;
y = 0;}
x = 0putc('\n');
y0 = y0 - the_char = ' '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
| 