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

      Наконец, мы должны внести изменения, позволяющие использовать Token вместо Look как символа для проверки и вызывать Scan в подходящих местах. По большей части это включает удаление вызовов Match, редкие замены вызовов Match на вызовы MatchString, и замену вызовов NewLine на вызовы Scan. Вот затронутые подпрограммы:

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

      Это должно работать. Если все изменения сделаны правильно, вы должны теперь анализировать программы, которые выглядят как программы. (Если вы не сделали всех изменений, не отчаивайтесь. Полный листинг конечной формы дан ниже.)
      Работает? Если да, то мы почти дома. Фактически, с несколькими небольшими исключениями, мы уже получили компилятор, пригодный для использования. Имеются еще несколько областей, требующих усовершенствования.

Многосимвольные имена переменных

      Одна из них – ограничение, требующее использования односимвольных имен переменных. Теперь, когда мы можем обрабатывать многосимвольные ключевые слова, это ограничение начинает казаться произвольным и ненужным. И действительно это так. В основном, единственное его достоинство в том, что он позволяет получить тривиально простую реализацию таблицы идентификаторов. Но это просто удобство для создателей компиляторов и оно должно быть уничтожено.
      Мы уже делали этот шаг прежде. На этот раз, как обычно, я сделаю это немного по-другому. Я думаю подход, примененный здесь, сохранит простоту настолько, насколько это возможно.
      Естественным путем реализации таблицы идентификаторов на Pascal является объявление переменной типа запись и создание таблицы идентификаторов как массива таких записей. Здесь, однако, нам в действительности пока не нужно поле типа (существует пока что только один разрешенный тип), так что нам нужен только массив символов. Это имеет свое преимущество, потому что мы можем использовать существующую процедуру Lookup для поиска в таблице идентификаторов также как и в списке ключевых слов. Оказывается, даже когда нам нужны больше полей, мы все равно можем использовать тот же самый подход, просто сохраняя другие поля в отдельных массивах.
      Вот изменения, которые необходимо сделать. Сперва добавьте новую типизированную константу:
      NEntry: integer = 0;
      Затем измените определение таблицы идентификаторов как показано ниже:
      const MaxEntry = 100;
      var ST : array[1..MaxEntry] of Symbol;
      (Обратите внимание, что ST не объявлен как SymTab. Это объявление липовое, чтобы заставить Lookup работать. SymTab заняля бы слишком много памяти и поэтому фактически никогда не обьявляется).
      Затем мы должны заменить InTable.

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

      Нам также необходима новая процедура AddEntry, которая добавляет новый элемент в таблицу:

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

      Эта процедура вызывается из Alloc:

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

      Наконец, мы должны изменить все подпрограммы, которые в настоящее время обрабатывают имена переменных как одиночный символ. Они включают LoadVar и Store (просто измените тип с char на string) и Factor, Assignment и Decl (просто измените Value[1] на Value).
      Последняя вещь: измените процедуру Init для очистки массива как показано ниже:

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

      Это должно работать. Испытайте ее и проверьте, что вы действительно можете использовать многосимвольные имена переменных.

Снова операторы отношений

      У нас осталось последнее односимвольное ограничение – ограничение операторов отношений. Некоторые из операторов отношений действительно состоят из одиночных символов, но другие требуют двух. Это '<=' и '>='. Я также предпочитаю Паскалевское '<>' для «не равно» вместо '#'.
      Как вы помните, в главе 7 я указал, что стандартный способ работы с операторами отношений – включить их в список ключевых слов и позволить лексическому анализатору отыскивать их. Но, опять, это требует выполнение полного анализа выражения, тогда как до этого мы у нас была возможность ограничить использование сканера началом утверждения.
      Я упомянул тогда, что мы все же можем избежать неприятностей с этим, так как многосимвольных операторов отношений немного и они ограничены в применении. Было бы легко обрабатывать их просто как специальные случаи и поддерживать их специальным способом.
      Требуемые изменения влияют только на подпрограммы генерации кода и процедуры Relation и ее друзей. Сперва, нам понадобятся еще две подпрограммы генерации кода:

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

      Это все, что требуется. Теперь вы можете обрабатывать все операторы отношений. Попробуйте.

Ввод/Вывод

      Теперь у нас есть полный, работающий язык, за исключением одного небольшого смущающего факта: у нас нет никакого способа получить или вывести данные. Нам нужны подпрограммы ввода/вывода.
      Современное соглашение, установленное в C и продолженное в Ada и Modula-2, состоит в том, чтобы вывести I/O операторы из самого языка и просто включить их в библиотеку подпрограмм. Это было бы прекрасно, за исключением того, что мы пока не имеем никаких средств поддержки подпрограмм. В любом случае, с этим подходом вы столкнетесь с проблемой переменной длины списка параметров. В Паскале I/O операторы встроены в язык, поэтому это единственные операторы, для которых список параметров может иметь переменное число элементов. В C мы примиряемся с клуджами типа scanf и printf и должны передавать количество параметров в вызываемую процедуру. В Ada и Modula-2 мы должны использовать неудобный (и медленный!) способ отдельного вызова для каждого аргумента.
      Так что я думаю, что предпочитаю Паскалевский подход встраивания подпрограмм ввода/вывода, даже если мы не нуждаемся в этом.
      Как обычно, для этого нам нужны еще несколько подпрограмм генерации кода. Они, оказывается, самые простые из всех, потому что все, что мы делаем это вызываем библиотечные процедуры для выполнения работы.

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

      Идея состоит в том, что READ загружает значение из входного потока в D0, а WRITE выводит его оттуда.
      Эти две процедуры представляют собой нашу первую встречу с потребностью в библиотечных процедурах... компонентах Run Time Library (RTL). Конечно кто-то (а именно мы) должен написать эти подпрограммы, но они не являются непосредственно частью компилятора. Я даже не буду беспокоиться о том, чтобы показать здесь эти подпрограммы, так как они очевидно очень ОС-зависимы. Я просто скажу, что для SK*DOS они особенно просты... почти тривиальны. Одна из причин, по которым я не буду показывать их здесь в том, что вы можете добавлять новые виды возможностей, например приглашение в READ или возможность пользователю повторить ошибочный ввод.
      Но это действительно отдельный от компилятора проект, так что теперь я буду подразумевать что библиотека, называемая TINYLIB.LIB, существует.
      Так как нам теперь нужно загружать ее, мы должны добавить ее загрузку в процедуру Header:

      {–}
      { 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';
      {–}

      (Обратите внимание, что здесь я использую кода в верхнем регистре чтобы избежать конфликта с 'w' из WHILE.) Затем нам нужны процедуры для обработки оператора ввода/вывода и его списка параметров:

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

      Наконец, мы должны расширить процедуру Block для поддержки новых типов операторов:

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

      На этом все. Теперь у нас есть язык!

Заключение

      К этому моменту мы полностью определили TINY. Он не слишком значителен... в действительности игрушечный комиплятор. TINY имеет только один тип данных и не имеет подпрограмм... но это законченный, пригодный для использования язык. Пока что вы не имеете возможности написать на нем другой компилятор или сделать что-нибудь еще очень серьезное, но вы могли бы писать программы для чтения входных данных, выполнения вычислений и вывода результатов. Не слишком плохо для игрушки.
      Более важно, что мы имеем твердую основу для дальнейшего развития. Я знаю, что вы будете рады слышать это: в последний раз я начал с создания синтаксического анализатора заново... с этого момента я предполагаю просто добавлять возможности в TINY пока он не превратится в KISS. Ох, будет время, когда нам понадобится попробовать некоторые вещи с новыми копиями Cradle, но как только мы разузнаем как они делаются, они будут встроены в TINY.
      Какие это будут возможности? Хорошо, для начала нам понадобятся подпрограммы и функции. Затем нам нужна возможность обрабатывать различные типы, включая массивы, строки и другие структуры. Затем нам нужно работать с идеей указателей. Все это будет в следующих главах.
      Увидимся.
      В справочных целях полный листинг TINY версии 1.0 показан ниже:

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