M2000 Compiler Task: Difference between revisions

lim=Len(a$)

LineNo=1

ColumnNo=1

Document Output$

Buffer Scanner as Integer*lim

Return Scanner, 0:=a$

offset=0

buffer1$=""

flag_rem=true

Ahead=lambda Scanner (a$, offset)->{

=false

Try {

// second parameter is the offset in buffer units

// third parameter is length in bytes

=Eval$(Scanner, offset,2*len(a$))=a$

}

}

Ahead2=lambda Scanner (a$, offset)->{

=false

Try {

=Eval$(Scanner, offset,2) ~ a$

}

}

const nl$=chr$(13)+chr$(10), quo$="""", er$="@", Ansi=3

Try {

Do

If Ahead("/*", offset) Then {

offset+=2 : ColumnNo+=2

While not Ahead("*/", offset)

If Ahead(nl$, offset) Then

lineNo++: ColumnNo=1 : offset+=2

Else

offset++ : ColumnNo++

End If

if offset>lim then

Error "End-of-file in comment. Closing comment characters not found"+er$

End if

End While

offset+=2 : ColumnNo+=2

} Else.if Ahead(nl$, offset) Then{

LineNo++: ColumnNo=1

offset+=2

} Else.if Ahead(quo$, offset) Then {

Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)

offset++ : ColumnNo++

strin=offset

While not Ahead(quo$, offset)

If Ahead("/", offset) Then

offset+=2 : ColumnNo+=2

else

offset++ : ColumnNo++

End if

checkerror()

End While

Output$="String "+quote$(Eval$(Scanner, strin, (offset-strin)*2))+nl$

offset++ : ColumnNo++

} Else.if Ahead("'", offset) Then {

Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)

offset++ : ColumnNo++

strin=offset

While not Ahead("'", offset)

If Ahead("/", offset) Then

offset+=2 : ColumnNo+=2

else

offset++ : ColumnNo++

End if

checkerror()

End While

lit$=format$(Eval$(Scanner, strin, (offset-strin)*2))

select case len(lit$)

case 1

Output$="Integer "+str$(asc(lit$),0)+nl$

case >1

{Error "Multi-character constant."+er$}

case 0

{Error "Empty character constant."+er$}

end select

offset++ : ColumnNo++

} Else.if Ahead2("[a-z]", offset) Then {

strin=offset

Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)

offset++ : ColumnNo++

While Ahead2("[a-zA-Z0-9_]", offset)

offset++ : ColumnNo++

End While

Keywords(Eval$(Scanner, strin, (offset-strin)*2))

} Else.if Ahead2("[0-9]", offset) Then {

strin=offset

Output$=format$("{0::-10}{1::-10} Integer ", LineNo, ColumnNo)

offset++ : ColumnNo++

While Ahead2("[0-9]", offset)

offset++ : ColumnNo++

End While

if Ahead2("[a-zA-Z_]", offset) then

{Error " Invalid number. Starts like a number, but ends in non-numeric characters."+er$}

else

Output$=Eval$(Scanner, strin, (offset-strin)*2)+nl$

end if

} Else {

Symbols(Eval$(Scanner, Offset, 2))

offset++ : ColumnNo++

}

Until offset>=lim

}

er1$=leftpart$(error$,er$)

if er1$<>"" then

Print

Report "Error:"+er1$

Output$="(Error)"+nl$+"Error:"+er1$

else

Output$=format$("{0::-10}{1::-10}", LineNo, ColumnNo)+" End_of_Input"+nl$

end if

Push Output$

Exit

Clipboard Output$

Save.Doc Output$, "lex.t", Ansi

document lex$

Load.Doc lex$,"lex.t", Ansi

Report lex$

Sub Keywords(a$)

select case a$

case "if"

a$="Keyword_if"

case "else"

a$="Keyword_else"

case "while"

a$="Keyword_while"

case "print"

a$="Keyword_print"

case "putc"

a$="Keyword_putc"

else case

a$="Identifier "+a$

end select

Output$=a$+nl$

End sub

Sub Symbols(a$)

select case a$

case " ", chr$(9)

a$=""

case "("

a$="LeftParen"

case ")"

a$="RightParen"

case "{"

a$="LeftBrace"

case "}"

a$="RightBrace"

case ";"

a$="Semicolon"

case ","

a$="Comma"

case "*"

a$="Op_multiply"

case "/"

a$="Op_divide"

case "+"

a$="Op_add"

case "-"

a$="Op_subtract"

case "%"

a$="Op_mod"

case "<"

{ if Ahead("=", offset+1) Then

offset++

a$="Op_lessequal"

ColumnNo++

else

a$="Op_less"

end if

}

case ">"

{ if Ahead("=", offset+1) Then

offset++

ColumnNo++

a$="Op_greaterequal"

else

a$="Op_greater"

end if

}

case "="

{ if Ahead("=", offset+1) Then

offset++

ColumnNo++

a$="Op_equal"

else

a$="Op_assign"

end if

}

case "!"

{ if Ahead("=", offset+1) Then

offset++

ColumnNo++

a$="Op_notequal"

else

a$="Op_not"

end if

}

case "&"

{ if Ahead("&", offset+1) Then

offset++

ColumnNo++

a$="Op_and"

else

a$=""

end if

}

case "|"

{ if Ahead("|", offset+1) Then

offset++

ColumnNo++

a$="Op_or"

else

a$=""

end if

}

else case

{Error "Unrecognized character."+er$}

end select

if a$<>"" then

Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)+a$+nl$

end if

End Sub

Sub checkerror()

if offset>lim then {

Error "End-of-line while scanning string literal. Closing string character not found before end-of-line."+er$

} else.if Ahead(nl$,offset) then {

Error "End-of-file while scanning string literal. Closing string character not found."+er$

}

End Sub

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

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

// function to extract string, replacing escape codes.

// process escape codes

// we can set starting value to any number n where 0<=n<=232

// change Report with Print #-2, (report stop when scrolling 3/4 of height of console, waiting key or mouse key to continue)

// get datasize

// make stack

// dim or redim buffer append 1000 long as is.

// get strings

a$=rightpart$(a$, nl$)

// Prepare VM

profiler

Print

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

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

if not islet then exitr