plparser.pas

简单编译器的源代码,是大学课程设计内容,附简单测试用例

unit plparser;
interface
uses pcommon,plscan;


{   Pass2  :  THE PL PARSER  --  PLPARSER.PAS   }
const
    MaxLabel = 1000;
    MaxLevel = 10;
type

  OperationPart=(Add2,And2,Arrow2,Assign2,Bar2,Call2,constant2,Divide2,
                 EndProc2,EndProg2,Equal2,Fi2,Greater2,Index2,Less2,Minus2,
                 Modulo2,Multiply2,Not2,Or2,Proc2,Prog2,Read2,Subtract2,
                 Value2,Variable2,Write2,DefAddr2,DefArg2);

procedure pass2;

implementation

 procedure Pass2;
   const
       NoName = 0;
       MaxVarAccessTable = 20;
   type
       Symbols = set of SymbolType;
       SymbolTables = array [0..42] of SymbolType;
       NameClass = ( Constantx, ArrayType, Variable, Procedur, Undefined);
       VariableType = ( Integer2, Boolean2,ArrayType2,CommonType2);
       VarAccessTable = array [1..MaxVarAccessTable] of VariableType;
       Classes = set of NameClass;
       VariableTypes = set of VariableType;
       Pointer = ^ ObjectRecord;
       ObjectRecord = record
            Name: integer;
            Previous: Pointer;
            case Kind: NameClass of
              Constantx: (ConstValue: integer; ConstType: VariableType);
              ArrayType: (Bound: integer; ArrLevel,ArrDispl:integer;
                          ElementType: VariableType);
               Variable: (VarLevel, VarDispl: integer; VarType: VariableType);
               Procedur: (ProcLevel, ProcLabel: integer)
       end;
       BlockRecord = record
            TempLength, MaxTemp,CurLen: integer;
            LastObject: Pointer
       end;
       BlockTable = array [0..MaxLevel] of BlockRecord;

    var
      Symbol: SymbolType;
      SymbolOrd, Argument, BlockLevel: integer;
      SymbolTable: SymbolTables;
      VarAccTypeTable,ExprTypeTable: VarAccessTable;
      Block: BlockTable;
      AddSymbols, ConstantSymbols,
      TermSymbols, FactorSymbols, TypeSymbols,
      LongSymbols, MultiplySymbols,
      RelationSymbols, SelectorSymbols,
      definitionSymbols, AndOrSymbols,
      StatementSymbols, ExpressionSymbols : Symbols;
      Variables: Classes;
      LabelNo: integer;

    { INPUT }
    procedure NextSymbol;
      begin
          Read(Input1, SymbolOrd);
          Symbol := SymbolTable[SymbolOrd];
          while Symbol = NewLine1 do
            begin
                Read(Input1, LineNo);
                NewLine(LineNo);
                Read(Input1, SymbolOrd);
                Symbol := SymbolTable[SymbolOrd]
            end;
          if Symbol in LongSymbols then  Read(Input1, Argument)
      end;

    { OUTPUT }
    procedure Emit1(Op: OperationPart);
      begin
          Emit(ord(Op))
      end;

    procedure Emit2(Op: OperationPart; Arg: integer);
      begin
          Emit(ord(Op));
          Emit(Arg)
      end;


    procedure Emit3(Op: OperationPart; Arg1, Arg2: integer);
      begin
          Emit(ord(Op));
          Emit(Arg1);
          Emit(Arg2)
      end;

    { SCOPE ANALYSIS }
    procedure Search(Name,LevelNo:integer; var Found:Boolean;
                               var Object0:Pointer  );
      var
          More: Boolean;
      begin
          More := true;  Object0 := Block[LevelNo].LastObject;
          while More do
            if Object0 = nil then
              begin
                  More := false;
                  Found := false
              end
            else
              if Object0^.Name = Name then
                begin
                    More := false;
                    Found := true
                end
              else  Object0 := Object0^.Previous
      end;

    procedure Define(Name: integer; Kind: NameClass; var Object0: Pointer);
      var
          Found: Boolean;  Other: Pointer;
      begin
          if Name <> NoName then
            begin
                Search(Name, BlockLevel, Found, Other);
                if Found then  Error(Ambiguous3)
            end;
          New(Object0);
          Object0^.Name := Name;
          Object0^.Previous := Block[BlockLevel].LastObject;
          Object0^.Kind := Kind;
          Block[BlockLevel].LastObject := Object0
      end;

    procedure Find(Name: integer; var Object0: Pointer);
      var
          More, Found: Boolean;  LevelNo: integer;
      begin
          More := true;  LevelNo := BlockLevel;
          while More do
            begin
                Search(Name, LevelNo, Found, Object0);
                if Found or (LevelNo = 0) then  More := false
                else  LevelNo := LevelNo - 1
            end;
          if not Found then
            begin
                Error(Undefined3);
                Define(Name, Undefined, Object0)
            end
      end;

    procedure NewBlock;
      var
          Current: BlockRecord;
      begin
          TestLimit(BlockLevel, MaxLevel);
          BlockLevel := BlockLevel + 1;
          Current.CurLen := 0;
          Current.TempLength := 0;
          Current.MaxTemp := 0;
          Current.LastObject := nil;
          Block[BlockLevel] := Current
      end;

    procedure EndBlock;
      begin
          BlockLevel := BlockLevel - 1
      end;

    procedure StandardBlock;
      begin
          BlockLevel := -1;
          NewBlock;
      end;

    { TYPE ANALYSIS }
    procedure CheckTypes(var Type1: VariableType; Type2: VariableType);
      begin
          if (Type1 <> Type2) then   
            begin
                if (Type1 <> CommonType2) and (Type2 <> CommonType2) then
                    Error(Type3);
                Type1:=CommonType2;
            end;
      end;

    procedure TypeError(var Typex: VariableType);
      begin
          if Typex <> CommonType2 then
            begin
                Error(Type3);
                Typex := CommonType2;
            end
      end;

    procedure KindError(Object0: Pointer);
      begin
          if Object0^.Kind <> Undefined then  Error(Kind3)
      end;

    { LABELS }
    procedure NewLabel(var No: integer);
      begin
          TestLimit(LabelNo, MaxLabel);
          LabelNo := LabelNo + 1;
          No := LabelNo
      end;

    { TEMPORARIES }
    procedure Push(Length: integer);
      begin
          Block[BlockLevel].TempLength:=Block[BlockLevel].TempLength+Length;
          if Block[BlockLevel].MaxTemp < Block[BlockLevel].TempLength then
          Block[BlockLevel].MaxTemp := Block[BlockLevel].TempLength
      end;

    procedure Pop(Length: integer);
      begin
          Block[BlockLevel].TempLength:=Block[BlockLevel].TempLength-Length
      end;

    { INITIALIZATION }
    procedure Initialize;
      begin
          AddSymbols := [ Minus1, Plus1 ];
          AndOrSymbols := [ And1, Or1 ];
          ConstantSymbols := [ Name1, Numeral1, False1, True1 ];
          DefinitionSymbols := [ Const1, Integer1, Boolean1, Proc1 ];
          ExpressionSymbols:=[LeftParenthesis1,Minus1,Name1,
                              Not1,Numeral1,Plus1,False1,True1];
          FactorSymbols := [ LeftParenthesis1, Name1, Not1, Numeral1, False1, True1 ];
          LongSymbols := [ Name1, Numeral1 ];
          MultiplySymbols := [ Asterisk1, Div1, Mod1 ];
          RelationSymbols:=[ Equal1, Greater1, Less1 ];
          SelectorSymbols := [ LeftBracket1 ];
          StatementSymbols := [ Call1, Do1, If1, Name1, Skip1,
                                Read1, Write1 ];
          TermSymbols := FactorSymbols;
          TypeSymbols := [ Integer1, Boolean1 ];
          Variables := [ Variable, ArrayType ];
          LabelNo := 0;
          SymbolTable[0]  := And1;              SymbolTable[1]  := Array1;
          SymbolTable[2]  := Arrow1;            SymbolTable[3]  := Asterisk1;
          SymbolTable[4]  := Becomes1;          SymbolTable[5]  := Begin1;
          SymbolTable[6]  := Boolean1;          SymbolTable[7]  := Bracket1;
          SymbolTable[8]  := Call1;             SymbolTable[9]  := Comma1;
          SymbolTable[10] := Const1;            SymbolTable[11] := Div1;
          SymbolTable[12] := Do1;               SymbolTable[13] := End1;
          SymbolTable[14] := EndText1;          SymbolTable[15] := Equal1;
          SymbolTable[16] := False1;            SymbolTable[17] := Fi1;
          SymbolTable[18] := Greater1;          SymbolTable[19] := If1;
          SymbolTable[20] := Integer1;          SymbolTable[21] := LeftBracket1;
          SymbolTable[22] := LeftParenthesis1;  SymbolTable[23] := Less1;
          SymbolTable[24] := Minus1;            SymbolTable[25] := Mod1;
          SymbolTable[26] := Name1;             SymbolTable[27] := Newline1;
          SymbolTable[28] := Not1;              SymbolTable[29] := Numeral1;
          SymbolTable[30] := Od1;               SymbolTable[31] := Or1;
          SymbolTable[32] := Period1;           SymbolTable[33] := Plus1;
          SymbolTable[34] := Proc1;             SymbolTable[35] := Read1;
          SymbolTable[36] := RightBracket1;     SymbolTable[37] := RightParenthesis1;
          SymbolTable[38] := Semicolon1;        SymbolTable[39] := Skip1;
          SymbolTable[40] := True1;             SymbolTable[41] := Unknown1;
          SymbolTable[42] := Write1;
      end;

    { SYNTAX ANALYSIS }
    procedure SyntaxError(Stop: Symbols);
      begin
          Error(Syntax3);
          while not (Symbol in Stop) do
              NextSymbol
      end;

    procedure SyntaxCheck(Stop: Symbols);
      begin
          if not (Symbol in Stop) then  SyntaxError(Stop)
      end;

    procedure Expect(s: SymbolType; Stop: Symbols);
      begin
          if Symbol = s then  NextSymbol
          else  SyntaxError(Stop);
          SyntaxCheck(Stop)
      end;

    procedure ExpectName(Var Name: integer; Stop: Symbols);
      begin
          if Symbol = Name1 then
            begin
                Name := Argument;
                NextSymbol
            end
          else
            begin
                Name := NoName;
                SyntaxError(Stop)
            end;
          SyntaxCheck(Stop)
      end;

    { Constant ::= Numeral | False1 | True1 | ConstantName }
    procedure Constant(var Value: integer;
                       var Typex:VariableType; Stop:Symbols);
      var
          Object0: Pointer;
      begin
          case  Symbol  of
            Numeral1: begin
                          Value := Argument;
                          Typex := Integer2;
                          Expect(Numeral1,Stop)
                      end;
              False1: begin
                          Value := ord(false);
                          Typex := Boolean2;
                          Expect(False1,Stop);
                      end;
               True1: begin
                          Value := ord(true);