Давайте создадим компилятор!

{–}

program Calls;

{–}

{ Constant Declarations }

const TAB = ^I;

CR = ^M;

LF = ^J;

{–}

{ Variable Declarations }

var Look: char; { Lookahead Character }

var ST: Array['A'..'Z'] of char;

{–}

{ Read New Character From Input Stream }

procedure GetChar;

begin

Read(Look);

end;

{–}

{ Report an Error }

procedure Error(s: string);

begin

WriteLn;

WriteLn(^G, 'Error: ', s, '.');

end;

{–}

{ Report Error and Halt }

procedure Abort(s: string);

begin

Error(s);

Halt;

end;

{–}

{ Report What Was Expected }

procedure Expected(s: string);

begin

Abort(s + ' Expected');

end;

{–}

{ Report an Undefined Identifier }

procedure Undefined(n: string);

begin

Abort('Undefined Identifier ' + n);

end;

{–}

{ Report an Duplicate Identifier }

procedure Duplicate(n: string);

begin

Abort('Duplicate Identifier ' + n);

end;

{–}

{ Get Type of Symbol }

function TypeOf(n: char): char;

begin

TypeOf := ST[n];

end;

{–}

{ Look for Symbol in Table }

function InTable(n: char): Boolean;

begin

InTable := ST[n] <> ' ';

end;

{–}

{ Add a New Symbol to Table }

procedure AddEntry(Name, T: char);

begin

if Intable(Name) then Duplicate(Name);

ST[Name] := T;

end;

{–}

{ Check an Entry to Make Sure It's a Variable }

procedure CheckVar(Name: char);

begin

if not InTable(Name) then Undefined(Name);

if TypeOf(Name) <> 'v' then Abort(Name + ' is not a

variable');

end;

{–}

{ Recognize an Alpha Character }

function IsAlpha(c: char): boolean;

begin

IsAlpha := upcase(c) in ['A'..'Z'];

end;

{–}

{ Recognize a Decimal Digit }

function IsDigit(c: char): boolean;

begin

IsDigit := c in ['0'..'9'];

end;

{–}

{ Recognize an AlphaNumeric Character }

function IsAlNum(c: char): boolean;

begin

IsAlNum := IsAlpha(c) or IsDigit(c);

end;

{–}

{ Recognize an Addop }

function IsAddop(c: char): boolean;

begin

IsAddop := c in ['+', '-'];

end;

{–}

{ Recognize a Mulop }

function IsMulop(c: char): boolean;

begin

IsMulop := c in ['*', '/'];

end;

{–}

{ Recognize a Boolean Orop }

function IsOrop(c: char): boolean;

begin

IsOrop := c in ['|', '~'];

end;

{–}

{ Recognize a Relop }

function IsRelop(c: char): boolean;

begin

IsRelop := c in ['=', '#', '<', '>'];

end;

{–}

{ Recognize White Space }

function IsWhite(c: char): boolean;

begin

IsWhite := c in [' ', TAB];

end;

{–}

{ Skip Over Leading White Space }

procedure SkipWhite;

begin

while IsWhite(Look) do

GetChar;

end;

{–}

{ Skip Over an End-of-Line }

procedure Fin;

begin

if Look = CR then begin

GetChar;

if Look = LF then

GetChar;

end;

end;

{–}

{ Match a Specific Input Character }

procedure Match(x: char);

begin

if Look = x then GetChar

else Expected('''' + x + '''');

SkipWhite;

end;

{–}

{ Get an Identifier }

function GetName: char;

begin

if not IsAlpha(Look) then Expected('Name');

GetName := UpCase(Look);

GetChar;

SkipWhite;

end;

{–}

{ Get a Number }

function GetNum: char;

begin

if not IsDigit(Look) then Expected('Integer');

GetNum := Look;

GetChar;

SkipWhite;

end;

{–}

{ Output a String with Tab }

procedure Emit(s: string);

begin

Write(TAB, s);

end;

{–}

{ Output a String with Tab and CRLF }

procedure EmitLn(s: string);

begin

Emit(s);

WriteLn;

end;

{–}

{ Post a Label To Output }

procedure PostLabel(L: string);

begin

WriteLn(L, ':');

end;

{–}

{ Load a Variable to the Primary Register }

procedure LoadVar(Name: char);

begin

CheckVar(Name);

EmitLn('MOVE ' + Name + '(PC),D0');

end;

{–}

{ Store the Primary Register }

procedure StoreVar(Name: char);

begin

CheckVar(Name);

EmitLn('LEA ' + Name + '(PC),A0');

EmitLn('MOVE D0,(A0)')

end;

{–}

{ Initialize }

procedure Init;

var i: char;

begin

GetChar;

SkipWhite;

for i := 'A' to 'Z' do

ST[i] := ' ';

end;

{–}

{ Parse and Translate an Expression }

{ Vestigial Version }

procedure Expression;

begin

LoadVar(GetName);

end;

{–}

{ Parse and Translate an Assignment Statement }

procedure Assignment;

var Name: char;

begin

Name := GetName;

Match('=');

Expression;

StoreVar(Name);

end;

{–}

{ Parse and Translate a Block of Statements }

procedure DoBlock;

begin

while not(Look in ['e']) do begin

Assignment;

Fin;

end;

end;

{–}

{ Parse and Translate a Begin-Block }

procedure BeginBlock;

begin

Match('b');

Fin;

DoBlock;

Match('e');

Fin;

end;

{–}

{ Allocate Storage for a Variable }

procedure Alloc(N: char);

begin

if InTable(N) then Duplicate(N);

ST[N] := 'v';

WriteLn(N, ':', TAB, 'DC 0');

end;

{–}

{ Parse and Translate a Data Declaration }

procedure Decl;

var Name: char;

begin

Match('v');

Alloc(GetName);

end;

{–}

{ Parse and Translate Global Declarations }

procedure TopDecls;

begin

while Look <> 'b' do begin

case Look of

'v': Decl;

else Abort('Unrecognized Keyword ' + Look);

end;

Fin;

end;

end;

{–}

{ Main Program }

begin

Init;

TopDecls;

BeginBlock;

end.

{–}