tutor11.doc

计算机编译原理教材

       {--------------------------------------------------------------}
       { Check to See if an Identifier is in the Symbol Table         }
       { Report an error if it's not. }


       procedure CheckTable(N: Symbol);
       begin
          if not InTable(N) then Undefined(N);
       end;


       {--------------------------------------------------------------}
       { Check the Symbol Table for a Duplicate Identifier }
       { Report an error if identifier is already in table. }


       procedure CheckDup(N: Symbol);
       begin
          if InTable(N) then Duplicate(N);
       end;


       {--------------------------------------------------------------}
       { Add a New Entry to Symbol Table }

       procedure AddEntry(N: Symbol; T: char);
       begin
          CheckDup(N);
          if NEntry = MaxEntry then Abort('Symbol Table Full');
          Inc(NEntry);
          ST[NEntry] := N;
          SType[NEntry] := T;
       end;


       {--------------------------------------------------------------}
       { Get an Identifier }

       procedure GetName;
       begin
          SkipWhite;
          if Not IsAlpha(Look) then Expected('Identifier');
          Token := 'x';
          Value := '';
          repeat
             Value := Value + UpCase(Look);
             GetChar;
          until not IsAlNum(Look);A*2A*
                                    - 17 -

PA2A





       end;


       {--------------------------------------------------------------}
       { Get a Number }

       procedure GetNum;
       begin
          SkipWhite;
          if not IsDigit(Look) then Expected('Number');
          Token := '#';
          Value := '';
          repeat
             Value := Value + Look;
             GetChar;
          until not IsDigit(Look);
       end;


       {--------------------------------------------------------------}
       { Get an Operator }

       procedure GetOp;
       begin
          SkipWhite;
          Token := Look;
          Value := Look;
          GetChar;
       end;


       {--------------------------------------------------------------}
       { Get the Next Input Token }

       procedure Next;
       begin
          SkipWhite;
          if IsAlpha(Look) then GetName
          else if IsDigit(Look) then GetNum
          else GetOp;
       end;


       {--------------------------------------------------------------}
       { Scan the Current Identifier for Keywords }

       procedure Scan;
       begin
          if Token = 'x' then
             Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
       end;


       {--------------------------------------------------------------}A*2A*
                                    - 18 -

PA2A





       { Match a Specific Input String }

       procedure MatchString(x: string);
       begin
          if Value <> x then Expected('''' + x + '''');
          Next;
       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;
       beginA*2A*
                                    - 19 -

PA2A





          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: string);
       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 }A62A6
                                    - 20 -A*2A*

PA2A





       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;A62A6
                                    - 21 -A*2A*

PA2A





       {---------------------------------------------------------------}
       { 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');A*2A*
                                    - 22 -

PA2A





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


       {---------------------------------------------------------------}A*2A*
                                    - 23 -

PA2A





       { Read Variable to Primary Register }

       procedure ReadIt(Name: string);
       begin
          EmitLn('BSR READ');
          Store(Name);
       end;


       { Write from Primary Register }

       procedure WriteIt;
       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;


       {---------------------------------------------------------------}
       { Allocate Storage for a Static Variable }

       procedure Allocate(Name, Val: string);
       begin
          WriteLn(Name, ':', TAB, 'DC ', Val);
       end;AB2AB
                                    - 24 -A*2A*

PA2A





       {---------------------------------------------------------------}
       { Parse and Translate a Math Factor }

       procedure BoolExpression; Forward;

       procedure Factor;
       begin
          if Token = '(' then begin
             Next;
             BoolExpression;
             MatchString(')');
             end
          else begin
             if Token = 'x' then
                LoadVar(Value)
             else if Token = '#' then