К этому моменту мы создали
К этому моменту мы создали ряд управляющих конструкций... в действительности более богатый набор чем предоставляет почти любой другой язык программирования. И, за исключением цикла 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('<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.
{--------------------------------------------------------------}
{ 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.
{--------------------------------------------------------------}
