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