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

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;

{–}

Этот код позаботится почти обо всем. Испытайте его, посмотрите, сможете ли вы «сломать» («break») его (каламбур). Аккуратней однако. К настоящему времени мы использовали так много букв, что трудно придумать символ, который не представляет сейчас какое либо зарезервированное слово. Не забудьте, перед тем, как вы протестируете программу, вы должны будете исправить каждый случай появления Block в других циклах для включения нового параметра. Сделайте это точно так же, как я сделал это для LOOP.

Я сказал выше «почти». Есть одна небольшая проблема: если вы внимательно посмотрите на код, генерируемый для DO, вы увидите, что если вы прервете этот цикл, то значение счетчика все еще остается в стеке. Мы должны исправить это! Позор... это была одна из самых маленьких наших подпрограмм, но это не помогло. Вот новая версия, которая не имеет этой проблемы:

{–}

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

{–}

Две дополнительные инструкции SUBQ и ADDQ заботятся о сохранении стека в правильной форме.

К этому моменту мы создали ряд управляющих конструкций... в действительности более богатый набор чем предоставляет почти любой другой язык программирования. И, за исключением цикла FOR, это было довольно легко сделать. Но даже этот цикл был сложен только потому, что сложность заключалась в ассемблере.

Я завершаю на этом урок. Чтобы можно было обернуть наш продукт красной ленточкой, в действительности мы должны иметь настоящие ключевые слова вместо этих игрушечных односимвольных. Вы уже видели, что расширить компилятор для поддержки многосимвольных слов не трудно, но в этом случае возникнут большие различия в представлении нашего входного кода. Я оставлю этот небольшой кусочек для следующей главы. В этой главе мы также рассмотрим логические выражения, так что мы сможем избавиться от фиктивной версии Condition, которую мы здесь использовали. Увидимся.

Для справочных целей привожу полный текст синтаксического анализатора для этого урока:

{–}

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('');

end;

{–}

{ Parse and Translate a Math Expression }

procedure Expression;

begin

EmitLn('');

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 }