Лекции по построению компилятора на Pascal

       

К этому моменту мы создали


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

Содержание раздела