Креншоу Джек. Давайте создадим компилятор!

   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;
   {–}
   Теперь мы должны сделать довольно много тонких изменений в оставшихся процедурах. Сначала мы должны изменить функцию GetName на процедуру, снова как в главе 7:

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

   Обратите внимание, что эта процедура оставляет свой результат в глобальной строковой переменной Value.
   Затем, мы должны изменить каждую обращение к GetName чтобы отразить ее новую форму. Они происходят в Factor, Assignment и Decl:

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

   (Заметьте, что мы все еще разрешаем только односимвольные имена переменных поэтому мы используем здесь простое решение и просто используем первый символ строки.)
   Наконец, мы должны внести изменения, позволяющие использовать 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;
   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 }