Снова выражения

Code:

program parse;

{ Constant Declarations }

const TAB = ^I;

       CR = ^M;

{ Variable Declarations }

var Look: char;              { Lookahead Character }

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

{ 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.