parser.pas

{------------------------------------------------------------------------------}
program parser;

{------------------------------------------------------------------------------}
{Constant Declarations}

const TAB = ^I;
       CR = ^J;

{------------------------------------------------------------------------------}
   { 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 Decimcal 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 an 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('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 Look in ['+', '-'] 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.
{------------------------------------------------------------------------------}