{–}
      { Parse and Translate a Math Expression }
      procedure Expression;
      begin
      EmitLn('MOVE #' + GetNum + ',D0')
      end;
      {–}
      И добавьте строку “Expression;” в основную программу, которая должна выглядеть так:
      {–}
      begin
      Init;
      Expression;
      end.
      {–}

      {–}
      { Parse and Translate an Expression }
      procedure Expression;
      begin
      Term;
      EmitLn('MOVE D0,D1');
      case Look of
      '+': Add;
      '-': Subtract;
      else Expected('Addop');
      end;
      end;
      {–}

      {–}
      { Recognize and Translate an Add }
      procedure Add;
      begin
      Match('+');
      Term;
      EmitLn('ADD D1,D0');
      end;
      {–}
      { Recognize and Translate a Subtract }
      procedure Subtract;
      begin
      Match('-');
      Term;
      EmitLn('SUB D1,D0');
      end;
      {–}

      {–}
      { Recognize and Translate a Subtract }
      procedure Subtract;
      begin
      Match('-');
      Term;
      EmitLn('SUB D1,D0');
      EmitLn('NEG D0');
      end;
      {–}

      {–}
      { Parse and Translate an Expression }
      procedure Expression;
      begin
      Term;
      while Look in ['+', '-'] do begin
      EmitLn('MOVE D0,D1');
      case Look of
      '+': Add;
      '-': Subtract;
      else Expected('Addop');
      end;
      end;
      end;
      {–}

      {–}
      { Parse and Translate a Math Factor }
      procedure Factor;
      begin
      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;
      else Expected('Mulop');
      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
      Term;
      while Look in ['+', '-'] do begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '+': Add;
      '-': Subtract;
      else Expected('Addop');
      end;
      end;
      end;
      {–}

      {–}
      { Parse and Translate a Math Factor }
      procedure Expression; Forward;
      procedure Factor;
      begin
      if Look = '(' then begin
      Match('(');
      Expression;
      Match(')');
      end
      else
      EmitLn('MOVE #' + GetNum + ',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;
      else Expected('Addop');
      end;
      end;
      end;
      {–}

      {–}
      { Recognize an Addop }
      function IsAddop(c: char): boolean;
      begin
      IsAddop := c in ['+', '-'];
      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
      EmitLn('MOVE ' + GetName + '(PC),D0')
      else
      EmitLn('MOVE #' + GetNum + ',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;
      {–}

      {–}
      { Parse and Translate an Identifier }
      procedure Ident;
      var Name: char;
      begin
      Name := GetName;
      if Look = '(' then begin
      Match('(');
      Match(')');
      EmitLn('BSR ' + Name);
      end
      else
      EmitLn('MOVE ' + Name + '(PC),D0')
      end;
      {–}

      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: char;
      begin
      Name := GetName;
      Match('=');
      Expression;
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)')
      end;
      {–}

      {–}
      { Recognize an Alphanumeric }
      function IsAlNum(c: char): boolean;
      begin
      IsAlNum := IsAlpha(c) or IsDigit(c);
      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;
      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;
      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;
      {–}

      {–}
      { Initialize }
      procedure Init;
      begin
      GetChar;
      SkipWhite;
      end;
      {–}

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

      {–}
      { Get a Number }
      function GetNum: integer;
      begin
      if not IsDigit(Look) then Expected('Integer');
      GetNum := Ord(Look) – Ord('0');
      GetChar;
      end;
      {–}

      {–}
      { Parse and Translate an Expression }
      function Expression: integer;
      begin
      Expression := GetNum;
      end;
      {–}

      {–}
      { Parse and Translate an Expression }
      function Expression: integer;
      var Value: integer;
      begin
      if IsAddop(Look) then
      Value := 0
      else
      Value := GetNum;
      while IsAddop(Look) do begin
      case Look of
      '+': begin
      Match('+');
      Value := Value + GetNum;
      end;
      '-': begin
      Match('-');
      Value := Value – GetNum;
      end;
      end;
      end;
      Expression := Value;
      end;
      {–}

      {–}
      { Parse and Translate a Math Term }
      function Term: integer;
      var Value: integer;
      begin
      Value := GetNum;
      while Look in ['*', '/'] do begin
      case Look of
      '*': begin
      Match('*');
      Value := Value * GetNum;
      end;
      '/': begin
      Match('/');
      Value := Value div GetNum;
      end;
      end;
      end;
      Term := Value;
      end;
      {–}

      {–}
      { Get a Number }
      function GetNum: integer;
      var Value: integer;
      begin
      Value := 0;
      if not IsDigit(Look) then Expected('Integer');
      while IsDigit(Look) do begin
      Value := 10 * Value + Ord(Look) – Ord('0');
      GetChar;
      end;
      GetNum := Value;
      end;
      {–}

      {–}
      { Parse and Translate a Math Factor }
      function Expression: integer; Forward;
      function Factor: integer;
      begin
      if Look = '(' then begin
      Match('(');
      Factor := Expression;
      Match(')');
      end
      else
      Factor := GetNum;
      end;
      {–}

      {–}
      { Initialize the Variable Area }
      procedure InitTable;
      var i: char;
      begin
      for i := 'A' to 'Z' do
      Table[i] := 0;
      end;
      {–}

      {–}
      { Parse and Translate a Math Factor }
      function Expression: integer; Forward;
      function Factor: integer;
      begin
      if Look = '(' then begin
      Match('(');
      Factor := Expression;
      Match(')');
      end
      else if IsAlpha(Look) then
      Factor := Table[GetName]
      else
      Factor := GetNum;
      end;
      {–}

      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: char;
      begin
      Name := GetName;
      Match('=');
      Table[Name] := Expression;
      end;
      {–}

      {–}
      { Recognize and Skip Over a Newline }
      procedure NewLine;
      begin
      if Look = CR then begin
      GetChar;
      if Look = LF then
      GetChar;
      end;
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      repeat
      Assignment;
      NewLine;
      until Look = '.';
      end.
      {–}

      {–}
      { Input Routine }
      procedure Input;
      begin
      Match('?');
      Read(Table[GetName]);
      end;
      {–}
      { Output Routine }
      procedure Output;
      begin
      Match('!');
      WriteLn(Table[GetName]);
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      repeat
      case Look of
      '?': Input;
      '!': Output;
      else Assignment;
      end;
      NewLine;
      until Look = '.';
      end.
      {–}

      {–}
      { Recognize and Translate an «Other» }
      procedure Other;
      begin
      EmitLn(GetName);
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      Other;
      end.
      {–}

      {–}
      { Parse and Translate a Program }
      procedure DoProgram;
      begin
      Block;
      if Look <> 'e' then Expected('End');
      EmitLn('END')
      end;
      {–}

      {–}
      { Recognize and Translate a Statement Block }
      procedure Block;
      begin
      while not(Look in ['e']) do begin
      Other;
      end;
      end;
      {–}

      {–}
      { Generate a Unique Label }
      function NewLabel: string;
      var S: string;
      begin
      Str(LCount, S);
      NewLabel := 'L' + S;
      Inc(LCount);
      end;
      {–}
      { Post a Label To Output }
      procedure PostLabel(L: string);
      begin
      WriteLn(L, ':');
      end;
      {–}

      var Look : char; { Lookahead Character }
      Lcount: integer; { Label Counter }

      LCount := 0;

      {–}
      { Recognize and Translate an IF Construct }
      procedure Block; Forward;
      procedure DoIf;
      var L: string;
      begin
      Match('i');
      L := NewLabel;
      Condition;
      EmitLn('BEQ ' + L);
      Block;
      Match('e');
      PostLabel(L);
      end;
      {–}

      {–}
      { Recognize and Translate a Statement Block }
      procedure Block;
      begin
      while not(Look in ['e']) do begin
      case Look of
      'i': DoIf;
      'o': Other;
      end;
      end;
      end;
      {–}

      {–}
      { Parse and Translate a Boolean Condition }
      { This version is a dummy }
      Procedure Condition;
      begin
      EmitLn('<condition>');
      end;
      {–}

      {–}
      { Recognize and Translate an IF Construct }
      procedure DoIf;
      var L1, L2: string;
      begin
      Match('i');
      Condition;
      L1 := NewLabel;
      L2 := L1;
      EmitLn('BEQ ' + L1);
      Block;
      if Look = 'l' then begin
      Match('l');
      L2 := NewLabel;
      EmitLn('BRA ' + L2);
      PostLabel(L1);
      Block;
      end;
      Match('e');
      PostLabel(L2);
      end;
      {–}

      {–}
      { Parse and Translate a WHILE Statement }
      procedure DoWhile;
      var L1, L2: string;
      begin
      Match('w');
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      Condition;
      EmitLn('BEQ ' + L2);
      Block;
      Match('e');
      EmitLn('BRA ' + L1);
      PostLabel(L2);
      end;
      {–}

      {–}
      { Recognize and Translate a Statement Block }
      procedure Block;
      begin
      while not(Look in ['e', 'l']) do begin
      case Look of
      'i': DoIf;
      'w': DoWhile;
      else Other;
      end;
      end;
      end;
      {–}

      {–}
      { Parse and Translate a LOOP Statement }
      procedure DoLoop;
      var L: string;
      begin
      Match('p');
      L := NewLabel;
      PostLabel(L);
      Block;
      Match('e');
      EmitLn('BRA ' + L);
      end;
      {–}

      Как обычно, код вытекает отсюда довольно легко:
      {–}
      { Parse and Translate a REPEAT Statement }
      procedure DoRepeat;
      var L: string;
      begin
      Match('r');
      L := NewLabel;
      PostLabel(L);
      Block;
      Match('u');
      Condition;
      EmitLn('BEQ ' + L);
      end;
      {–}

      {–}
      { Recognize and Translate a Statement Block }
      procedure Block;
      begin
      while not(Look in ['e', 'l', 'u']) do begin
      case Look of
      'i': DoIf;
      'w': DoWhile;
      'p': DoLoop;
      'r': DoRepeat;
      else Other;
      end;
      end;
      end;
      {–}

      {–}
      { Parse and Translate a FOR Statement }
      procedure DoFor;
      var L1, L2: string;
      Name: char;
      begin
      Match('f');
      L1 := NewLabel;
      L2 := NewLabel;
      Name := GetName;
      Match('=');
      Expression;
      EmitLn('SUBQ #1,D0');
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)');
      Expression;
      EmitLn('MOVE D0,-(SP)');
      PostLabel(L1);
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE (A0),D0');
      EmitLn('ADDQ #1,D0');
      EmitLn('MOVE D0,(A0)');
      EmitLn('CMP (SP),D0');
      EmitLn('BGT ' + L2);
      Block;
      Match('e');
      EmitLn('BRA ' + L1);
      PostLabel(L2);
      EmitLn('ADDQ #2,SP');
      end;
      {–}

      {–}
      { Parse and Translate an Expression }
      { This version is a dummy }
      Procedure Expression;
      begin
      EmitLn('<expr>');
      end;
      {–}

      {–}
      { Parse and Translate a DO Statement }
      procedure Dodo;
      var L: string;
      begin
      Match('d');
      L := NewLabel;
      Expression;
      EmitLn('SUBQ #1,D0');
      PostLabel(L);
      EmitLn('MOVE D0,-(SP)');
      Block;
      EmitLn('MOVE (SP)+,D0');
      EmitLn('DBRA D0,' + L);
      end;
      {–}

      {–}
      { Parse and Translate a LOOP Statement }
      procedure DoLoop;
      var L1, L2: string;
      begin
      Match('p');
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      Block(L2);
      Match('e');
      EmitLn('BRA ' + L1);
      PostLabel(L2);
      end;
      {–}

      {–}
      { Recognize and Translate a Statement Block }
      procedure Block(L: string);
      begin
      while not(Look in ['e', 'l', 'u']) do begin
      case Look of
      'i': DoIf(L);
      'w': DoWhile;
      'p': DoLoop;
      'r': DoRepeat;
      'f': DoFor;
      'd': DoDo;
      'b': DoBreak(L);
      else Other;
      end;
      end;
      end;
      {–}

      {–}
      { Recognize and Translate an IF Construct }
      procedure Block(L: string); Forward;
      procedure DoIf(L: string);
      var L1, L2: string;
      begin
      Match('i');
      Condition;
      L1 := NewLabel;
      L2 := L1;
      EmitLn('BEQ ' + L1);
      Block(L);
      if Look = 'l' then begin
      Match('l');
      L2 := NewLabel;
      EmitLn('BRA ' + L2);
      PostLabel(L1);
      Block(L);
      end;
      Match('e');
      PostLabel(L2);
      end;
      {–}

      {–}
      { Recognize and Translate a BREAK }
      procedure DoBreak(L: string);
      begin
      Match('b');
      if L <> '' then
      EmitLn('BRA ' + L)
      else Abort('No loop to break from');
      end;
      {–}
      { Parse and Translate a Program }
      procedure DoProgram;
      begin
      Block('');
      if Look <> 'e' then Expected('End');
      EmitLn('END')
      end;
      {–}

      {–}
      { Parse and Translate a DO Statement }
      procedure Dodo;
      var L1, L2: string;
      begin
      Match('d');
      L1 := NewLabel;
      L2 := NewLabel;
      Expression;
      EmitLn('SUBQ #1,D0');
      PostLabel(L1);
      EmitLn('MOVE D0,-(SP)');
      Block(L2);
      EmitLn('MOVE (SP)+,D0');
      EmitLn('DBRA D0,' + L1);
      EmitLn('SUBQ #2,SP');
      PostLabel(L2);
      EmitLn('ADDQ #2,SP');
      end;
      {–}

      {–}
      program Branch;
      {–}
      { Constant Declarations }
      const TAB = ^I;
      CR = ^M;
      {–}
      { Variable Declarations }
      var Look : char; { Lookahead Character }
      Lcount: integer; { Label Counter }
      {–}
      { 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;
      {–}
      { Match a Specific Input Character }
      procedure Match(x: char);
      begin
      if Look = x then GetChar
      else Expected('''' + x + '''');
      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 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;
      {–}
      { Get an Identifier }
      function GetName: char;
      begin
      if not IsAlpha(Look) then Expected('Name');
      GetName := UpCase(Look);
      GetChar;
      end;
      {–}
      { Get a Number }
      function GetNum: char;
      begin
      if not IsDigit(Look) then Expected('Integer');
      GetNum := Look;
      GetChar;
      end;
      {–}
      { Generate a Unique Label }
      function NewLabel: string;
      var S: string;
      begin
      Str(LCount, S);
      NewLabel := 'L' + S;
      Inc(LCount);
      end;
      {–}
      { Post a Label To Output }
      procedure PostLabel(L: string);
      begin
      WriteLn(L, ':');
      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 Boolean Condition }
      procedure Condition;
      begin
      EmitLn('<condition>');
      end;
      {–}
      { Parse and Translate a Math Expression }
      procedure Expression;
      begin
      EmitLn('<expr>');
      end;
      {–}
      { Recognize and Translate an IF Construct }
      procedure Block(L: string); Forward;
      procedure DoIf(L: string);
      var L1, L2: string;
      begin
      Match('i');
      Condition;
      L1 := NewLabel;
      L2 := L1;
      EmitLn('BEQ ' + L1);
      Block(L);
      if Look = 'l' then begin
      Match('l');
      L2 := NewLabel;
      EmitLn('BRA ' + L2);
      PostLabel(L1);
      Block(L);
      end;
      Match('e');
      PostLabel(L2);
      end;
      {–}
      { Parse and Translate a WHILE Statement }
      procedure DoWhile;
      var L1, L2: string;
      begin
      Match('w');
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      Condition;
      EmitLn('BEQ ' + L2);
      Block(L2);
      Match('e');
      EmitLn('BRA ' + L1);
      PostLabel(L2);
      end;
      {–}
      { Parse and Translate a LOOP Statement }
      procedure DoLoop;
      var L1, L2: string;
      begin
      Match('p');
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      Block(L2);
      Match('e');
      EmitLn('BRA ' + L1);
      PostLabel(L2);
      end;
      {–}
      { Parse and Translate a REPEAT Statement }
      procedure DoRepeat;
      var L1, L2: string;
      begin
      Match('r');
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      Block(L2);
      Match('u');
      Condition;
      EmitLn('BEQ ' + L1);
      PostLabel(L2);
      end;
      {–}
      { Parse and Translate a FOR Statement }
      procedure DoFor;
      var L1, L2: string;
      Name: char;
      begin
      Match('f');
      L1 := NewLabel;
      L2 := NewLabel;
      Name := GetName;
      Match('=');
      Expression;
      EmitLn('SUBQ #1,D0');
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)');
      Expression;
      EmitLn('MOVE D0,-(SP)');
      PostLabel(L1);
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE (A0),D0');
      EmitLn('ADDQ #1,D0');
      EmitLn('MOVE D0,(A0)');
      EmitLn('CMP (SP),D0');
      EmitLn('BGT ' + L2);
      Block(L2);
      Match('e');
      EmitLn('BRA ' + L1);
      PostLabel(L2);
      EmitLn('ADDQ #2,SP');
      end;
      {–}
      { Parse and Translate a DO Statement }
      procedure Dodo;
      var L1, L2: string;
      begin
      Match('d');
      L1 := NewLabel;
      L2 := NewLabel;
      Expression;
      EmitLn('SUBQ #1,D0');
      PostLabel(L1);
      EmitLn('MOVE D0,-(SP)');
      Block(L2);
      EmitLn('MOVE (SP)+,D0');
      EmitLn('DBRA D0,' + L1);
      EmitLn('SUBQ #2,SP');
      PostLabel(L2);
      EmitLn('ADDQ #2,SP');
      end;
      {–}
      { Recognize and Translate a BREAK }
      procedure DoBreak(L: string);
      begin
      Match('b');
      EmitLn('BRA ' + L);
      end;
      {–}
      { Recognize and Translate an «Other» }
      procedure Other;
      begin
      EmitLn(GetName);
      end;
      {–}
      { Recognize and Translate a Statement Block }
      procedure Block(L: string);
      begin
      while not(Look in ['e', 'l', 'u']) do begin
      case Look of
      'i': DoIf(L);
      'w': DoWhile;
      'p': DoLoop;
      'r': DoRepeat;
      'f': DoFor;
      'd': DoDo;
      'b': DoBreak(L);
      else Other;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Program }
      procedure DoProgram;
      begin
      Block('');
      if Look <> 'e' then Expected('End');
      EmitLn('END')
      end;
      {–}
      { Initialize }
      procedure Init;
      begin
      LCount := 0;
      GetChar;
      end;
      {–}
      { Main Program }
      begin
      Init;
      DoProgram;
      end.
      {–}

      {–}
      { Recognize a Boolean Literal }
      function IsBoolean(c: char): Boolean;
      begin
      IsBoolean := UpCase(c) in ['T', 'F'];
      end;
      {–}
      { Get a Boolean Literal }
      function GetBoolean: Boolean;
      var c: char;
      begin
      if not IsBoolean(Look) then Expected('Boolean Literal');
      GetBoolean := UpCase(Look) = 'T';
      GetChar;
      end;
      {–}

      {–}
      { Parse and Translate a Boolean Expression }
      procedure BoolExpression;
      begin
      if not IsBoolean(Look) then Expected('Boolean Literal');
      if GetBoolean then
      EmitLn('MOVE #-1,D0')
      else
      EmitLn('CLR D0');
      end;
      {–}

      {–}
      { Recognize and Translate a Boolean OR }
      procedure BoolOr;
      begin
      Match('|');
      BoolTerm;
      EmitLn('OR (SP)+,D0');
      end;
      {–}
      { Recognize and Translate an Exclusive Or }
      procedure BoolXor;
      begin
      Match('~');
      BoolTerm;
      EmitLn('EOR (SP)+,D0');
      end;
      {–}
      { Parse and Translate a Boolean Expression }
      procedure BoolExpression;
      begin
      BoolTerm;
      while IsOrOp(Look) do begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '|': BoolOr;
      '~': BoolXor;
      end;
      end;
      end;
      {–}
      Обратите внимание на новую процедуру IsOrOp, которая также является копией, на этот раз IsAddOp:
      {–}
      { Recognize a Boolean Orop }
      function IsOrop(c: char): Boolean;
      begin
      IsOrop := c in ['|', '~'];
      end;
      {–}

      {–}
      { Parse and Translate a Boolean Term }
      procedure BoolTerm;
      begin
      NotFactor;
      while Look = '&' do begin
      EmitLn('MOVE D0,-(SP)');
      Match('&');
      NotFactor;
      EmitLn('AND (SP)+,D0');
      end;
      end;
      {–}

      {–}
      { Parse and Translate a Boolean Factor with NOT }
      procedure NotFactor;
      begin
      if Look = '!' then begin
      Match('!');
      BoolFactor;
      EmitLn('EOR #-1,D0');
      end
      else
      BoolFactor;
      end;
      {–}

      {–}
      { Parse and Translate a Boolean Factor }
      procedure BoolFactor;
      begin
      if IsBoolean(Look) then
      if GetBoolean then
      EmitLn('MOVE #-1,D0')
      else
      EmitLn('CLR D0')
      else Relation;
      end;
      {–}

      {–}
      { Parse and Translate a Relation }
      procedure Relation;
      begin
      WriteLn('<Relation>');
      GetChar;
      end;
      {–}

      {–}
      { Recognize a Relop }
      function IsRelop(c: char): Boolean;
      begin
      IsRelop := c in ['=', '#', '<', '>'];
      end;
      {–}

      {–}
      { Recognize and Translate a Relational «Equals» }
      procedure Equals;
      begin
      Match('=');
      Expression;
      EmitLn('CMP (SP)+,D0');
      EmitLn('SEQ D0');
      end;
      {–}
      { Recognize and Translate a Relational «Not Equals» }
      procedure NotEquals;
      begin
      Match('#');
      Expression;
      EmitLn('CMP (SP)+,D0');
      EmitLn('SNE D0');
      end;
      {–}
      { Recognize and Translate a Relational «Less Than» }
      procedure Less;
      begin
      Match('<');
      Expression;
      EmitLn('CMP (SP)+,D0');
      EmitLn('SGE D0');
      end;
      {–}
      { Recognize and Translate a Relational «Greater Than» }
      procedure Greater;
      begin
      Match('>');
      Expression;
      EmitLn('CMP (SP)+,D0');
      EmitLn('SLE D0');
      end;
      {–}
      { Parse and Translate a Relation }
      procedure Relation;
      begin
      Expression;
      if IsRelop(Look) then begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '=': Equals;
      '#': NotEquals;
      '<': Less;
      '>': Greater;
      end;
      EmitLn('TST D0');
      end;
      end;
      {–}

      {–}
      { Parse and Translate an Identifier }
      procedure Ident;
      var Name: char;
      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;
      {–}
      { Parse and Translate the First Math Factor }
      procedure SignedFactor;
      begin
      if Look = '+' then
      GetChar;
      if Look = '-' then begin
      GetChar;
      if IsDigit(Look) then
      EmitLn('MOVE #-' + GetNum + ',D0')
      else begin
      Factor;
      EmitLn('NEG D0');
      end;
      end
      else Factor;
      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
      SignedFactor;
      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
      Term;
      while IsAddop(Look) do begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '+': Add;
      '-': Subtract;
      end;
      end;
      end;
      {–}

      {–}
      { Skip a CRLF }
      procedure Fin;
      begin
      if Look = CR then GetChar;
      if Look = LF then GetChar;
      end;
      {–}

      {–}
      { Recognize and Translate a Statement Block }
      procedure Block(L: string);
      begin
      while not(Look in ['e', 'l', 'u']) do begin
      Fin;
      case Look of
      'i': DoIf(L);
      'w': DoWhile;
      'p': DoLoop;
      'r': DoRepeat;
      'f': DoFor;
      'd': DoDo;
      'b': DoBreak(L);
      else Other;
      end;
      Fin;
      end;
      end;
      {–}

      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: char;
      begin
      Name := GetName;
      Match('=');
      BoolExpression;
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)');
      end;
      {–}

      {–}
      { Recognize an Alphanumeric Character }
      function IsAlNum(c: char): boolean;
      begin
      IsAlNum := IsAlpha(c) or IsDigit(c);
      end;
      {–}

      {–}
      { Get an Identifier }
      function GetName: string;
      var x: string[8];
      begin
      x := '';
      if not IsAlpha(Look) then Expected('Name');
      while IsAlNum(Look) do begin
      x := x + UpCase(Look);
      GetChar;
      end;
      GetName := x;
      end;
      {–}
      { Get a Number }
      function GetNum: string;
      var x: string[16];
      begin
      x := '';
      if not IsDigit(Look) then Expected('Integer');
      while IsDigit(Look) do begin
      x := x + Look;
      GetChar;
      end;
      GetNum := x;
      end;
      {–}

      {–}
      { Lexical Scanner }
      Function Scan: string;
      begin
      if IsAlpha(Look) then
      Scan := GetName
      else if IsDigit(Look) then
      Scan := GetNum
      else begin
      Scan := Look;
      GetChar;
      end;
      SkipWhite;
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      repeat
      Token := Scan;
      writeln(Token);
      until Token = CR;
      end.
      {–}

      {–}
      { Main Program }
      begin
      Init;
      repeat
      Token := Scan;
      writeln(Token);
      if Token = CR then Fin;
      until Token = '.';
      end.
      {–}

      {–}
      { Recognize Any Operator }
      function IsOp(c: char): boolean;
      begin
      IsOp := c in ['+', '-', '*', '/', '<', '>', ':', '='];
      end;
      {–}

      {–}
      { Lexical Scanner }
      Function Scan: string;
      begin
      while Look = CR do
      Fin;
      if IsAlpha(Look) then
      Scan := GetName
      else if IsDigit(Look) then
      Scan := GetNum
      else if IsOp(Look) then
      Scan := GetOp
      else begin
      Scan := Look;
      GetChar;
      end;
      SkipWhite;
      end;
      {–}

      {–}
      { Skip Over a Comma }
      procedure SkipComma;
      begin
      SkipWhite;
      if Look = ',' then begin
      GetChar;
      SkipWhite;
      end;
      end;
      {–}

      {–}
      { Type Declarations }
      type Symbol = string[8];
      SymTab = array[1..1000] of Symbol;
      TabPtr = ^SymTab;
      {–}

      {–}
      { Definition of Keywords and Token Types }
      const KWlist: array [1..4] of Symbol =
      ('IF', 'ELSE', 'ENDIF', 'END');
      {–}

      {–}
      { Table Lookup }
      { If the input string matches a table entry, return the entry
      index. If not, return a zero. }
      function Lookup(T: TabPtr; s: string; n: integer): integer;
      var i: integer;
      found: boolean;
      begin
      found := false;
      i := n;
      while (i > 0) and not found do
      if s = T^[i] then
      found := true
      else
      dec(i);
      Lookup := i;
      end;
      {–}

      {–}
      { Main Program }
      begin
      ReadLn(Token);
      WriteLn(Lookup(Addr(KWList), Token, 4));
      end.
      {–}

      {–}
      { Lexical Scanner }
      procedure Scan;
      var k: integer;
      begin
      while Look = CR do
      Fin;
      if IsAlpha(Look) then begin
      Value := GetName;
      k := Lookup(Addr(KWlist), Value, 4);
      if k = 0 then
      Token := Ident
      else
      Token := SymType(k – 1);
      end
      else if IsDigit(Look) then begin
      Value := GetNum;
      Token := Number;
      end
      else if IsOp(Look) then begin
      Value := GetOp;
      Token := Operator;
      end
      else begin
      Value := Look;
      Token := Operator;
      GetChar;
      end;
      SkipWhite;
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      repeat
      Scan;
      case Token of
      Ident: write('Ident ');
      Number: Write('Number ');
      Operator: Write('Operator ');
      IfSym, ElseSym, EndifSym, EndSym: Write('Keyword ');
      end;
      Writeln(Value);
      until Token = EndSym;
      end.
      {–}

      {–}
      { Get an Identifier }
      procedure GetName;
      var k: integer;
      begin
      Value := '';
      if not IsAlpha(Look) then Expected('Name');
      while IsAlNum(Look) do begin
      Value := Value + UpCase(Look);
      GetChar;
      end;
      k := Lookup(Addr(KWlist), Value, 4);
      if k = 0 then
      Token := Ident
      else
      Token := SymType(k-1);
      end;
      {–}
      { Get a Number }
      procedure GetNum;
      begin
      Value := '';
      if not IsDigit(Look) then Expected('Integer');
      while IsDigit(Look) do begin
      Value := Value + Look;
      GetChar;
      end;
      Token := Number;
      end;
      {–}
      { Get an Operator }
      procedure GetOp;
      begin
      Value := '';
      if not IsOp(Look) then Expected('Operator');
      while IsOp(Look) do begin
      Value := Value + Look;
      GetChar;
      end;
      Token := Operator;
      end;
      {–}
      { Lexical Scanner }
      procedure Scan;
      var k: integer;
      begin
      while Look = CR do
      Fin;
      if IsAlpha(Look) then
      GetName
      else if IsDigit(Look) then
      GetNum
      else if IsOp(Look) then
      GetOp
      else begin
      Value := Look;
      Token := Operator;
      GetChar;
      end;
      SkipWhite;
      end;
      {–}

      {–}
      { Get an Identifier }
      procedure GetName;
      begin
      Value := '';
      if not IsAlpha(Look) then Expected('Name');
      while IsAlNum(Look) do begin
      Value := Value + UpCase(Look);
      GetChar;
      end;
      Token := KWcode[Lookup(Addr(KWlist), Value, 4) + 1];
      end;
      {–}
      { Get a Number }
      procedure GetNum;
      begin
      Value := '';
      if not IsDigit(Look) then Expected('Integer');
      while IsDigit(Look) do begin
      Value := Value + Look;
      GetChar;
      end;
      Token := '#';
      end;
      {–}
      { Get an Operator }
      procedure GetOp;
      begin
      Value := '';
      if not IsOp(Look) then Expected('Operator');
      while IsOp(Look) do begin
      Value := Value + Look;
      GetChar;
      end;
      if Length(Value) = 1 then
      Token := Value[1]
      else
      Token := '?';
      end;
      {–}
      { Lexical Scanner }
      procedure Scan;
      var k: integer;
      begin
      while Look = CR do
      Fin;
      if IsAlpha(Look) then
      GetName
      else if IsDigit(Look) then
      GetNum
      else if IsOp(Look) then begin
      GetOp
      else begin
      Value := Look;
      Token := '?';
      GetChar;
      end;
      SkipWhite;
      end;
      {–}
      { Main Program }
      begin
      Init;
      repeat
      Scan;
      case Token of
      'x': write('Ident ');
      '#': Write('Number ');
      'i', 'l', 'e': Write('Keyword ');
      else Write('Operator ');
      end;
      Writeln(Value);
      until Value = 'END';
      end.
      {–}

      {–}
      program KISS;
      {–}
      { Constant Declarations }
      const TAB = ^I;
      CR = ^M;
      LF = ^J;
      {–}
      { Type Declarations }
      type Symbol = string[8];
      SymTab = array[1..1000] of Symbol;
      TabPtr = ^SymTab;
      {–}
      { Variable Declarations }
      var Look : char; { Lookahead Character }
      Lcount: integer; { Label Counter }
      {–}
      { 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 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 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 + '''');
      GetChar;
      SkipWhite;
      end;
      {–}
      { Skip a CRLF }
      procedure Fin;
      begin
      if Look = CR then GetChar;
      if Look = LF then GetChar;
      SkipWhite;
      end;
      {–}
      { Get an Identifier }
      function GetName: char;
      begin
      while Look = CR do
      Fin;
      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;
      {–}
      { Generate a Unique Label }
      function NewLabel: string;
      var S: string;
      begin
      Str(LCount, S);
      NewLabel := 'L' + S;
      Inc(LCount);
      end;
      {–}
      { Post a Label To Output }
      procedure PostLabel(L: string);
      begin
      WriteLn(L, ':');
      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: char;
      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;
      {–}
      { Parse and Translate the First Math Factor }
      procedure SignedFactor;
      var s: boolean;
      begin
      s := Look = '-';
      if IsAddop(Look) then begin
      GetChar;
      SkipWhite;
      end;
      Factor;
      if s then
      EmitLn('NEG 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;
      {–}
      { Completion of Term Processing (called by Term and FirstTerm }
      procedure Term1;
      begin
      while IsMulop(Look) do begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '*': Multiply;
      '/': Divide;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Math Term }
      procedure Term;
      begin
      Factor;
      Term1;
      end;
      {–}
      { Parse and Translate a Math Term with Possible Leading Sign }
      procedure FirstTerm;
      begin
      SignedFactor;
      Term1;
      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
      FirstTerm;
      while IsAddop(Look) do begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '+': Add;
      '-': Subtract;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Boolean Condition }
      { This version is a dummy }
      Procedure Condition;
      begin
      EmitLn('Condition');
      end;
      {–}
      { Recognize and Translate an IF Construct }
      procedure Block;
      Forward;
      procedure DoIf;
      var L1, L2: string;
      begin
      Match('i');
      Condition;
      L1 := NewLabel;
      L2 := L1;
      EmitLn('BEQ ' + L1);
      Block;
      if Look = 'l' then begin
      Match('l');
      L2 := NewLabel;
      EmitLn('BRA ' + L2);
      PostLabel(L1);
      Block;
      end;
      PostLabel(L2);
      Match('e');
      end;
      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: char;
      begin
      Name := GetName;
      Match('=');
      Expression;
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)');
      end;
      {–}
      { Recognize and Translate a Statement Block }
      procedure Block;
      begin
      while not(Look in ['e', 'l']) do begin
      case Look of
      'i': DoIf;
      CR: while Look = CR do
      Fin;
      else Assignment;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Program }
      procedure DoProgram;
      begin
      Block;
      if Look <> 'e' then Expected('END');
      EmitLn('END')
      end;
      {–}
      { Initialize }
      procedure Init;
      begin
      LCount := 0;
      GetChar;
      end;
      {–}
      { Main Program }
      begin
      Init;
      DoProgram;
      end.
      {–}

      {–}
      program KISS;
      {–}
      { Constant Declarations }
      const TAB = ^I;
      CR = ^M;
      LF = ^J;
      {–}
      { Type Declarations }
      type Symbol = string[8];
      SymTab = array[1..1000] of Symbol;
      TabPtr = ^SymTab;
      {–}
      { Variable Declarations }
      var Look : char; { Lookahead Character }
      Token : char; { Encoded Token }
      Value : string[16]; { Unencoded Token }
      Lcount: integer; { Label Counter }
      {–}
      { Definition of Keywords and Token Types }
      const KWlist: array [1..4] of Symbol =
      ('IF', 'ELSE', 'ENDIF', 'END');
      const KWcode: string[5] = 'xilee';
      {–}
      { 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 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 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 + '''');
      GetChar;
      SkipWhite;
      end;
      {–}
      { Skip a CRLF }
      procedure Fin;
      begin
      if Look = CR then GetChar;
      if Look = LF then GetChar;
      SkipWhite;
      end;
      {–}
      { Table Lookup }
      function Lookup(T: TabPtr; s: string; n: integer): integer;
      var i: integer;
      found: boolean;
      begin
      found := false;
      i := n;
      while (i > 0) and not found do
      if s = T^[i] then
      found := true
      else
      dec(i);
      Lookup := i;
      end;
      {–}
      { Get an Identifier }
      procedure GetName;
      begin
      while Look = CR do
      Fin;
      if not IsAlpha(Look) then Expected('Name');
      Value := '';
      while IsAlNum(Look) do begin
      Value := Value + UpCase(Look);
      GetChar;
      end;
      SkipWhite;
      end;
      {–}
      { Get a Number }
      procedure GetNum;
      begin
      if not IsDigit(Look) then Expected('Integer');
      Value := '';
      while IsDigit(Look) do begin
      Value := Value + Look;
      GetChar;
      end;
      Token := '#';
      SkipWhite;
      end;
      {–}
      { Get an Identifier and Scan it for Keywords }
      procedure Scan;
      begin
      GetName;
      Token := KWcode[Lookup(Addr(KWlist), Value, 4) + 1];
      end;
      {–}
      { Match a Specific Input String }
      procedure MatchString(x: string);
      begin
      if Value <> x then Expected('''' + x + '''');
      end;
      {–}
      { Generate a Unique Label }
      function NewLabel: string;
      var S: string;
      begin
      Str(LCount, S);
      NewLabel := 'L' + S;
      Inc(LCount);
      end;
      {–}
      { Post a Label To Output }
      procedure PostLabel(L: string);
      begin
      WriteLn(L, ':');
      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;
      begin
      GetName;
      if Look = '(' then begin
      Match('(');
      Match(')');
      EmitLn('BSR ' + Value);
      end
      else
      EmitLn('MOVE ' + Value + '(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 begin
      GetNum;
      EmitLn('MOVE #' + Value + ',D0');
      end;
      end;
      {–}
      { Parse and Translate the First Math Factor }
      procedure SignedFactor;
      var s: boolean;
      begin
      s := Look = '-';
      if IsAddop(Look) then begin
      GetChar;
      SkipWhite;
      end;
      Factor;
      if s then
      EmitLn('NEG 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;
      {–}
      { Completion of Term Processing (called by Term and FirstTerm }
      procedure Term1;
      begin
      while IsMulop(Look) do begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '*': Multiply;
      '/': Divide;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Math Term }
      procedure Term;
      begin
      Factor;
      Term1;
      end;
      {–}
      { Parse and Translate a Math Term with Possible Leading Sign }
      procedure FirstTerm;
      begin
      SignedFactor;
      Term1;
      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
      FirstTerm;
      while IsAddop(Look) do begin
      EmitLn('MOVE D0,-(SP)');
      case Look of
      '+': Add;
      '-': Subtract;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Boolean Condition }
      { This version is a dummy }
      Procedure Condition;
      begin
      EmitLn('Condition');
      end;
      {–}
      { Recognize and Translate an IF Construct }
      procedure Block; Forward;
      procedure DoIf;
      var L1, L2: string;
      begin
      Condition;
      L1 := NewLabel;
      L2 := L1;
      EmitLn('BEQ ' + L1);
      Block;
      if Token = 'l' then begin
      L2 := NewLabel;
      EmitLn('BRA ' + L2);
      PostLabel(L1);
      Block;
      end;
      PostLabel(L2);
      MatchString('ENDIF');
      end;
      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: string;
      begin
      Name := Value;
      Match('=');
      Expression;
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)');
      end;
      {–}
      { Recognize and Translate a Statement Block }
      procedure Block;
      begin
      Scan;
      while not (Token in ['e', 'l']) do begin
      case Token of
      'i': DoIf;
      else Assignment;
      end;
      Scan;
      end;
      end;
      {–}
      { Parse and Translate a Program }
      procedure DoProgram;
      begin
      Block;
      MatchString('END');
      EmitLn('END')
      end;
      {–}
      { Initialize }
      procedure Init;
      begin
      LCount := 0;
      GetChar;
      end;
      {–}
      { Main Program }
      begin
      Init;
      DoProgram;
      end.
      {–}

      {–}
      { Parse and Translate A Program }
      procedure Prog;
      var Name: char;
      begin
      Match('p'); { Handles program header part }
      Name := GetName;
      Prolog(Name);
      Match('.');
      Epilog(Name);
      end;
      {–}

      {–}
      { Write the Prolog }
      procedure Prolog;
      begin
      EmitLn('WARMST EQU $A01E');
      end;
      {–}
      { Write the Epilog }
      procedure Epilog(Name: char);
      begin
      EmitLn('DC WARMST');
      EmitLn('END ' + Name);
      end;
      {–}

      {–}
      { Parse and Translate a Pascal Block }
      procedure DoBlock(Name: char);
      begin
      end;
      {–}
      и измените Prog следующим образом:
      {–}
      { Parse and Translate A Program }
      procedure Prog;
      var Name: char;
      begin
      Match('p');
      Name := GetName;
      Prolog;
      DoBlock(Name);
      Match('.');
      Epilog(Name);
      end;
      {–}

      {–}
      { Parse and Translate a Pascal Block }
      procedure DoBlock(Name: char);
      begin
      Declarations;
      PostLabel(Name);
      Statements;
      end;
      {–}

      {–}
      { Parse and Translate the Declaration Part }
      procedure Declarations;
      begin
      while Look in ['l', 'c', 't', 'v', 'p', 'f'] do
      case Look of
      'l': Labels;
      'c': Constants;
      't': Types;
      'v': Variables;
      'p': DoProcedure;
      'f': DoFunction;
      end;
      end;
      {–}

      {–}
      { Process Label Statement }
      procedure Labels;
      begin
      Match('l');
      end;
      {–}
      { Process Const Statement }
      procedure Constants;
      begin
      Match('c');
      end;
      {–}
      { Process Type Statement }
      procedure Types;
      begin
      Match('t');
      end;
      {–}
      { Process Var Statement }
      procedure Variables;
      begin
      Match('v');
      end;
      {–}
      { Process Procedure Definition }
      procedure DoProcedure;
      begin
      Match('p');
      end;
      {–}
      { Process Function Definition }
      procedure DoFunction;
      begin
      Match('f');
      end;
      {–}

      {–}
      { Parse and Translate the Statement Part }
      procedure Statements;
      begin
      Match('b');
      while Look <> 'e' do
      GetChar;
      Match('e');
      end;
      {–}

      {–}
      { Parse and Translate A Program }
      procedure Prog;
      begin
      while Look <> ^Z do begin
      case Look of
      '#': PreProc;
      'i': IntDecl;
      'c': CharDecl;
      else DoFunction(Int);
      end;
      end;
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      while Look <> ^Z do begin
      GetClass;
      GetType;
      TopDecl;
      end;
      end.
      {–}

      {–}
      { Get a Storage Class Specifier }
      Procedure GetClass;
      begin
      if Look in ['a', 'x', 's'] then begin
      Class := Look;
      GetChar;
      end
      else Class := 'a';
      end;
      {–}

      {–}
      { Get a Type Specifier }
      procedure GetType;
      begin
      Typ := ' ';
      if Look = 'u' then begin
      Sign := 'u';
      Typ := 'i';
      GetChar;
      end
      else Sign := 's';
      if Look in ['i', 'l', 'c'] then begin
      Typ := Look;
      GetChar;
      end;
      end;
      {–}

      {–}
      { Process a Top-Level Declaration }
      procedure TopDecl;
      var Name: char;
      begin
      Name := Getname;
      if Look = '(' then
      DoFunc(Name)
      else
      DoData(Name);
      end;
      {–}

      {–}
      { Process a Function Definition }
      procedure DoFunc(n: char);
      begin
      Match('(');
      Match(')');
      Match('{');
      Match('}');
      if Typ = ' ' then Typ := 'i';
      Writeln(Class, Sign, Typ, ' function ', n);
      end;
      {–}
      { Process a Data Declaration }
      procedure DoData(n: char);
      begin
      if Typ = ' ' then Expected('Type declaration');
      Writeln(Class, Sign, Typ, ' data ', n);
      while Look = ',' do begin
      Match(',');
      n := GetName;
      WriteLn(Class, Sign, Typ, ' data ', n);
      end;
      Match(';');
      end;
      {–}

      {–}
      { Parse and Translate a Program }
      procedure Prog;
      begin
      Match('p');
      Header;
      Prolog;
      Match('.');
      Epilog;
      end;
      {–}

      {–}
      { Write Header Info }
      procedure Header;
      begin
      WriteLn('WARMST', TAB, 'EQU $A01E');
      end;
      {–}

      {–}
      { Write the Prolog }
      procedure Prolog;
      begin
      PostLabel('MAIN');
      end;
      {–}
      { Write the Epilog }
      procedure Epilog;
      begin
      EmitLn('DC WARMST');
      EmitLn('END MAIN');
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      Prog;
      if Look <> CR then Abort('Unexpected data after ''.''');
      end.
      {–}

      {–}
      { Parse and Translate a Program }
      procedure Prog;
      begin
      Match('p');
      Header;
      Main;
      Match('.');
      end;
      {–}

      {–}
      { Parse and Translate a Main Program }
      procedure Main;
      begin
      Match('b');
      Prolog;
      Match('e');
      Epilog;
      end;
      {–}

      {–}
      { Parse and Translate a Program }
      procedure Prog;
      begin
      Match('p');
      Header;
      TopDecls;
      Main;
      Match('.');
      end;
      {–}

      {–}
      { Process a Data Declaration }
      procedure Decl;
      begin
      Match('v');
      GetChar;
      end;
      {–}
      { Parse and Translate Global Declarations }
      procedure TopDecls;
      begin
      while Look <> 'b' do
      case Look of
      'v': Decl;
      else Abort('Unrecognized Keyword ''' + Look + '''');
      end;
      end;
      {–}

      {–}
      { Parse and Translate a Data Declaration }
      procedure Decl;
      var Name: char;
      begin
      Match('v');
      Alloc(GetName);
      end;
      {–}

      {–}
      { Allocate Storage for a Variable }
      procedure Alloc(N: char);
      begin
      WriteLn(N, ':', TAB, 'DC 0');
      end;
      {–}

      {–}
      { Parse and Translate a Data Declaration }
      procedure Decl;
      var Name: char;
      begin
      Match('v');
      Alloc(GetName);
      while Look = ',' do begin
      GetChar;
      Alloc(GetName);
      end;
      end;
      {–}

      {–}
      { Allocate Storage for a Variable }
      procedure Alloc(N: char);
      begin
      Write(N, ':', TAB, 'DC ');
      if Look = '=' then begin
      Match('=');
      WriteLn(GetNum);
      end
      else
      WriteLn('0');
      end;
      {–}

      {–}
      { Get a Number }
      function GetNum: integer;
      var Val: integer;
      begin
      Val := 0;
      if not IsDigit(Look) then Expected('Integer');
      while IsDigit(Look) do begin
      Val := 10 * Val + Ord(Look) – Ord('0');
      GetChar;
      end;
      GetNum := Val;
      end;
      {–}

      {–}
      { Allocate Storage for a Variable }
      procedure Alloc(N: char);
      begin
      if InTable(N) then Abort('Duplicate Variable Name ' + N);
      ST[N] := 'v';
      Write(N, ':', TAB, 'DC ');
      if Look = '=' then begin
      Match('=');
      If Look = '-' then begin
      Write(Look);
      Match('-');
      end;
      WriteLn(GetNum);
      end
      else
      WriteLn('0');
      end;
      {–}

      {–}
      { Look for Symbol in Table }
      function InTable(n: char): Boolean;
      begin
      InTable := ST[n] <> ' ';
      end;
      {–}

      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      begin
      GetChar;
      end;
      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      while Look <> 'e' do
      Assignment;
      end;
      {–}

      {–}
      { Parse and Translate a Main Program }
      procedure Main;
      begin
      Match('b');
      Prolog;
      Block;
      Match('e');
      Epilog;
      end;
      {–}

      {–}
      { Clear the Primary Register }
      procedure Clear;
      begin
      EmitLn('CLR D0');
      end;
      {–}
      { Negate the Primary Register }
      procedure Negate;
      begin
      EmitLn('NEG D0');
      end;
      {–}
      { Load a Constant Value to Primary Register }
      procedure LoadConst(n: integer);
      begin
      Emit('MOVE #');
      WriteLn(n, ',D0');
      end;
      {–}
      { Load a Variable to Primary Register }
      procedure LoadVar(Name: char);
      begin
      if not InTable(Name) then Undefined(Name);
      EmitLn('MOVE ' + Name + '(PC),D0');
      end;
      {–}
      { Push Primary onto Stack }
      procedure Push;
      begin
      EmitLn('MOVE D0,-(SP)');
      end;
      {–}
      { Add Top of Stack to Primary }
      procedure PopAdd;
      begin
      EmitLn('ADD (SP)+,D0');
      end;
      {–}
      { Subtract Primary from Top of Stack }
      procedure PopSub;
      begin
      EmitLn('SUB (SP)+,D0');
      EmitLn('NEG D0');
      end;
      {–}
      { Multiply Top of Stack by Primary }
      procedure PopMul;
      begin
      EmitLn('MULS (SP)+,D0');
      end;
      {–}
      { Divide Top of Stack by Primary }
      procedure PopDiv;
      begin
      EmitLn('MOVE (SP)+,D7');
      EmitLn('EXT.L D7');
      EmitLn('DIVS D0,D7');
      EmitLn('MOVE D7,D0');
      end;
      {–}
      { Store Primary to Variable }
      procedure Store(Name: char);
      begin
      if not InTable(Name) then Undefined(Name);
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)')
      end;
      {–}

      {–}
      { Report an Undefined Identifier }
      procedure Undefined(n: string);
      begin
      Abort('Undefined Identifier ' + n);
      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
      LoadVar(GetName)
      else
      LoadConst(GetNum);
      end;
      {–}
      { Parse and Translate a Negative Factor }
      procedure NegFactor;
      begin
      Match('-');
      if IsDigit(Look) then
      LoadConst(-GetNum)
      else begin
      Factor;
      Negate;
      end;
      end;
      {–}
      { Parse and Translate a Leading Factor }
      procedure FirstFactor;
      begin
      case Look of
      '+': begin
      Match('+');
      Factor;
      end;
      '-': NegFactor;
      else Factor;
      end;
      end;
      {–}
      { Recognize and Translate a Multiply }
      procedure Multiply;
      begin
      Match('*');
      Factor;
      PopMul;
      end;
      {–}
      { Recognize and Translate a Divide }
      procedure Divide;
      begin
      Match('/');
      Factor;
      PopDiv;
      end;
      {–}
      { Common Code Used by Term and FirstTerm }
      procedure Term1;
      begin
      while IsMulop(Look) do begin
      Push;
      case Look of
      '*': Multiply;
      '/': Divide;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Math Term }
      procedure Term;
      begin
      Factor;
      Term1;
      end;
      {–}
      { Parse and Translate a Leading Term }
      procedure FirstTerm;
      begin
      FirstFactor;
      Term1;
      end;
      {–}
      { Recognize and Translate an Add }
      procedure Add;
      begin
      Match('+');
      Term;
      PopAdd;
      end;
      {–}
      { Recognize and Translate a Subtract }
      procedure Subtract;
      begin
      Match('-');
      Term;
      PopSub;
      end;
      {–}
      { Parse and Translate an Expression }
      procedure Expression;
      begin
      FirstTerm;
      while IsAddop(Look) do begin
      Push;
      case Look of
      '+': Add;
      '-': Subtract;
      end;
      end;
      end;
      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: char;
      begin
      Name := GetName;
      Match('=');
      Expression;
      Store(Name);
      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;
      {–}
      Также нам понадобятся несколько подпрограмм генерации кода:
      {–}
      { Complement the Primary Register }
      procedure NotIt;
      begin
      EmitLn('NOT D0');
      end;
      {–}
      .
      .
      .
      {–}
      { AND Top of Stack with Primary }
      procedure PopAnd;
      begin
      EmitLn('AND (SP)+,D0');
      end;
      {–}
      { OR Top of Stack with Primary }
      procedure PopOr;
      begin
      EmitLn('OR (SP)+,D0');
      end;
      {–}
      { XOR Top of Stack with Primary }
      procedure PopXor;
      begin
      EmitLn('EOR (SP)+,D0');
      end;
      {–}
      { Compare Top of Stack with Primary }
      procedure PopCompare;
      begin
      EmitLn('CMP (SP)+,D0');
      end;
      {–}
      { Set D0 If Compare was = }
      procedure SetEqual;
      begin
      EmitLn('SEQ D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was != }
      procedure SetNEqual;
      begin
      EmitLn('SNE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was > }
      procedure SetGreater;
      begin
      EmitLn('SLT D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was < }
      procedure SetLess;
      begin
      EmitLn('SGT D0');
      EmitLn('EXT D0');
      end;
      {–}

      {–}
      { Recognize and Translate a Relational «Equals» }
      procedure Equals;
      begin
      Match('=');
      Expression;
      PopCompare;
      SetEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Not Equals» }
      procedure NotEquals;
      begin
      Match('#');
      Expression;
      PopCompare;
      SetNEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Less Than» }
      procedure Less;
      begin
      Match('<');
      Expression;
      PopCompare;
      SetLess;
      end;
      {–}
      { Recognize and Translate a Relational «Greater Than» }
      procedure Greater;
      begin
      Match('>');
      Expression;
      PopCompare;
      SetGreater;
      end;
      {–}
      { Parse and Translate a Relation }
      procedure Relation;
      begin
      Expression;
      if IsRelop(Look) then begin
      Push;
      case Look of
      '=': Equals;
      '#': NotEquals;
      '<': Less;
      '>': Greater;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Boolean Factor with Leading NOT }
      procedure NotFactor;
      begin
      if Look = '!' then begin
      Match('!');
      Relation;
      NotIt;
      end
      else
      Relation;
      end;
      {–}
      { Parse and Translate a Boolean Term }
      procedure BoolTerm;
      begin
      NotFactor;
      while Look = '&' do begin
      Push;
      Match('&');
      NotFactor;
      PopAnd;
      end;
      end;
      {–}
      { Recognize and Translate a Boolean OR }
      procedure BoolOr;
      begin
      Match('|');
      BoolTerm;
      PopOr;
      end;
      {–}
      { Recognize and Translate an Exclusive Or }
      procedure BoolXor;
      begin
      Match('~');
      BoolTerm;
      PopXor;
      end;
      {–}
      { Parse and Translate a Boolean Expression }
      procedure BoolExpression;
      begin
      BoolTerm;
      while IsOrOp(Look) do begin
      Push;
      case Look of
      '|': BoolOr;
      '~': BoolXor;
      end;
      end;
      end;
      {–}

      {–}
      { Branch Unconditional }
      procedure Branch(L: string);
      begin
      EmitLn('BRA ' + L);
      end;
      {–}
      { Branch False }
      procedure BranchFalse(L: string);
      begin
      EmitLn('TST D0');
      EmitLn('BEQ ' + L);
      end;
      {–}

      {–}
      { Recognize and Translate an IF Construct }
      procedure Block; Forward;
      procedure DoIf;
      var L1, L2: string;
      begin
      Match('i');
      BoolExpression;
      L1 := NewLabel;
      L2 := L1;
      BranchFalse(L1);
      Block;
      if Look = 'l' then begin
      Match('l');
      L2 := NewLabel;
      Branch(L2);
      PostLabel(L1);
      Block;
      end;
      PostLabel(L2);
      Match('e');
      end;
      {–}
      { Parse and Translate a WHILE Statement }
      procedure DoWhile;
      var L1, L2: string;
      begin
      Match('w');
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      BoolExpression;
      BranchFalse(L2);
      Block;
      Match('e');
      Branch(L1);
      PostLabel(L2);
      end;
      {–}

      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      while not(Look in ['e', 'l']) do begin
      case Look of
      'i': DoIf;
      'w': DoWhile;
      else Assignment;
      end;
      end;
      end;
      {–}

      {–}
      { Skip Over an End-of-Line }
      procedure NewLine;
      begin
      while Look = CR do begin
      GetChar;
      if Look = LF then GetChar;
      SkipWhite;
      end;
      end;
      {–}

      {–}
      { Type Declarations }
      type Symbol = string[8];
      SymTab = array[1..1000] of Symbol;
      TabPtr = ^SymTab;
      {–}
      { Variable Declarations }
      var Look : char; { Lookahead Character }
      Token: char; { Encoded Token }
      Value: string[16]; { Unencoded Token }
      ST: Array['A'..'Z'] of char;
      {–}
      { Definition of Keywords and Token Types }
      const NKW = 9;
      NKW1 = 10;
      const KWlist: array[1..NKW] of Symbol =
      ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE',
      'VAR', 'BEGIN', 'END', 'PROGRAM');
      const KWcode: string[NKW1] = 'xilewevbep';
      {–}

      {–}
      { Table Lookup }
      function Lookup(T: TabPtr; s: string; n: integer): integer;
      var i: integer;
      found: Boolean;
      begin
      found := false;
      i := n;
      while (i > 0) and not found do
      if s = T^[i] then
      found := true
      else
      dec(i);
      Lookup := i;
      end;
      {–}
      .
      .
      {–}
      { Get an Identifier and Scan it for Keywords }
      procedure Scan;
      begin
      GetName;
      Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
      end;
      {–}
      .
      .
      {–}
      { Match a Specific Input String }
      procedure MatchString(x: string);
      begin
      if Value <> x then Expected('''' + x + '''');
      end;
      {–}

      {–}
      { Get an Identifier }
      procedure GetName;
      begin
      NewLine;
      if not IsAlpha(Look) then Expected('Name');
      Value := '';
      while IsAlNum(Look) do begin
      Value := Value + UpCase(Look);
      GetChar;
      end;
      SkipWhite;
      end;
      {–}

      {–}
      { Parse and Translate a Math Factor }
      procedure BoolExpression; Forward;
      procedure Factor;
      begin
      if Look = '(' then begin
      Match('(');
      BoolExpression;
      Match(')');
      end
      else if IsAlpha(Look) then begin
      GetName;
      LoadVar(Value[1]);
      end
      else
      LoadConst(GetNum);
      end;
      {–}
      .
      .
      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: char;
      begin
      Name := Value[1];
      Match('=');
      BoolExpression;
      Store(Name);
      end;
      {–}
      .
      .
      {–}
      { Parse and Translate a Data Declaration }
      procedure Decl;
      begin
      GetName;
      Alloc(Value[1]);
      while Look = ',' do begin
      Match(',');
      GetName;
      Alloc(Value[1]);
      end;
      end;
      {–}

      {–}
      { Recognize and Translate an IF Construct }
      procedure Block; Forward;
      procedure DoIf;
      var L1, L2: string;
      begin
      BoolExpression;
      L1 := NewLabel;
      L2 := L1;
      BranchFalse(L1);
      Block;
      if Token = 'l' then begin
      L2 := NewLabel;
      Branch(L2);
      PostLabel(L1);
      Block;
      end;
      PostLabel(L2);
      MatchString('ENDIF');
      end;
      {–}
      { Parse and Translate a WHILE Statement }
      procedure DoWhile;
      var L1, L2: string;
      begin
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      BoolExpression;
      BranchFalse(L2);
      Block;
      MatchString('ENDWHILE');
      Branch(L1);
      PostLabel(L2);
      end;
      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      Scan;
      while not(Token in ['e', 'l']) do begin
      case Token of
      'i': DoIf;
      'w': DoWhile;
      else Assignment;
      end;
      Scan;
      end;
      end;
      {–}
      { Parse and Translate Global Declarations }
      procedure TopDecls;
      begin
      Scan;
      while Token <> 'b' do begin
      case Token of
      'v': Decl;
      else Abort('Unrecognized Keyword ' + Value);
      end;
      Scan;
      end;
      end;
      {–}
      { Parse and Translate a Main Program }
      procedure Main;
      begin
      MatchString('BEGIN');
      Prolog;
      Block;
      MatchString('END');
      Epilog;
      end;
      {–}
      { Parse and Translate a Program }
      procedure Prog;
      begin
      MatchString('PROGRAM');
      Header;
      TopDecls;
      Main;
      Match('.');
      end;
      {–}
      { Initialize }
      procedure Init;
      var i: char;
      begin
      for i := 'A' to 'Z' do
      ST[i] := ' ';
      GetChar;
      Scan;
      end;
      {–}

      {–}
      { Look for Symbol in Table }
      function InTable(n: Symbol): Boolean;
      begin
      InTable := Lookup(@ST, n, MaxEntry) <> 0;
      end;
      {–}

      {–}
      { Add a New Entry to Symbol Table }
      procedure AddEntry(N: Symbol; T: char);
      begin
      if InTable(N) then Abort('Duplicate Identifier ' + N);
      if NEntry = MaxEntry then Abort('Symbol Table Full');
      Inc(NEntry);
      ST[NEntry] := N;
      SType[NEntry] := T;
      end;
      {–}

      {–}
      { Allocate Storage for a Variable }
      procedure Alloc(N: Symbol);
      begin
      if InTable(N) then Abort('Duplicate Variable Name ' + N);
      AddEntry(N, 'v');
      .
      .
      .
      {–}

      {–}
      { Initialize }
      procedure Init;
      var i: integer;
      begin
      for i := 1 to MaxEntry do begin
      ST[i] := '';
      SType[i] := ' ';
      end;
      GetChar;
      Scan;
      end;
      {–}

      {–}
      { Set D0 If Compare was <= }
      procedure SetLessOrEqual;
      begin
      EmitLn('SGE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was >= }
      procedure SetGreaterOrEqual;
      begin
      EmitLn('SLE D0');
      EmitLn('EXT D0');
      end;
      {–}

      {–}
      { Recognize and Translate a Relational «Less Than or Equal» }
      procedure LessOrEqual;
      begin
      Match('=');
      Expression;
      PopCompare;
      SetLessOrEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Not Equals» }
      procedure NotEqual;
      begin
      Match('>');
      Expression;
      PopCompare;
      SetNEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Less Than» }
      procedure Less;
      begin
      Match('<');
      case Look of
      '=': LessOrEqual;
      '>': NotEqual;
      else begin
      Expression;
      PopCompare;
      SetLess;
      end;
      end;
      end;
      {–}
      { Recognize and Translate a Relational «Greater Than» }
      procedure Greater;
      begin
      Match('>');
      if Look = '=' then begin
      Match('=');
      Expression;
      PopCompare;
      SetGreaterOrEqual;
      end
      else begin
      Expression;
      PopCompare;
      SetGreater;
      end;
      end;
      {–}

      {–}
      { Read Variable to Primary Register }
      procedure ReadVar;
      begin
      EmitLn('BSR READ');
      Store(Value);
      end;
      {–}
      { Write Variable from Primary Register }
      procedure WriteVar;
      begin
      EmitLn('BSR WRITE');
      end;
      {–}

      {–}
      { Write Header Info }
      procedure Header;
      begin
      WriteLn('WARMST', TAB, 'EQU $A01E');
      EmitLn('LIB TINYLIB');
      end;
      {–}

      {–}
      { Definition of Keywords and Token Types }
      const NKW = 11;
      NKW1 = 12;
      const KWlist: array[1..NKW] of Symbol =
      ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE',
      'READ', 'WRITE', 'VAR', 'BEGIN', 'END',
      'PROGRAM');
      const KWcode: string[NKW1] = 'xileweRWvbep';
      {–}

      {–}
      { Process a Read Statement }
      procedure DoRead;
      begin
      Match('(');
      GetName;
      ReadVar;
      while Look = ',' do begin
      Match(',');
      GetName;
      ReadVar;
      end;
      Match(')');
      end;
      {–}
      { Process a Write Statement }
      procedure DoWrite;
      begin
      Match('(');
      Expression;
      WriteVar;
      while Look = ',' do begin
      Match(',');
      Expression;
      WriteVar;
      end;
      Match(')');
      end;
      {–}

      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      Scan;
      while not(Token in ['e', 'l']) do begin
      case Token of
      'i': DoIf;
      'w': DoWhile;
      'R': DoRead;
      'W': DoWrite;
      else Assignment;
      end;
      Scan;
      end;
      end;
      {–}

      {–}
      program Tiny10;
      {–}
      { Constant Declarations }
      const TAB = ^I;
      CR = ^M;
      LF = ^J;
      LCount: integer = 0;
      NEntry: integer = 0;
      {–}
      { Type Declarations }
      type Symbol = string[8];
      SymTab = array[1..1000] of Symbol;
      TabPtr = ^SymTab;
      {–}
      { Variable Declarations }
      var Look : char; { Lookahead Character }
      Token: char; { Encoded Token }
      Value: string[16]; { Unencoded Token }
      const MaxEntry = 100;
      var ST : array[1..MaxEntry] of Symbol;
      SType: array[1..MaxEntry] of char;
      {–}
      { Definition of Keywords and Token Types }
      const NKW = 11;
      NKW1 = 12;
      const KWlist: array[1..NKW] of Symbol =
      ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE',
      'READ', 'WRITE', 'VAR', 'BEGIN', 'END',
      'PROGRAM');
      const KWcode: string[NKW1] = 'xileweRWvbep';
      {–}
      { 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;
      {–}
      { 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 NewLine;
      begin
      while Look = CR do begin
      GetChar;
      if Look = LF then GetChar;
      SkipWhite;
      end;
      end;
      {–}
      { Match a Specific Input Character }
      procedure Match(x: char);
      begin
      NewLine;
      if Look = x then GetChar
      else Expected('''' + x + '''');
      SkipWhite;
      end;
      {–}
      { Table Lookup }
      function Lookup(T: TabPtr; s: string; n: integer): integer;
      var i: integer;
      found: Boolean;
      begin
      found := false;
      i := n;
      while (i > 0) and not found do
      if s = T^[i] then
      found := true
      else
      dec(i);
      Lookup := i;
      end;
      {–}
      { Locate a Symbol in Table }
      { Returns the index of the entry. Zero if not present. }
      function Locate(N: Symbol): integer;
      begin
      Locate := Lookup(@ST, n, MaxEntry);
      end;
      {–}
      { Look for Symbol in Table }
      function InTable(n: Symbol): Boolean;
      begin
      InTable := Lookup(@ST, n, MaxEntry) <> 0;
      end;
      {–}
      { Add a New Entry to Symbol Table }
      procedure AddEntry(N: Symbol; T: char);
      begin
      if InTable(N) then Abort('Duplicate Identifier ' + N);
      if NEntry = MaxEntry then Abort('Symbol Table Full');
      Inc(NEntry);
      ST[NEntry] := N;
      SType[NEntry] := T;
      end;
      {–}
      { Get an Identifier }
      procedure GetName;
      begin
      NewLine;
      if not IsAlpha(Look) then Expected('Name');
      Value := '';
      while IsAlNum(Look) do begin
      Value := Value + UpCase(Look);
      GetChar;
      end;
      SkipWhite;
      end;
      {–}
      { Get a Number }
      function GetNum: integer;
      var Val: integer;
      begin
      NewLine;
      if not IsDigit(Look) then Expected('Integer');
      Val := 0;
      while IsDigit(Look) do begin
      Val := 10 * Val + Ord(Look) – Ord('0');
      GetChar;
      end;
      GetNum := Val;
      SkipWhite;
      end;
      {–}
      { Get an Identifier and Scan it for Keywords }
      procedure Scan;
      begin
      GetName;
      Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
      end;
      {–}
      { Match a Specific Input String }
      procedure MatchString(x: string);
      begin
      if Value <> x then Expected('''' + x + '''');
      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;
      {–}
      { Generate a Unique Label }
      function NewLabel: string;
      var S: string;
      begin
      Str(LCount, S);
      NewLabel := 'L' + S;
      Inc(LCount);
      end;
      {–}
      { Post a Label To Output }
      procedure PostLabel(L: string);
      begin
      WriteLn(L, ':');
      end;
      {–}
      { Clear the Primary Register }
      procedure Clear;
      begin
      EmitLn('CLR D0');
      end;
      {–}
      { Negate the Primary Register }
      procedure Negate;
      begin
      EmitLn('NEG D0');
      end;
      {–}
      { Complement the Primary Register }
      procedure NotIt;
      begin
      EmitLn('NOT D0');
      end;
      {–}
      { Load a Constant Value to Primary Register }
      procedure LoadConst(n: integer);
      begin
      Emit('MOVE #');
      WriteLn(n, ',D0');
      end;
      {–}
      { Load a Variable to Primary Register }
      procedure LoadVar(Name: string);
      begin
      if not InTable(Name) then Undefined(Name);
      EmitLn('MOVE ' + Name + '(PC),D0');
      end;
      {–}
      { Push Primary onto Stack }
      procedure Push;
      begin
      EmitLn('MOVE D0,-(SP)');
      end;
      {–}
      { Add Top of Stack to Primary }
      procedure PopAdd;
      begin
      EmitLn('ADD (SP)+,D0');
      end;
      {–}
      { Subtract Primary from Top of Stack }
      procedure PopSub;
      begin
      EmitLn('SUB (SP)+,D0');
      EmitLn('NEG D0');
      end;
      {–}
      { Multiply Top of Stack by Primary }
      procedure PopMul;
      begin
      EmitLn('MULS (SP)+,D0');
      end;
      {–}
      { Divide Top of Stack by Primary }
      procedure PopDiv;
      begin
      EmitLn('MOVE (SP)+,D7');
      EmitLn('EXT.L D7');
      EmitLn('DIVS D0,D7');
      EmitLn('MOVE D7,D0');
      end;
      {–}
      { AND Top of Stack with Primary }
      procedure PopAnd;
      begin
      EmitLn('AND (SP)+,D0');
      end;
      {–}
      { OR Top of Stack with Primary }
      procedure PopOr;
      begin
      EmitLn('OR (SP)+,D0');
      end;
      {–}
      { XOR Top of Stack with Primary }
      procedure PopXor;
      begin
      EmitLn('EOR (SP)+,D0');
      end;
      {–}
      { Compare Top of Stack with Primary }
      procedure PopCompare;
      begin
      EmitLn('CMP (SP)+,D0');
      end;
      {–}
      { Set D0 If Compare was = }
      procedure SetEqual;
      begin
      EmitLn('SEQ D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was != }
      procedure SetNEqual;
      begin
      EmitLn('SNE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was > }
      procedure SetGreater;
      begin
      EmitLn('SLT D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was < }
      procedure SetLess;
      begin
      EmitLn('SGT D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was <= }
      procedure SetLessOrEqual;
      begin
      EmitLn('SGE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was >= }
      procedure SetGreaterOrEqual;
      begin
      EmitLn('SLE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Store Primary to Variable }
      procedure Store(Name: string);
      begin
      if not InTable(Name) then Undefined(Name);
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)')
      end;
      {–}
      { Branch Unconditional }
      procedure Branch(L: string);
      begin
      EmitLn('BRA ' + L);
      end;
      {–}
      { Branch False }
      procedure BranchFalse(L: string);
      begin
      EmitLn('TST D0');
      EmitLn('BEQ ' + L);
      end;
      {–}
      { Read Variable to Primary Register }
      procedure ReadVar;
      begin
      EmitLn('BSR READ');
      Store(Value[1]);
      end;
      { Write Variable from Primary Register }
      procedure WriteVar;
      begin
      EmitLn('BSR WRITE');
      end;
      {–}
      { Write Header Info }
      procedure Header;
      begin
      WriteLn('WARMST', TAB, 'EQU $A01E');
      end;
      {–}
      { Write the Prolog }
      procedure Prolog;
      begin
      PostLabel('MAIN');
      end;
      {–}
      { Write the Epilog }
      procedure Epilog;
      begin
      EmitLn('DC WARMST');
      EmitLn('END MAIN');
      end;
      {–}
      { Parse and Translate a Math Factor }
      procedure BoolExpression; Forward;
      procedure Factor;
      begin
      if Look = '(' then begin
      Match('(');
      BoolExpression;
      Match(')');
      end
      else if IsAlpha(Look) then begin
      GetName;
      LoadVar(Value);
      end
      else
      LoadConst(GetNum);
      end;
      {–}
      { Parse and Translate a Negative Factor }
      procedure NegFactor;
      begin
      Match('-');
      if IsDigit(Look) then
      LoadConst(-GetNum)
      else begin
      Factor;
      Negate;
      end;
      end;
      {–}
      { Parse and Translate a Leading Factor }
      procedure FirstFactor;
      begin
      case Look of
      '+': begin
      Match('+');
      Factor;
      end;
      '-': NegFactor;
      else Factor;
      end;
      end;
      {–}
      { Recognize and Translate a Multiply }
      procedure Multiply;
      begin
      Match('*');
      Factor;
      PopMul;
      end;
      {–}
      { Recognize and Translate a Divide }
      procedure Divide;
      begin
      Match('/');
      Factor;
      PopDiv;
      end;
      {–}
      { Common Code Used by Term and FirstTerm }
      procedure Term1;
      begin
      while IsMulop(Look) do begin
      Push;
      case Look of
      '*': Multiply;
      '/': Divide;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Math Term }
      procedure Term;
      begin
      Factor;
      Term1;
      end;
      {–}
      { Parse and Translate a Leading Term }
      procedure FirstTerm;
      begin
      FirstFactor;
      Term1;
      end;
      {–}
      { Recognize and Translate an Add }
      procedure Add;
      begin
      Match('+');
      Term;
      PopAdd;
      end;
      {–}
      { Recognize and Translate a Subtract }
      procedure Subtract;
      begin
      Match('-');
      Term;
      PopSub;
      end;
      {–}
      { Parse and Translate an Expression }
      procedure Expression;
      begin
      FirstTerm;
      while IsAddop(Look) do begin
      Push;
      case Look of
      '+': Add;
      '-': Subtract;
      end;
      end;
      end;
      {–}
      { Recognize and Translate a Relational «Equals» }
      procedure Equal;
      begin
      Match('=');
      Expression;
      PopCompare;
      SetEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Less Than or Equal» }
      procedure LessOrEqual;
      begin
      Match('=');
      Expression;
      PopCompare;
      SetLessOrEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Not Equals» }
      procedure NotEqual;
      begin
      Match('>');
      Expression;
      PopCompare;
      SetNEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Less Than» }
      procedure Less;
      begin
      Match('<');
      case Look of
      '=': LessOrEqual;
      '>': NotEqual;
      else begin
      Expression;
      PopCompare;
      SetLess;
      end;
      end;
      end;
      {–}
      { Recognize and Translate a Relational «Greater Than» }
      procedure Greater;
      begin
      Match('>');
      if Look = '=' then begin
      Match('=');
      Expression;
      PopCompare;
      SetGreaterOrEqual;
      end
      else begin
      Expression;
      PopCompare;
      SetGreater;
      end;
      end;
      {–}
      { Parse and Translate a Relation }
      procedure Relation;
      begin
      Expression;
      if IsRelop(Look) then begin
      Push;
      case Look of
      '=': Equal;
      '<': Less;
      '>': Greater;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Boolean Factor with Leading NOT }
      procedure NotFactor;
      begin
      if Look = '!' then begin
      Match('!');
      Relation;
      NotIt;
      end
      else
      Relation;
      end;
      {–}
      { Parse and Translate a Boolean Term }
      procedure BoolTerm;
      begin
      NotFactor;
      while Look = '&' do begin
      Push;
      Match('&');
      NotFactor;
      PopAnd;
      end;
      end;
      {–}
      { Recognize and Translate a Boolean OR }
      procedure BoolOr;
      begin
      Match('|');
      BoolTerm;
      PopOr;
      end;
      {–}
      { Recognize and Translate an Exclusive Or }
      procedure BoolXor;
      begin
      Match('~');
      BoolTerm;
      PopXor;
      end;
      {–}
      { Parse and Translate a Boolean Expression }
      procedure BoolExpression;
      begin
      BoolTerm;
      while IsOrOp(Look) do begin
      Push;
      case Look of
      '|': BoolOr;
      '~': BoolXor;
      end;
      end;
      end;
      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: string;
      begin
      Name := Value;
      Match('=');
      BoolExpression;
      Store(Name);
      end;
      {–}
      { Recognize and Translate an IF Construct }
      procedure Block; Forward;
      procedure DoIf;
      var L1, L2: string;
      begin
      BoolExpression;
      L1 := NewLabel;
      L2 := L1;
      BranchFalse(L1);
      Block;
      if Token = 'l' then begin
      L2 := NewLabel;
      Branch(L2);
      PostLabel(L1);
      Block;
      end;
      PostLabel(L2);
      MatchString('ENDIF');
      end;
      {–}
      { Parse and Translate a WHILE Statement }
      procedure DoWhile;
      var L1, L2: string;
      begin
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      BoolExpression;
      BranchFalse(L2);
      Block;
      MatchString('ENDWHILE');
      Branch(L1);
      PostLabel(L2);
      end;
      {–}
      { Process a Read Statement }
      procedure DoRead;
      begin
      Match('(');
      GetName;
      ReadVar;
      while Look = ',' do begin
      Match(',');
      GetName;
      ReadVar;
      end;
      Match(')');
      end;
      {–}
      { Process a Write Statement }
      procedure DoWrite;
      begin
      Match('(');
      Expression;
      WriteVar;
      while Look = ',' do begin
      Match(',');
      Expression;
      WriteVar;
      end;
      Match(')');
      end;
      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      Scan;
      while not(Token in ['e', 'l']) do begin
      case Token of
      'i': DoIf;
      'w': DoWhile;
      'R': DoRead;
      'W': DoWrite;
      else Assignment;
      end;
      Scan;
      end;
      end;
      {–}
      { Allocate Storage for a Variable }
      procedure Alloc(N: Symbol);
      begin
      if InTable(N) then Abort('Duplicate Variable Name ' + N);
      AddEntry(N, 'v');
      Write(N, ':', TAB, 'DC ');
      if Look = '=' then begin
      Match('=');
      If Look = '-' then begin
      Write(Look);
      Match('-');
      end;
      WriteLn(GetNum);
      end
      else
      WriteLn('0');
      end;
      {–}
      { Parse and Translate a Data Declaration }
      procedure Decl;
      begin
      GetName;
      Alloc(Value);
      while Look = ',' do begin
      Match(',');
      GetName;
      Alloc(Value);
      end;
      end;
      {–}
      { Parse and Translate Global Declarations }
      procedure TopDecls;
      begin
      Scan;
      while Token <> 'b' do begin
      case Token of
      'v': Decl;
      else Abort('Unrecognized Keyword ' + Value);
      end;
      Scan;
      end;
      end;
      {–}
      { Parse and Translate a Main Program }
      procedure Main;
      begin
      MatchString('BEGIN');
      Prolog;
      Block;
      MatchString('END');
      Epilog;
      end;
      {–}
      { Parse and Translate a Program }
      procedure Prog;
      begin
      MatchString('PROGRAM');
      Header;
      TopDecls;
      Main;
      Match('.');
      end;
      {–}
      { Initialize }
      procedure Init;
      var i: integer;
      begin
      for i := 1 to MaxEntry do begin
      ST[i] := '';
      SType[i] := ' ';
      end;
      GetChar;
      Scan;
      end;
      {–}
      { Main Program }
      begin
      Init;
      Prog;
      if Look <> CR then Abort('Unexpected data after ''.''');
      end.
      {–}

      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      Scan;
      while not(Token in ['e', 'l']) do begin
      case Token of
      'i': DoIf;
      'w': DoWhile;
      'R': DoRead;
      'W': DoWrite;
      else Assignment;
      end;
      Scan;
      end;
      end;
      {–}

      {–}
      { Get an Identifier }
      procedure GetName;
      begin
      SkipWhite;
      if Not IsAlpha(Look) then Expected('Identifier');
      Token := 'x';
      Value := '';
      repeat
      Value := Value + UpCase(Look);
      GetChar;
      until not IsAlNum(Look);
      end;
      {–}
      { Get a Number }
      procedure GetNum;
      begin
      SkipWhite;
      if not IsDigit(Look) then Expected('Number');
      Token := '#';
      Value := '';
      repeat
      Value := Value + Look;
      GetChar;
      until not IsDigit(Look);
      end;
      {–}

      {–}
      { Get an Operator }
      procedure GetOp;
      begin
      Token := Look;
      Value := '';
      repeat
      Value := Value + Look;
      GetChar;
      until IsAlpha(Look) or IsDigit(Look) or IsWhite(Look);
      end;
      {–}

      {–}
      { Get the Next Input Token }
      procedure Next;
      begin
      SkipWhite;
      if IsAlpha(Look) then GetName
      else if IsDigit(Look) then GetNum
      else GetOp;
      end;
      {–}

      {–}
      { Recognize White Space }
      function IsWhite(c: char): boolean;
      begin
      IsWhite := c in [' ', TAB, CR, LF];
      end;
      {–}

      {–}
      { Main Program }
      begin
      Init;
      repeat
      Next;
      WriteLn(Token, ' ', Value);
      until Token = '.';
      end.
      {–}

      {–}
      { Get an Operator }
      procedure GetOp;
      begin
      SkipWhite;
      Token := Look;
      Value := Look;
      GetChar;
      end;
      {–}

      {–}
      { Scan the Current Identifier for Keywords }
      procedure Scan;
      begin
      if Token = 'x' then
      Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
      end;
      {–}

      {–}
      { Match a Specific Input String }
      procedure MatchString(x: string);
      begin
      if Value <> x then Expected('''' + x + '''');
      Next;
      end;
      {–}

      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      Scan;
      while not(Token in ['e', 'l']) do begin
      case Token of
      'i': DoIf;
      'w': DoWhile;
      'R': DoRead;
      'W': DoWrite;
      else Assignment;
      end;
      Scan;
      end;
      end;
      {–}

      {–}
      { Parse and Translate a Boolean Expression }
      procedure BoolExpression;
      begin
      BoolTerm;
      while IsOrOp(Token) do begin
      Push;
      case Token of
      '|': BoolOr;
      '~': BoolXor;
      end;
      end;
      end;
      {–}

      {–}
      { Recognize and Translate an Add }
      procedure Add;
      begin
      Next;
      Term;
      PopAdd;
      end;
      {–}

      {–}
      { Recognize and Translate an IF Construct }
      procedure Block; Forward;
      procedure DoIf;
      var L1, L2: string;
      begin
      Next;
      BoolExpression;
      L1 := NewLabel;
      L2 := L1;
      BranchFalse(L1);
      Block;
      if Token = 'l' then begin
      Next;
      L2 := NewLabel;
      Branch(L2);
      PostLabel(L1);
      Block;
      end;
      PostLabel(L2);
      MatchString('ENDIF');
      end;
      {–}

TINY VERSION 1.1

      {–}
      program Tiny11;
      {–}
      { Constant Declarations }
      const TAB = ^I;
      CR = ^M;
      LF = ^J;
      LCount: integer = 0;
      NEntry: integer = 0;
      {–}
      { Type Declarations }
      type Symbol = string[8];
      SymTab = array[1..1000] of Symbol;
      TabPtr = ^SymTab;
      {–}
      { Variable Declarations }
      var Look : char; { Lookahead Character }
      Token: char; { Encoded Token }
      Value: string[16]; { Unencoded Token }
      const MaxEntry = 100;
      var ST : array[1..MaxEntry] of Symbol;
      SType: array[1..MaxEntry] of char;
      {–}
      { Definition of Keywords and Token Types }
      const NKW = 9;
      NKW1 = 10;
      const KWlist: array[1..NKW] of Symbol =
      ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE',
      'READ', 'WRITE', 'VAR', 'END');
      const KWcode: string[NKW1] = 'xileweRWve';
      {–}
      { 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 a Duplicate Identifier }
      procedure Duplicate(n: string);
      begin
      Abort('Duplicate Identifier ' + n);
      end;
      {–}
      { Check to Make Sure the Current Token is an Identifier }
      procedure CheckIdent;
      begin
      if Token <> 'x' then Expected('Identifier');
      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, CR, LF];
      end;
      {–}
      { Skip Over Leading White Space }
      procedure SkipWhite;
      begin
      while IsWhite(Look) do
      GetChar;
      end;
      {–}
      { Table Lookup }
      function Lookup(T: TabPtr; s: string; n: integer): integer;
      var i: integer;
      found: Boolean;
      begin
      found := false;
      i := n;
      while (i > 0) and not found do
      if s = T^[i] then
      found := true
      else
      dec(i);
      Lookup := i;
      end;
      {–}
      { Locate a Symbol in Table }
      { Returns the index of the entry. Zero if not present. }
      function Locate(N: Symbol): integer;
      begin
      Locate := Lookup(@ST, n, NEntry);
      end;
      {–}
      { Look for Symbol in Table }
      function InTable(n: Symbol): Boolean;
      begin
      InTable := Lookup(@ST, n, NEntry) <> 0;
      end;
      {–}
      { Check to See if an Identifier is in the Symbol Table }
      { Report an error if it's not. }
      procedure CheckTable(N: Symbol);
      begin
      if not InTable(N) then Undefined(N);
      end;
      {–}
      { Check the Symbol Table for a Duplicate Identifier }
      { Report an error if identifier is already in table. }
      procedure CheckDup(N: Symbol);
      begin
      if InTable(N) then Duplicate(N);
      end;
      {–}
      { Add a New Entry to Symbol Table }
      procedure AddEntry(N: Symbol; T: char);
      begin
      CheckDup(N);
      if NEntry = MaxEntry then Abort('Symbol Table Full');
      Inc(NEntry);
      ST[NEntry] := N;
      SType[NEntry] := T;
      end;
      {–}
      { Get an Identifier }
      procedure GetName;
      begin
      SkipWhite;
      if Not IsAlpha(Look) then Expected('Identifier');
      Token := 'x';
      Value := '';
      repeat
      Value := Value + UpCase(Look);
      GetChar;
      until not IsAlNum(Look);
      end;
      {–}
      { Get a Number }
      procedure GetNum;
      begin
      SkipWhite;
      if not IsDigit(Look) then Expected('Number');
      Token := '#';
      Value := '';
      repeat
      Value := Value + Look;
      GetChar;
      until not IsDigit(Look);
      end;
      {–}
      { Get an Operator }
      procedure GetOp;
      begin
      SkipWhite;
      Token := Look;
      Value := Look;
      GetChar;
      end;
      {–}
      { Get the Next Input Token }
      procedure Next;
      begin
      SkipWhite;
      if IsAlpha(Look) then GetName
      else if IsDigit(Look) then GetNum
      else GetOp;
      end;
      {–}
      { Scan the Current Identifier for Keywords }
      procedure Scan;
      begin
      if Token = 'x' then
      Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
      end;
      {–}
      { Match a Specific Input String }
      procedure MatchString(x: string);
      begin
      if Value <> x then Expected('''' + x + '''');
      Next;
      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;
      {–}
      { Generate a Unique Label }
      function NewLabel: string;
      var S: string;
      begin
      Str(LCount, S);
      NewLabel := 'L' + S;
      Inc(LCount);
      end;
      {–}
      { Post a Label To Output }
      procedure PostLabel(L: string);
      begin
      WriteLn(L, ':');
      end;
      {–}
      { Clear the Primary Register }
      procedure Clear;
      begin
      EmitLn('CLR D0');
      end;
      {–}
      { Negate the Primary Register }
      procedure Negate;
      begin
      EmitLn('NEG D0');
      end;
      {–}
      { Complement the Primary Register }
      procedure NotIt;
      begin
      EmitLn('NOT D0');
      end;
      {–}
      { Load a Constant Value to Primary Register }
      procedure LoadConst(n: string);
      begin
      Emit('MOVE #');
      WriteLn(n, ',D0');
      end;
      {–}
      { Load a Variable to Primary Register }
      procedure LoadVar(Name: string);
      begin
      if not InTable(Name) then Undefined(Name);
      EmitLn('MOVE ' + Name + '(PC),D0');
      end;
      {–}
      { Push Primary onto Stack }
      procedure Push;
      begin
      EmitLn('MOVE D0,-(SP)');
      end;
      {–}
      { Add Top of Stack to Primary }
      procedure PopAdd;
      begin
      EmitLn('ADD (SP)+,D0');
      end;
      {–}
      { Subtract Primary from Top of Stack }
      procedure PopSub;
      begin
      EmitLn('SUB (SP)+,D0');
      EmitLn('NEG D0');
      end;
      {–}
      { Multiply Top of Stack by Primary }
      procedure PopMul;
      begin
      EmitLn('MULS (SP)+,D0');
      end;
      {–}
      { Divide Top of Stack by Primary }
      procedure PopDiv;
      begin
      EmitLn('MOVE (SP)+,D7');
      EmitLn('EXT.L D7');
      EmitLn('DIVS D0,D7');
      EmitLn('MOVE D7,D0');
      end;
      {–}
      { AND Top of Stack with Primary }
      procedure PopAnd;
      begin
      EmitLn('AND (SP)+,D0');
      end;
      {–}
      { OR Top of Stack with Primary }
      procedure PopOr;
      begin
      EmitLn('OR (SP)+,D0');
      end;
      {–}
      { XOR Top of Stack with Primary }
      procedure PopXor;
      begin
      EmitLn('EOR (SP)+,D0');
      end;
      {–}
      { Compare Top of Stack with Primary }
      procedure PopCompare;
      begin
      EmitLn('CMP (SP)+,D0');
      end;
      {–}
      { Set D0 If Compare was = }
      procedure SetEqual;
      begin
      EmitLn('SEQ D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was != }
      procedure SetNEqual;
      begin
      EmitLn('SNE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was > }
      procedure SetGreater;
      begin
      EmitLn('SLT D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was < }
      procedure SetLess;
      begin
      EmitLn('SGT D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was <= }
      procedure SetLessOrEqual;
      begin
      EmitLn('SGE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Set D0 If Compare was >= }
      procedure SetGreaterOrEqual;
      begin
      EmitLn('SLE D0');
      EmitLn('EXT D0');
      end;
      {–}
      { Store Primary to Variable }
      procedure Store(Name: string);
      begin
      EmitLn('LEA ' + Name + '(PC),A0');
      EmitLn('MOVE D0,(A0)')
      end;
      {–}
      { Branch Unconditional }
      procedure Branch(L: string);
      begin
      EmitLn('BRA ' + L);
      end;
      {–}
      { Branch False }
      procedure BranchFalse(L: string);
      begin
      EmitLn('TST D0');
      EmitLn('BEQ ' + L);
      end;
      {–}
      { Read Variable to Primary Register }
      procedure ReadIt(Name: string);
      begin
      EmitLn('BSR READ');
      Store(Name);
      end;
      { Write from Primary Register }
      procedure WriteIt;
      begin
      EmitLn('BSR WRITE');
      end;
      {–}
      { Write Header Info }
      procedure Header;
      begin
      WriteLn('WARMST', TAB, 'EQU $A01E');
      end;
      {–}
      { Write the Prolog }
      procedure Prolog;
      begin
      PostLabel('MAIN');
      end;
      {–}
      { Write the Epilog }
      procedure Epilog;
      begin
      EmitLn('DC WARMST');
      EmitLn('END MAIN');
      end;
      {–}
      { Allocate Storage for a Static Variable }
      procedure Allocate(Name, Val: string);
      begin
      WriteLn(Name, ':', TAB, 'DC ', Val);
      end;
      {–}
      { Parse and Translate a Math Factor }
      procedure BoolExpression; Forward;
      procedure Factor;
      begin
      if Token = '(' then begin
      Next;
      BoolExpression;
      MatchString(')');
      end
      else begin
      if Token = 'x' then
      LoadVar(Value)
      else if Token = '#' then
      LoadConst(Value)
      else Expected('Math Factor');
      Next;
      end;
      end;
      {–}
      { Recognize and Translate a Multiply }
      procedure Multiply;
      begin
      Next;
      Factor;
      PopMul;
      end;
      {–}
      { Recognize and Translate a Divide }
      procedure Divide;
      begin
      Next;
      Factor;
      PopDiv;
      end;
      {–}
      { Parse and Translate a Math Term }
      procedure Term;
      begin
      Factor;
      while IsMulop(Token) do begin
      Push;
      case Token of
      '*': Multiply;
      '/': Divide;
      end;
      end;
      end;
      {–}
      { Recognize and Translate an Add }
      procedure Add;
      begin
      Next;
      Term;
      PopAdd;
      end;
      {–}
      { Recognize and Translate a Subtract }
      procedure Subtract;
      begin
      Next;
      Term;
      PopSub;
      end;
      {–}
      { Parse and Translate an Expression }
      procedure Expression;
      begin
      if IsAddop(Token) then
      Clear
      else
      Term;
      while IsAddop(Token) do begin
      Push;
      case Token of
      '+': Add;
      '-': Subtract;
      end;
      end;
      end;
      {–}
      { Get Another Expression and Compare }
      procedure CompareExpression;
      begin
      Expression;
      PopCompare;
      end;
      {–}
      { Get The Next Expression and Compare }
      procedure NextExpression;
      begin
      Next;
      CompareExpression;
      end;
      {–}
      { Recognize and Translate a Relational «Equals» }
      procedure Equal;
      begin
      NextExpression;
      SetEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Less Than or Equal» }
      procedure LessOrEqual;
      begin
      NextExpression;
      SetLessOrEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Not Equals» }
      procedure NotEqual;
      begin
      NextExpression;
      SetNEqual;
      end;
      {–}
      { Recognize and Translate a Relational «Less Than» }
      procedure Less;
      begin
      Next;
      case Token of
      '=': LessOrEqual;
      '>': NotEqual;
      else begin
      CompareExpression;
      SetLess;
      end;
      end;
      end;
      {–}
      { Recognize and Translate a Relational «Greater Than» }
      procedure Greater;
      begin
      Next;
      if Token = '=' then begin
      NextExpression;
      SetGreaterOrEqual;
      end
      else begin
      CompareExpression;
      SetGreater;
      end;
      end;
      {–}
      { Parse and Translate a Relation }
      procedure Relation;
      begin
      Expression;
      if IsRelop(Token) then begin
      Push;
      case Token of
      '=': Equal;
      '<': Less;
      '>': Greater;
      end;
      end;
      end;
      {–}
      { Parse and Translate a Boolean Factor with Leading NOT }
      procedure NotFactor;
      begin
      if Token = '!' then begin
      Next;
      Relation;
      NotIt;
      end
      else
      Relation;
      end;
      {–}
      { Parse and Translate a Boolean Term }
      procedure BoolTerm;
      begin
      NotFactor;
      while Token = '&' do begin
      Push;
      Next;
      NotFactor;
      PopAnd;
      end;
      end;
      {–}
      { Recognize and Translate a Boolean OR }
      procedure BoolOr;
      begin
      Next;
      BoolTerm;
      PopOr;
      end;
      {–}
      { Recognize and Translate an Exclusive Or }
      procedure BoolXor;
      begin
      Next;
      BoolTerm;
      PopXor;
      end;
      {–}
      { Parse and Translate a Boolean Expression }
      procedure BoolExpression;
      begin
      BoolTerm;
      while IsOrOp(Token) do begin
      Push;
      case Token of
      '|': BoolOr;
      '~': BoolXor;
      end;
      end;
      end;
      {–}
      { Parse and Translate an Assignment Statement }
      procedure Assignment;
      var Name: string;
      begin
      CheckTable(Value);
      Name := Value;
      Next;
      MatchString('=');
      BoolExpression;
      Store(Name);
      end;
      {–}
      { Recognize and Translate an IF Construct }
      procedure Block; Forward;
      procedure DoIf;
      var L1, L2: string;
      begin
      Next;
      BoolExpression;
      L1 := NewLabel;
      L2 := L1;
      BranchFalse(L1);
      Block;
      if Token = 'l' then begin
      Next;
      L2 := NewLabel;
      Branch(L2);
      PostLabel(L1);
      Block;
      end;
      PostLabel(L2);
      MatchString('ENDIF');
      end;
      {–}
      { Parse and Translate a WHILE Statement }
      procedure DoWhile;
      var L1, L2: string;
      begin
      Next;
      L1 := NewLabel;
      L2 := NewLabel;
      PostLabel(L1);
      BoolExpression;
      BranchFalse(L2);
      Block;
      MatchString('ENDWHILE');
      Branch(L1);
      PostLabel(L2);
      end;
      {–}
      { Read a Single Variable }
      procedure ReadVar;
      begin
      CheckIdent;
      CheckTable(Value);
      ReadIt(Value);
      Next;
      end;
      {–}
      { Process a Read Statement }
      procedure DoRead;
      begin
      Next;
      MatchString('(');
      ReadVar;
      while Token = ',' do begin
      Next;
      ReadVar;
      end;
      MatchString(')');
      end;
      {–}
      { Process a Write Statement }
      procedure DoWrite;
      begin
      Next;
      MatchString('(');
      Expression;
      WriteIt;
      while Token = ',' do begin
      Next;
      Expression;
      WriteIt;
      end;
      MatchString(')');
      end;
      {–}
      { Parse and Translate a Block of Statements }
      procedure Block;
      begin
      Scan;
      while not(Token in ['e', 'l']) do begin
      case Token of
      'i': DoIf;
      'w': DoWhile;
      'R': DoRead;
      'W': DoWrite;
      else Assignment;
      end;
      Scan;
      end;
      end;
      {–}
      { Allocate Storage for a Variable }
      procedure Alloc;
      begin
      Next;
      if Token <> 'x' then Expected('Variable Name');
      CheckDup(Value);
      AddEntry(Value, 'v');
      Allocate(Value, '0');
      Next;
      end;
      {–}
      { Parse and Translate Global Declarations }
      procedure TopDecls;
      begin
      Scan;
      while Token = 'v' do
      Alloc;
      while Token = ',' do
      Alloc;
      end;
      {–}
      { Initialize }
      procedure Init;
      begin
      GetChar;
      Next;
      end;
      {–}
      { Main Program }
      begin
      Init;
      MatchString('PROGRAM');
      Header;
      TopDecls;
      MatchString('BEGIN');
      Prolog;
      Block;
      MatchString('END');
      Epilog;
      end.
      {–}