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

procedure Expected(s: string);

begin

Abort(s + ' Expected');

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 }

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 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;

{–}

{ Match a Specific Input Character }

procedure Match(x: char);

begin

if Look <> x then Expected('''' + x + '''')

else begin

GetChar;

SkipWhite;

end;

end;

{–}

{ Get an Identifier }

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;

end;

GetName := Token;

SkipWhite;

end;

{–}

{ Get a Number }

function GetNum: string;

var Value: string;

begin

Value := '';

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

while IsDigit(Look) do begin

Value := Value + Look;

GetChar;

end;

GetNum := Value;

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;

{–}

{ Parse and Translate a Identifier }

procedure Ident;

var Name: string[8];

begin

Name:= GetName;

if Look = '(' then begin

Match('(');

Match(')');

EmitLn('BSR ' + Name);

end

else

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

end;

{–}

{ Parse and Translate a Math Factor }

procedure Expression; Forward;

procedure Factor;

begin

if Look = '(' then begin

Match('(');

Expression;

Match(')');

end

else if IsAlpha(Look) then

Ident

else

EmitLn('MOVE #' + GetNum + ',D0');

end;

{–}

{ Recognize and Translate a Multiply }

procedure Multiply;

begin

Match('*');

Factor;

EmitLn('MULS (SP)+,D0');

end;

{–}

{ Recognize and Translate a Divide }

procedure Divide;

begin

Match('/');

Factor;

EmitLn('MOVE (SP)+,D1');

EmitLn('EXS.L D0');

EmitLn('DIVS D1,D0');

end;

{–}

{ Parse and Translate a Math Term }

procedure Term;

begin

Factor;

while Look in ['*', '/'] do begin

EmitLn('MOVE D0,-(SP)');

case Look of

'*': Multiply;

'/': Divide;

end;

end;

end;

{–}

{ Recognize and Translate an Add }

procedure Add;

begin

Match('+');

Term;

EmitLn('ADD (SP)+,D0');

end;

{–}

{ Recognize and Translate a Subtract }

procedure Subtract;

begin

Match('-');

Term;

EmitLn('SUB (SP)+,D0');

EmitLn('NEG D0');

end;

{–}

{ Parse and Translate an Expression }

procedure Expression;

begin

if IsAddop(Look) then

EmitLn('CLR D0')

else

Term;

while IsAddop(Look) do begin

EmitLn('MOVE D0,-(SP)');

case Look of

'+': Add;

'-': Subtract;

end;

end;

end;

{–}

{ Parse and Translate an Assignment Statement }

procedure Assignment;

var Name: string[8];

begin

Name := GetName;

Match('=');

Expression;

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

EmitLn('MOVE D0,(A0)')

end;

{–}

{ Initialize }

procedure Init;

begin

GetChar;

SkipWhite;

end;

{–}

{ Main Program }

begin

Init;

Assignment;

If Look <> CR then Expected('NewLine');

end.

{–}