This is a program for Rossetacode.org and first published here
Modules have a stack of values, and when we call a module we pass any argument in this stack, but stack is the current stack, from the caller. So from a module we can return results to same stack. So in console we have a current stack, and a Push 10, "ok" make two items, one at position 1 of stack as "ok" and a second at position 2 as 10 (default type double). To observe the stack we can use the Stack statement with no arguments. Its good first to flush the stack (to make it empty) using the Flush statement:
When we call a user function in an expression, interpreter give a fresh new stack of values, so any value on stack at the exit of function just removed as stack destroyed.
Stack pass values by value, and reference type by pointer (a reference is something else from a pointer). Reference type is an array, so if we push an array three time we push only three pointers. If we change the array after the push, then when we read the array we get the changed array. We can use Cons() function to make a copy of one or a copy of the merging of two or more arrays), and pass this new pointer as the array to stack, so only one pointer exist, and this only to stack.
So the following program use the stack, to shared by these modules:
The example program (783 lines) get a string in stack of values using a Push statement, and a string in curly brackets (including line separator the two characters crlf) with a context of a program written in a simple language, (which draw a Mandelbrot ascii image), and pass it to lexical analyzer, then to syntax analyzer then to code generator and then to virtual machine. All in one program, with one module the CompilerExample. (M2000 identifiers are not case sensitive, ecxept for labels, for using with goto and gosub - the BASIC type statements).
About scope in M2000. Each module and user function has own scope. A local variable always shadow a global one with the same name. We can use closures to lambda functions, passing them as copies. We can alter the value of a closure inside the lambda function. M2000 can use OOP but here not needed for this task. A subroutine is a code private to a module or and a function. In a subroutine we have the same scope as module or function, so we have to use Local to shadow any module's variable with same name, or when we call again (recursion, or mutual recursion happen). Subs have a limit of 10000 calls for private in module return stack, but we can change that to million calls, using the Recursion.Limit statement (or using Recursion.limit 0 for no limit until we get out of memory, including virtual memory), Modules and Functions have three number to indicate the recursion level, which are the three type of calls, in M2000, the simple call of a module using only the name (6354 calls, but no recursion allowed, so we have to use mutual recursion for global modules), the call using the Call statement for functions and modules (also stack of values are the same for each call, so we get about 5422 calls) and functions calls in expressions (we have new stack of values for every call, about 3233 calls). Arguments passed to stack of values when we call something, not to the return stack. When interpreter loaded to execute, check the length of stack, so we can get these values for calls, using Monitor statement from console. So interpreter has one return stack (size defined in M2000.exe), and for each execution object (modules and functions have execution objects) there is also a subroutine stack. Modules also have a pointer to parent stack of values, and functions (if called in expressions) hold own stack of values. Except return stack, all other stacks are kept in heap.
Local Scope. In Virtual_Machine_Interpreter we use a Call Local to call a lambda function. The Call Local place the current scope to the function which we call. We can use this call for modules and normal functions. When we use arguments we have to use new before the first argument to make the Read new arg1, arg2 ... so we can shadow same name variables. In subroutines these happen automatic. So a call local is like a call to subroutine. Calling a lambda function is a kind of indirect call. A lambda function is a value type. So each time we use a copy (see b=func(eval(code_, pc)) where b get a copy from inventory func() when we pass an opcode from buffer code_ at offset pc)
Use of Tuple. M2000 use a kind of array as tuple. So a (,) is the empty tuple (also called auto array). A ((1,2),(3,4)) is a tuple with two tuples as items. A (1,) is a tuple with one item. A (1) is number 1. A a=("a","b", (1,2), 100#) is a tuple with strings as the two first items amd a tuple as third and a currency type number as fourth item. Print a#val(2)#val(1)=2 because item 2 is the third item which is a tuple, and item 1 is number 2 (if we want the string value we have to use last val as val$). We make, in the compiler task an AST tree as Tuple in Tuple. The variable a is a pointer to tuple. We can push a tuple to stack and pop it or pick it (we can peek a value from stack using Stackitem() for top or item 1, or we can peek from another position, say 3 we use StackItem(3), and we can use Stacktype$(3) to check for type in a more dynamic perspective)
We use some ready made objects, like Invetories (a type of vector), enum types, Buffer (memory block). Also we use Form ! 120, 60 (for TV to use safe area we use this !, but we can use Form 120, 60 without it for a monitor), which give us a console with 120 characters per line, for 60 lines. We want big width for characters in a line to use it for drawing with ascii. M2000 console works for graphics. Using Move 6000,6000 : Circle 3000 we make a circle of 3000 twips, with a center at 6000twips from left side, and 6000twips from upper side. But for the task we use ascii drawing. We didn't use the Print ordinary statement, but a variant which is like to send unicode characters to a file, but we use #-2 to send it to console screen. The ordinary Print not process CR and LF from chars (the print as spaces), because we use @() to move the cursor to print. Also normal Print statement use columns, so Print #-2 bypass columns, and print to the next. Both Print and Print #-2 use the ; for not using a new line as the last action of statement.
Modules have a stack of values, and when we call a module we pass any argument in this stack, but stack is the current stack, from the caller. So from a module we can return results to same stack. So in console we have a current stack, and a Push 10, "ok" make two items, one at position 1 of stack as "ok" and a second at position 2 as 10 (default type double). To observe the stack we can use the Stack statement with no arguments. Its good first to flush the stack (to make it empty) using the Flush statement:
Flush
Push 10, "ok"
Stack ' show "ok" 1
Read a$, x
Print a$, x, empty=true ' yes is true
Push 10 : Push "ok"
Data 20 ' this goes to end of stack
Stack ' show "ok" 10 20
Data 1,2,"end"
Stack ' show "ok" 10 20 1 2 "end"
Module Consume { Stack : Read x : Drop x}
Consume 3 ' show 3 "ok" 10 20 1 2 "end"
Stack ' show 1 2 "end"
Print Match("NNS")=True
Drop Stack.Size ' same as Flush
Print Empty=True ' true
Push 10, "ok"
Stack ' show "ok" 1
Read a$, x
Print a$, x, empty=true ' yes is true
Push 10 : Push "ok"
Data 20 ' this goes to end of stack
Stack ' show "ok" 10 20
Data 1,2,"end"
Stack ' show "ok" 10 20 1 2 "end"
Module Consume { Stack : Read x : Drop x}
Consume 3 ' show 3 "ok" 10 20 1 2 "end"
Stack ' show 1 2 "end"
Print Match("NNS")=True
Drop Stack.Size ' same as Flush
Print Empty=True ' true
When we call a user function in an expression, interpreter give a fresh new stack of values, so any value on stack at the exit of function just removed as stack destroyed.
Stack pass values by value, and reference type by pointer (a reference is something else from a pointer). Reference type is an array, so if we push an array three time we push only three pointers. If we change the array after the push, then when we read the array we get the changed array. We can use Cons() function to make a copy of one or a copy of the merging of two or more arrays), and pass this new pointer as the array to stack, so only one pointer exist, and this only to stack.
So the following program use the stack, to shared by these modules:
lexical_analyzer, syntax_analyzer, CodeGenerator, Virtual_Machine_InterpreterAlso we use Set Fast ! and Set Fast, one for changing the way which interpreter control screen refresh, the "Extreme" Fast !, and the "Normal" Fast (there is also the Set Slow). We use Set to send the line of code to command line interpreter (global name space). We can use Fast !, Fast and Slow in M2000 console without Set statement.
The example program (783 lines) get a string in stack of values using a Push statement, and a string in curly brackets (including line separator the two characters crlf) with a context of a program written in a simple language, (which draw a Mandelbrot ascii image), and pass it to lexical analyzer, then to syntax analyzer then to code generator and then to virtual machine. All in one program, with one module the CompilerExample. (M2000 identifiers are not case sensitive, ecxept for labels, for using with goto and gosub - the BASIC type statements).
About scope in M2000. Each module and user function has own scope. A local variable always shadow a global one with the same name. We can use closures to lambda functions, passing them as copies. We can alter the value of a closure inside the lambda function. M2000 can use OOP but here not needed for this task. A subroutine is a code private to a module or and a function. In a subroutine we have the same scope as module or function, so we have to use Local to shadow any module's variable with same name, or when we call again (recursion, or mutual recursion happen). Subs have a limit of 10000 calls for private in module return stack, but we can change that to million calls, using the Recursion.Limit statement (or using Recursion.limit 0 for no limit until we get out of memory, including virtual memory), Modules and Functions have three number to indicate the recursion level, which are the three type of calls, in M2000, the simple call of a module using only the name (6354 calls, but no recursion allowed, so we have to use mutual recursion for global modules), the call using the Call statement for functions and modules (also stack of values are the same for each call, so we get about 5422 calls) and functions calls in expressions (we have new stack of values for every call, about 3233 calls). Arguments passed to stack of values when we call something, not to the return stack. When interpreter loaded to execute, check the length of stack, so we can get these values for calls, using Monitor statement from console. So interpreter has one return stack (size defined in M2000.exe), and for each execution object (modules and functions have execution objects) there is also a subroutine stack. Modules also have a pointer to parent stack of values, and functions (if called in expressions) hold own stack of values. Except return stack, all other stacks are kept in heap.
Local Scope. In Virtual_Machine_Interpreter we use a Call Local to call a lambda function. The Call Local place the current scope to the function which we call. We can use this call for modules and normal functions. When we use arguments we have to use new before the first argument to make the Read new arg1, arg2 ... so we can shadow same name variables. In subroutines these happen automatic. So a call local is like a call to subroutine. Calling a lambda function is a kind of indirect call. A lambda function is a value type. So each time we use a copy (see b=func(eval(code_, pc)) where b get a copy from inventory func() when we pass an opcode from buffer code_ at offset pc)
Use of Tuple. M2000 use a kind of array as tuple. So a (,) is the empty tuple (also called auto array). A ((1,2),(3,4)) is a tuple with two tuples as items. A (1,) is a tuple with one item. A (1) is number 1. A a=("a","b", (1,2), 100#) is a tuple with strings as the two first items amd a tuple as third and a currency type number as fourth item. Print a#val(2)#val(1)=2 because item 2 is the third item which is a tuple, and item 1 is number 2 (if we want the string value we have to use last val as val$). We make, in the compiler task an AST tree as Tuple in Tuple. The variable a is a pointer to tuple. We can push a tuple to stack and pop it or pick it (we can peek a value from stack using Stackitem() for top or item 1, or we can peek from another position, say 3 we use StackItem(3), and we can use Stacktype$(3) to check for type in a more dynamic perspective)
Print
(1,2,3,"a","b")#max()=3
'true
Print (1,2,3,"a","b")#max$()="b" ' true
Print (1,2,3,"a","b")#max$()="b" ' true
We use some ready made objects, like Invetories (a type of vector), enum types, Buffer (memory block). Also we use Form ! 120, 60 (for TV to use safe area we use this !, but we can use Form 120, 60 without it for a monitor), which give us a console with 120 characters per line, for 60 lines. We want big width for characters in a line to use it for drawing with ascii. M2000 console works for graphics. Using Move 6000,6000 : Circle 3000 we make a circle of 3000 twips, with a center at 6000twips from left side, and 6000twips from upper side. But for the task we use ascii drawing. We didn't use the Print ordinary statement, but a variant which is like to send unicode characters to a file, but we use #-2 to send it to console screen. The ordinary Print not process CR and LF from chars (the print as spaces), because we use @() to move the cursor to print. Also normal Print statement use columns, so Print #-2 bypass columns, and print to the next. Both Print and Print #-2 use the ; for not using a new line as the last action of statement.
2022 November
We can choose from a message box the virtual machine or the M2000 transpiler. The M2000 transpiler get the same input as the virtual machine from code generator, and make a module, then register to M2000 interpreter with name Run and execute it. For each mnemonic we have module inside Run module, except for fetch and store which we have subroutines. We use the stack of values of M2000 for the stack machine. Also we leave the numbers (address for the virtual machine), because M2000 handle these as numeric labels, and we can use Goto for jump, The Jump on zero (jz mnemonic) we use the If number Else XXX where XXX is the numeric label. The read only variable Number just pop a value from stack (if isn't numeric we get an error but here we now it is numeric).
So this code (Courier font) is actual a M2000 program; The module RUN. See the Inline statement which we place the module as local module of Transpiler_to_M2000 module, which is local to CompilerExample which is local to whatever module name you give to module where you copy the code.
Module Run {Global z
Module Halt {Error "stop"}
Module neg {push -number}
Module not {push number=0}
Module and {push sint(binary.and(uint(number), uint(number)))}
Module or {push sint(binary.or(uint(number), uint(number)))}
Module gt {push number<number}
Module lt {push number>number}
Module ge {push number<=number}
Module le {push number>=number}
Module ne {push number<>number}
Module eq {push number=number}
Module mul {push number*number}
Module div {shift 2 : push number div number}
Module mod {shift 2 : push number mod number}
Module sub {shift 2 : push number - number}
Module add {push number + number}
Module prtc {Print #-2, chrcode$(number);:Refresh}
Module prts {Print #-2, var$(number);:Refresh}
Module prti {Print #-2, str$(number, 0);:Refresh}
Dim Base 0, var(15)
Try {
0 push 420
5 neg
6 store(0)
11 push 300
16 store(1)
21 push 300
26 store(2)
31 push 300
36 neg
37 store(3)
42 push 7
47 store(4)
52 push 15
57 store(5)
62 push 200
67 store(6)
72 fetch(2)
77 store(7)
82 fetch(7)
87 fetch(3)
92 gt
93 if number else 423
98 fetch(0)
103 store(8)
108 fetch(8)
113 fetch(1)
118 lt
119 if number else 396
124 push 0
129 store(9)
134 push 0
139 store(10)
144 push 32
149 store(11)
154 push 0
159 store(12)
164 fetch(12)
169 fetch(6)
174 lt
175 if number else 369
180 fetch(10)
185 fetch(10)
190 mul
191 push 200
196 div
197 store(13)
202 fetch(9)
207 fetch(9)
212 mul
213 push 200
218 div
219 store(14)
224 fetch(13)
229 fetch(14)
234 add
235 push 800
240 gt
241 if number else 298
246 push 48
251 fetch(12)
256 add
257 store(11)
262 fetch(12)
267 push 9
272 gt
273 if number else 288
278 push 64
283 store(11)
288 fetch(6)
293 store(12)
298 fetch(10)
303 fetch(9)
308 mul
309 push 100
314 div
315 fetch(7)
320 add
321 store(9)
326 fetch(13)
331 fetch(14)
336 sub
337 fetch(8)
342 add
343 store(10)
348 fetch(12)
353 push 1
358 add
359 store(12)
364 goto 164
369 fetch(11)
374 prtc
375 fetch(8)
380 fetch(4)
385 add
386 store(8)
391 goto 108
396 push 10
401 prtc
402 fetch(7)
407 fetch(5)
412 sub
413 store(7)
418 goto 82
423 halt
}
End
Sub store(x)
Read var(x)
End Sub
Sub fetch(x)
Push var(x)
End Sub
}
And this is the program (we have to copy this in a module), 981 lines of code from both languages..
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
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, strings$(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
profiler
let pc=0, sp=len(stack_) div 4
do
b=func(eval(code_, pc))
pc++
call local b()
until exit_now
Print "", round(Timecount/1000,2),"s"
}
Module Transpiler_to_M2000 (code$){
Print #-2, "Virtual Assembly Code:"+{
}+code$
Print "Prepare M2000 Code"
Flush
prolog$={Global z
Module Halt {Error "stop"}
Module neg {push -number}
Module not {push number=0}
Module and {push sint(binary.and(uint(number), uint(number)))}
Module or {push sint(binary.or(uint(number), uint(number)))}
Module gt {push number<number}
Module lt {push number>number}
Module ge {push number<=number}
Module le {push number>=number}
Module ne {push number<>number}
Module eq {push number=number}
Module mul {push number*number}
Module div {shift 2 : push number div number}
Module mod {shift 2 : push number mod number}
Module sub {shift 2 : push number - number}
Module add {push number + number}
Module prtc {Print #-2, chrcode$(number);:Refresh}
Module prts {Print #-2, format$(var$(number));:Refresh}
Module prti {Print #-2, str$(number, 0);:Refresh}
}
Variable$=lambda$ (many, Name$, glob as boolean=false)->{
if many else exit
if glob then
="Global "+name$+"(0 to "+str$(many,0)+")"+{
}
else
="Dim Base 0, "+name$+"("+str$(many,0)+")"+{
}
end if
}
firstline$=leftpart$(code$,13)
code$=rightpart$(code$, 10)
firstline$=rightpart$(firstline$, ": ")
Vars=val(firstline$)
firstline$=rightpart$(firstline$, ": ")
Strings=val(firstline$)
document feedstrings$
if Strings Then
for i=0 to Strings-1
firstline$=Trim$(leftpart$(code$,13))
code$=rightpart$(code$, 10)
feedstrings$="var$("+str$(i,0)+") = "+firstline$+{
}
next
end if
stack new {
{
g$=leftpart$(code$, " (")
if g$="" or code$="" then
data code$ : code$="": exit
end if
data g$
code$=rightpart$(code$, 41)
loop
}
while not empty{
read g$
code$+=g$
}
}
code$=replace$("]", ")", code$)
code$=replace$("fetch [", "fetch(", code$)
code$=replace$("store [", "store(", code$)
code$=replace$("jmp ", "goto ", code$)
code$=replace$("jz", "if number else ", code$)
Subs$={
End
Sub store(x)
Read var(x)
End Sub
Sub fetch(x)
Push var(x)
End Sub
}
document M2000Code$="Module Run {" +prolog$ + Variable$(Vars,"var")
M2000Code$=Variable$(Strings,"var$", true) +feedstrings$ + "Try {" + {
} + code$+"}"+Subs$+"}"
//clipboard M2000code$
//exit
Inline M2000Code$
Print "Press any key" : Push key$ : Drop
profiler
Run
Print round(Timecount/1000,2),"s"
}
print "choose example",
menu "Mandelbrot", "primes","test case 4", "99 Bottles of Beer", "FizzBuzz", "fibonacci of 44 is 701408733", "12 factorial is 479001600"
if menu then print menu$(menu) else exit
select case menu
case 1
{
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;
}
}
}
}
case 2
{
push {
/*
Simple prime number generator
*/
count = 1;
n = 1;
limit = 100;
while (n < limit) {
k=3;
p=1;
n=n+2;
while ((k*k<=n) && (p)) {
p=n/k*k!=n;
k=k+2;
}
if (p) {
print(n, " is prime\n");
count = count + 1;
}
}
print("Total primes found: ", count, "\n");
}
}
case 3
{
push {
/*** test printing, embedded \n and comments with lots of '*' ***/ print(42); print("\nHello World\nGood Bye\nok\n"); print("Print a slash n - \\n.\n");
}
}
case 4
{
push {
/* 99 bottles */ bottles = 99; while (bottles > 0) {
print(bottles, " bottles of beer on the wall\n");
print(bottles, " bottles of beer\n");
print("Take one down, pass it around\n");
bottles = bottles - 1;
print(bottles, " bottles of beer on the wall\n\n");
}
}
}
case 5
{
push {
/* FizzBuzz */ i = 1; while (i <= 100) {
if (!(i % 15))
print("FizzBuzz");
else if (!(i % 3))
print("Fizz");
else if (!(i % 5))
print("Buzz");
else
print(i);
print("\n");
i = i + 1;
}
}
}
case 6
{
push {
/* fibonacci of 44 is 701408733 */
n = 44; i = 1; a = 0; b = 1; while (i < n) {
w = a + b;
a = b;
b = w;
i = i + 1;
} print(w, "\n");
}
}
case 7
{
push {
/* 12 factorial is 479001600 */
n = 12; result = 1; i = 1; while (i <= n) {
result = result * i;
i = i + 1;
} print(result);
}
}
end select
Form! 104, 60
Refresh
Print "Lexical Analyzer" : Refresh
lexical_analyzer
if not islet then exitr
Print "Syntax Analyzer" : Refresh
syntax_analyzer
if not islet then exit
Print "Code Generator" : Refresh
CodeGenerator
if not islet then exit
if ask("Choose execution style", "Info", "Virtual Machine", "*M2000 Transpiler")=1 then
Virtual_Machine_Interpreter
else
Transpiler_to_M2000
end if
Print "done"
Set Fast 'restore speed setting
}
CompilerExample
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου
You can feel free to write any suggestion, or idea on the subject.