path: root/crenshaw/main.pas

program Main;

const
	TAB = ^I;
	LF = ^J;

var
	Look : char;
	LCount : integer;

procedure Error(s : string);
begin
	WriteLn;
	WriteLn(^G, 'Error: ', s, '.');
end;

procedure GetChar;
begin
	Read(Look);
end;

function IsWhite(c: char): boolean;
begin
	IsWhite := c in [' ', TAB];
end;

procedure SkipWhite;
begin
	while IsWhite(Look) do
		GetChar;
end;

procedure Abort(s : string);
begin
	Error(s);
	Halt;
end;

procedure Expected(s : string);
begin
	Abort(s + ' expected');
end;

procedure Match(c : char);
begin
	if c <> Look then Expected('''' + c + '''')
	else begin
		GetChar;
		SkipWhite;
	end
end;

function IsAlpha(c : char) : boolean;
begin
	IsAlpha := upcase(c) in ['A'..'Z'];
end;

function IsDigit(c : char) : boolean;
begin
	IsDigit := c in ['0'..'9'];
end;

function IsAlNum(c: char): boolean;
begin
	IsAlNum := IsAlpha(c) or IsDigit(c);
end;

function IsAddop(c: char): boolean;
begin
   IsAddop := c in ['+', '-'];
end;

function GetName : string;
var
	Token : string;
begin
	Token := '';
	if not IsAlpha(Look) then Expected('Name');
	while IsAlNum(Look) do begin
		Token := Token + UpCase(Look);
		GetChar;
		SkipWhite;
	end;
	GetName := Token;
end;

function GetNum : string;
var
	Value : string;
begin
	Value := '';
	if not IsDigit(Look) then Expected('Integer');
	while IsDigit(Look) do begin
		Value := Value + Look;
		GetChar;
		SkipWhite;
	end;
	GetNum := Value;
end;

procedure Emit(s : string);
begin
	Write(TAB, s);
end;

procedure EmitLn(s : string);
begin
	Emit(s);
	WriteLn;
end;

function NewLabel : string;
var
	s : string;
begin
	Str(LCount, s);
	NewLabel := 'L'+s;
	Inc(LCount);
end;

procedure EmitLabel(s : string);
begin
	WriteLn(s+':');
end;

procedure EmitComment(s : string);
begin
	WriteLn('; '+s);
end;

procedure Expression; forward;

type
	symbolType = ( variableType = 1, functionType = 2 );
	
var
	nof_symbols : integer;
	symbols : array[0..26] of record
		name : string;
		sym_type : symbolType;
	end;

procedure RememberName(name : string; sym_type : symbolType);
var
	i : integer;
	found : boolean;
begin
	found := false;
	for i := 0 to nof_symbols do begin
		if symbols[i].name = name then
			found := true;
	end;
	if i = 26 then Abort('Table of symbols overflowed');
	if not found then begin
		symbols[nof_symbols].name := name;
		symbols[nof_symbols].sym_type := sym_type;
		inc(nof_symbols);
	end;
end;

procedure Ident;
var name : string;
begin
	name := GetName;
	if Look = '(' then begin
		Match('(');
		Match(')');
		RememberName(name, functionType);
		EmitLn('call '+name);
	end else begin
		RememberName(name, variableType);
		EmitLn('mov eax,['+name+']');
	end;
end;

procedure Factor;
begin
	if Look = '(' then begin
		Match('(');
		Expression;
		Match(')');
	end else if IsAlpha(Look) then
		Ident
	else
		EmitLn('mov eax, ' + GetNum);
end;

procedure Multiply;
begin
	Match('*');
	Factor;
	EmitLn('pop ebx');
	EmitLn('mul ebx');
end;

procedure Divide;
begin
	Match('/');
	Factor;
	EmitLn('mov ecx,eax');	
	EmitLn('pop eax');
	EmitLn('div ecx');
end;

procedure Term;
begin
	Factor;
	while Look in ['*', '/'] do
	begin
		EmitLn('push eax');
		case Look of
                        '*': Multiply;
                        '/': Divide;
                else Expected('* or /');
                end;
	end;
end;

procedure Add;
begin;
	Match('+');
	Term;
	Emitln('pop ebx');
	EmitLn('add eax,ebx');
end;

procedure Subtract;
begin;
	Match('-');
	Term;
	EmitLn('pop ebx');
	EmitLn('sub eax, ebx');
	EmitLn('neg eax');
end;

procedure Expression;
begin
	if IsAddop(Look) then
		EmitLn('MOV eax, 0')
	else
		Term;
	while Look in ['+', '-'] do
	begin
		EmitLn('push eax');
		case Look of
			'+': Add;
			'-': Subtract;
		else Expected('+ or -');
		end;
	end;
end;

procedure Assignment;
var
	name : string;
begin
	name := GetName;
	RememberName(name, variableType);
	Match('=');
	Expression;
	EmitLn('lea ebx,['+name+']');
	EmitLn('mov [ebx],eax');
end;

procedure Init;
begin
	nof_symbols := 0;
	LCount := 0;
	GetChar;
	SkipWhite;
end;

procedure Prologue;
begin
	WriteLn('[bits 32]');
	WriteLn('cpu 486');
	WriteLn('org 0x1000000');
{	WriteLn('section .text');
	WriteLn('global main');
	EmitLabel('main');
	EmitLn('push ebp');
	EmitLn('mov ebp, esp');
}
end;

procedure Functions;
var i : integer;
begin	
	for i := 0 to nof_symbols-1 do begin
		if symbols[i].sym_type = FunctionType then begin
			EmitLabel(symbols[i].name);
			EmitLn('ret');
		end;
	end;
end;

procedure Variables;
var i : integer;
begin
	for i := 0 to nof_symbols-1 do begin
		if symbols[i].sym_type = VariableType then begin
			EmitLabel(symbols[i].name);
			EmitLn('dd 0');
		end;
	end;
end;

procedure Epilogue;
begin
	EmitLn('hlt');
	Functions;
	Variables;
{
	EmitLn('leave');
	EmitLn('ret');
}
end;

procedure NewLine;
begin
	if Look = LF then
		GetChar;
end;

procedure Other;
begin
	while not(Look in ['e']) do begin
		Assignment;
		Newline;
	{	EmitComment('Other: '+GetName);}
	end;
end;

procedure Block; forward;

procedure Condition;
begin
	EmitComment('Condition: '+GetName);
end;

procedure DoIf;
var
	L : string;
begin
	Match('i');
	L := NewLabel;
	Condition;
	EmitLn('jz '+L);
	Block;
	Match('e');
	EmitLabel(L);
end;

procedure Block;
begin
	while not(Look in ['e']) do begin
		case Look of
			'i': DoIf;
			'o': Other;
		end;
	end;
end;

procedure DoProgram;
begin
	Block;
	if Look <> 'e' then Expected('END');
	EmitComment('END');
end;

begin
	Prologue;
	Init;
	DoProgram;
{	Other;
	repeat
		Assignment;
		NewLine;
	until Look = '.';
}
	Epilogue;
end.