plparser.pas

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

                          Typex := Boolean2;
                          Expect(True1,Stop);
                      end;
               Name1: begin
                          Find(Argument, Object0);
                          if Object0 = nil then
                            begin
                                KindError(Object0);
                                Value := 0;
                                Typex := CommonType2;
                            end
                          else if Object0^.Kind = Constantx then
                                 begin
                                     Value := Object0^.ConstValue;
                                     Typex := Object0^.constType
                                 end
                               else
                                 begin
                                     KindError(Object0);
                                     Value := 0;
                                     Typex := CommonType2;
                                 end;
                          Expect(Name1, Stop)
                      end;
              else    begin    {  case  else  }
                          SyntaxError(Stop);
                          Value := 0;
                          Typex := CommonType2
                      end
           end { case }
      end;

    { ConstantDefinition ::= "const" ConstantName “=” Constant }
    procedure ConstantDefinition(Stop: Symbols);
      var
          Name, Value: integer;  Constx: Pointer; Typex: VariableType;
      begin
          Expect(Const1, [Name1, Equal1] + ConstantSymbols + Stop);
          ExpectName(Name, [Equal1] + ConstantSymbols + Stop);
          Expect( Equal1, ConstantSymbols + Stop);
          Constant(Value, Typex, Stop);
          Define(Name,Constantx, Constx);
          Constx^.ConstValue := Value;
          Constx^.ConstType := Typex;
      end;

    { VariableList ::= VariableName # "," VariableName # }
    procedure VariableList(Kind: NameClass; var Number: integer;
                           var LastVar: Pointer; Stop: Symbols);
      var
          Name: integer;
      begin
          ExpectName(Name, [Comma1, Name1] + Stop);
          Define(Name, Kind, LastVar);
          Number:=Number+1;
          while Symbol = Comma1 do
            begin
                Expect(Comma1, [Name1] + Stop);
                VariableList(Kind, Number, LastVar, Stop);
            end;
      end;

    { VariableDefinition ::= VariableType VariableList |
             VariableType "array" VariableList "[" Constant "]" }
    { VariableType ::= "integer" | "boolean" }
    procedure VariableDefinition(var LastVar: Pointer;
              var Length:integer;Stop: Symbols);
      var
          Number,value,i: integer;  VarTypex,Typex: VariableType;
          varlist:Pointer; temsymbol:SymbolType;
      begin
          temsymbol:=Symbol;
          if temsymbol = Integer1 then VarTypex:=Integer2
          else
            if temsymbol =Boolean1 then VarTypex:=Boolean2
            else VarTypex:=CommonType2;
          Expect(temsymbol,[Name1, Array1]+ConstantSymbols+Stop);
          if (Symbol = Array1) then
            begin
                Expect(Array1,[Name1, LeftBracket1, RightBracket1]+ConstantSymbols+Stop);
                Number:=0;
                VariableList(ArrayType,Number,varlist,
                             [LeftBracket1, RightBracket1]+ConstantSymbols+Stop);
                Expect(LeftBracket1,[RightBracket1]+ConstantSymbols+Stop);
                Constant(value,Typex,[RightBracket1]+ConstantSymbols+Stop);
                Expect(RightBracket1,ConstantSymbols+Stop);
                LastVar := varlist;
                i:=Number;
                while i > 0 do
                  begin
                      varlist^.ArrLevel:=BlockLevel;
                      varlist^.ArrDispl:=3+Block[Blocklevel].CurLen+(i-1)*value;
                      varlist^.Bound:=value;
                      varlist^.ElementType:=VarTypex;
                      varlist:=varlist^.Previous;
                      i:=i-1;
                  end;
                Length:=Number*value;
            end
          else
            begin
                Number:=0;
                VariableList(Variable,Number,varlist,Stop);
                LastVar := varlist;
                i:=Number;
                while i > 0 do
                  begin
                      varlist^.VarLevel:=BlockLevel;
                      varlist^.VarDispl:=3+Block[BlockLevel].CurLen+(i-1);
                      varlist^.VarType:=VarTypex;
                      varlist:=varlist^.Previous;
                      i:=i-1;
                  end;
                Length:=Number;
            end;
          Block[BlockLevel].CurLen:=Block[BlockLevel].CurLen+Length;

      end;

    { ProcedureDefinition ::= “proc” ProcedureName ParProgram }

    procedure PartProgram(BeginLabel, VarLabel: integer;
                          Stop: Symbols);      forward;

    procedure ProcedureDefinition(Stop: Symbols);
      var
          Name: integer;  Proc: Pointer;
          BeginLabel,VarLabel: integer;
      begin
          Expect(Proc1,[Name1,Begin1]+Stop);
          ExpectName(Name, [Begin1] + Stop);
          Define(Name, Procedur, Proc);
          Proc^.ProcLevel := BlockLevel;
          NewLabel(Proc^.ProcLabel);
          NewLabel(VarLabel);
          NewLabel(BeginLabel);
          Emit2(DefAddr2,Proc^.ProcLabel);
          Emit3(Proc2, VarLabel, BeginLabel);
          PartProgram(BeginLabel,VarLabel,[Semicolon1]+Stop);
          Emit1(EndProc2);
      end;

    { IndexedSelector ::= “[“ Expression “]” }
    procedure Expression(var Typex: VariableType; Stop: Symbols); forward;

    procedure IndexSelector(ArrVar:Pointer; Stop: Symbols);
      var
          ExprType: VariableType;
      begin
          Expect(LeftBracket1,[RightBracket1]+ExpressionSymbols + Stop);
          Expression(ExprType, [RightBracket1] + Stop);
          if ExprType = Integer2 then
            begin
                CheckTypes(ExprType, Integer2);
                Emit3(Index2, ArrVar^.Bound, LineNo);
                Pop(1);
            end
          else
            begin
                KindError(ArrVar);
            end;
          Expect(RightBracket1, Stop)
      end;

    { VariableAccess ::= VariableName # IndexSelector #
       IndexSelector ::= "[" Expression "]" }
    procedure VariableAccess(var Typex:VariableType;Stop: Symbols);
      var
          Stop2: Symbols;  Object0: Pointer;  Level, Displ: integer;
      begin
          if Symbol = Name1 then
            begin
                Stop2 := SelectorSymbols + Stop;
                Find(Argument, Object0);
                Expect(Name1, Stop2);
                if Object0^.Kind in Variables then
                  begin
                      if Object0^.Kind = Variable then
                        begin
                            Typex := Object0^.VarType;
                            Level := BlockLevel-Object0^.VarLevel;
                            Displ := Object0^.VarDispl;
                            Emit3(Variable2,Level,Displ);
                        end
                      else
                        begin
                            Typex := Object0^.ElementType;
                            Level := BlockLevel - Object0^.ArrLevel;
                            Displ := Object0^.ArrDispl;
                            Emit3(Variable2,Level,Displ);
                            IndexSelector(Object0,Stop);
                        end;
                      Push(1)
                  end
                else
                  begin
                      KindError(Object0);
                      Typex := CommonType2;
                  end;
                if Name1 = LeftBracket1 then
                  IndexSelector(Object0,ExpressionSymbols+[LeftBracket1]+Stop);
            end
          else
            begin
                SyntaxError(Stop);
                Typex := commonType2;
            end
      end;

    { Factor ::= Constant|VariableAccess|”(“ Expression “)”
                 |”~” Factor }
    procedure Factor(var Typex: VariableType;  Stop: Symbols);
      var
          Object0: Pointer;  Value: integer;
      begin
          if Symbol in ConstantSymbols-[Name1] then
            begin
                Constant(Value, Typex, Stop);
                Emit2(Constant2, Value);
                Push(1)
            end
          else
            if Symbol = Name1 then
              begin
                  Find(Argument, Object0);
                  if Object0^.Kind = Constantx then
                    begin
                        Constant(Value, Typex, Stop);
                        Emit2(Constant2, Value);
                        Push(1)
                    end
                  else
                    if Object0^.Kind in Variables then
                      begin
                          VariableAccess(Typex,Stop);
                          Emit1(Value2);
                          Push(1)
                      end
                    else
                      begin
                          Typex := CommonType2;
                          Expect(Name1, Stop)
                      end
              end
            else
              if Symbol = LeftParenthesis1 then
                begin
                    Expect(LeftParenthesis1, [RightParenthesis1]
                           + ExpressionSymbols + Stop);
                    Expression(Typex, [RightParenthesis1] + Stop);
                    Expect(RightParenthesis1, Stop)
                end
              else
                if Symbol = Not1 then
                  begin
                      Expect(Not1, FactorSymbols + Stop);
                      Factor(Typex, Stop);
                      CheckTypes(Typex, Boolean2);
                      Emit1(Not2)
                  end
                else
                  begin
                      SyntaxError(Stop);
                      Typex:= CommonType2
                  end
      end;

    { Term ::= Factor # MultiplyingOperator Factor #
      MultiplyingOperator ::= “*” | “/” | “\” }
    procedure Term(var Typex: VariableType; Stop: Symbols);
      var
          Stop2: Symbols;Operator: SymbolType;Type2: VariableType;
      begin
          Stop2 := MultiplySymbols + Stop;
          Factor(Typex, Stop2);
          while Symbol in MultiplySymbols do
            begin
                Operator := Symbol;
                Expect(Symbol, FactorSymbols + Stop2);
                Factor(Type2, Stop2);
                if Typex = Integer2 then
                  begin
                      CheckTypes(Typex, Type2);
                      if Operator = Asterisk1 then
                        Emit1(Multiply2)
                      else
                        if Operator = Div1 then  Emit1(Divide2)
                        else
                          Emit1(Modulo2);
                      Pop(1)
                  end
                else
                  TypeError(Typex)
            end
      end;

    { SimpleExpression ::= [ "-" ] Term # AddingOperator Term #
      AddingOperator ::= “+” | “-“ }
    procedure SimpleExpression(var Typex: VariableType; Stop: Symbols);
      var
          Stop2: Symbols;  Operator: SymbolType;  Type2: VariableType;
      begin
          Stop2 := AddSymbols + Stop;
          SyntaxCheck([Minus1] + TermSymbols + Stop2);
          if Symbol = Minus1 then
            begin
                Operator := Symbol;
                Expect(Symbol, TermSymbols + Stop2);
                Term(Typex, Stop2);
                CheckTypes(TYpex, Integer2);
                if Operator = Minus1 then  Emit1(Minus2)
            end
          else  Term(Typex, Stop2);
          while Symbol in AddSymbols do
            begin
                Operator := Symbol;
                Expect(Symbol, TermSymbols + Stop2);
                Term(Type2,Stop2);
                if Typex = Integer2 then
                  begin
                      CheckTypes(Typex, Type2);
                      if Operator = Plus1 then  Emit1(Add2)
                      else