untpasscriptcompile.~pas

delphi编写的pascal解释器

    SetLength(FUserMethodList, FCount + 30);
    end;
end;

procedure TUserMethodList.Clear;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    FreeAndNil(FUserMethodList[i]);
    end;

  SetLength(FUserMethodList, 30);

  FCount := 0;

end;

constructor TUserMethodList.Create;
begin
  SetLength(FUserMethodList, 30);
  FCount := 0;
end;

destructor TUserMethodList.Destroy;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    FreeAndNil(FUserMethodList[i]);
    end;

  SetLength(FUserMethodList, 0);
  
  inherited;
end;

function TUserMethodList.getMethodByID(aID: integer): TUserMethod;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    if FUserMethodList[i].ID = aID then
        begin
        Result := FUserMethodList[i];
        exit;
        end;
    end;

  raise Exception.Create('没该ID的方法！');
end;

function TUserMethodList.GetMethodByName(aName: string): TUserMethod;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    if SameText(FUserMethodList[i].Name, aName) then
      begin
      Result := FUserMethodList[i];
      exit;
      end;
    end;

  Result := nil;
end;


function TUserMethodList.getText: string;
var
  i: integer;
begin
  Result := '';

  for i := 0 to FCount - 1 do
    begin
    Result := UserMethod[i].Text + #13#10;
    end;

end;

{ TVMPCodeList }

function TVMPCodeList.AddVMPCode(aCmd, aP1, aP2: integer): TVMPCode;
begin
  CheckArray;

  FVMPCodeList[FCount] := TVMPCode.Create;
  FVMPCodeList[FCount].Cmd := aCmd;
  FVMPCodeList[FCount].P1 := aP1;
  FVMPCodeList[FCount].P2 := aP2;
  FVMPCodeList[FCount].FAddr := FCount;

  Result := FVMPCodeList[FCount];

  Inc(FCount);
end;

procedure TVMPCodeList.CheckArray;
begin
  if FCount >= Length(FVMPCodeList) then
    begin
    SetLength(FVMPCodeList, FCount + 30);
    end;
end;

procedure TVMPCodeList.Clear;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    FreeAndNil(FVMPCodeList[i]);
    end;

  SetLength(FVMPCodeList, 30);

  FCount := 0;

end;

constructor TVMPCodeList.Create;
begin
  FCount := 0;
  SetLength(FVMPCodeList, 30);
end;

destructor TVMPCodeList.Destroy;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    FreeAndNil(FVMPCodeList[i]);
    end;

  SetLength(FVMPCodeList, 0);
  
  inherited;
end;

function TVMPCodeList.getLastVMPCode: TVMPCode;
begin
  Result := FVMPCodeList[FCount - 1];
end;

function TVMPCodeList.getText: string;
var
  i: integer;
begin
  Result := '';

  for i := 0 to FCount - 1 do
    begin
    Result := Result + FVMPCodeList[i].getText + #13#10; 
    end;

end;

function TVMPCodeList.getVMPCodeByIndex(aIndex: integer): TVMPCode;
begin
  if (aIndex < 0) or (aIndex >= FCount) then raise Exception.Create('索引超出范围！');

  Result := FVMPCodeList[aIndex];
end;


{ TAnalyExpression }

procedure TAnalyExpression.Analy;
begin
  Expression;
end;

class procedure TAnalyExpression.Analy(aCodeMaker: TCodeMaker; aTokenReader: TTokenReader);
var
  analy: TAnalyExpression;
begin
  analy := TAnalyExpression.Create(aCodeMaker, aTokenReader);
try
  analy.Analy;

  finally
  FreeAndNil(analy);
  end;
end;

constructor TAnalyExpression.Create(aCodeMaker: TCodeMaker; aTokenReader: TTokenReader);
begin
  FCodeMaker := aCodeMaker;
  FTokenReader := aTokenReader;
end;

destructor TAnalyExpression.Destroy;
begin
  FCodeMaker := nil;
  FTokenReader := nil;
  
  inherited;
end;

procedure TAnalyExpression.Expression;
var
  tmp: TToken;
begin
  tmp := FTokenReader.NextToken;

  if tmp.ID = rcidMinus then
      begin
      FTokenReader.ReadToken;
      Term;
      FCodeMaker.PutCode(ocNeg, 0, 0);
      end
     else Term;

  tmp := FTokenReader.NextToken;
  
  while (tmp.ID = rcidPlus) or (tmp.ID = rcidMinus) or (tmp.ID = rwidOr) or (tmp.ID = rwidXor) do
    begin
    FTokenReader.ReadToken;
    
    Case tmp.ID of
        rcidPlus: begin
                  Term;
                  FCodeMaker.PutCode(ocAdd, 0, 0);
                  end;

        rcidMinus: begin
                 Term;
                 FCodeMaker.PutCode(ocSub, 0, 0);
                 end;

        rwidOr: begin
              Term;
              FCodeMaker.PutCode(ocOr, 0, 0);
              end;

        rwidXor: begin
               Term;
               FCodeMaker.PutCode(ocXor, 0, 0);
               end;
    end;

    tmp := FTokenReader.NextToken;
  end;

end;

procedure TAnalyExpression.Factor;
var
  str: string;
  aUserVar: TUserVar;
  aLevel: integer;
  method: TUserMethod;
  tmp: TToken;
begin
  tmp := FTokenReader.NextToken;

  case tmp.ID of
      udIdentifier: begin
                    str := tmp.data;

                    method := FCodeMaker.FindMethodByName(str, aLevel);
                    if method <> nil then
                       begin
                       TAnalyCallMethod.Analy(FCodeMaker, FTokenReader);
                       end
                      else begin
                           FTokenReader.ReadToken;
                           str := tmp.data;

                           aUserVar := FCodeMaker.FindVarByName(str, aLevel);
                           if aUserVar = nil then FTokenReader.Error('变量' + str + '没有定义');
                           FCodeMaker.PutCode(ocMov, aLevel, aUserVar.ID);
                           end;



                    end;

      rwidFalse: begin
                 FTokenReader.ReadToken;

                 aUserVar := FCodeMaker.RegisterConstVar('False');
                 aUserVar.Value := False;
                 aUserVar.VarType := vtStatic;
                 aUserVar.DataType := dtBool;

                 FCodeMaker.PutCode(ocLoadConst, 0, aUserVar.ID);
                 end;

      rwidTrue: begin
                FTokenReader.ReadToken;

                aUserVar := FCodeMaker.RegisterConstVar('True');
                aUserVar.Value := True;
                aUserVar.VarType := vtStatic;
                aUserVar.DataType := dtBool;

                FCodeMaker.PutCode(ocLoadConst, 0, aUserVar.ID);  
                end;

      rwidNil: begin
               FTokenReader.ReadToken;

               aUserVar := FCodeMaker.RegisterConstVar('Nil');
               aUserVar.Value := null;
               aUserVar.VarType := vtStatic;
               aUserVar.DataType := dtOther;

               FCodeMaker.PutCode(ocLoadConst, 0, aUserVar.ID);
               end;

      rwidNull: begin
                FTokenReader.ReadToken;

                aUserVar := FCodeMaker.RegisterConstVar('Null');
                aUserVar.Value := null;
                aUserVar.VarType := vtStatic;
                aUserVar.DataType := dtOther;

                FCodeMaker.PutCode(ocLoadConst, 0, aUserVar.ID);
                end;


      udNumberConst: begin
                     FTokenReader.ReadToken;

                     aUserVar := FCodeMaker.RegisterConstVar('Number');
                     aUserVar.Value := FTokenReader.CurToken.Data;
                     aUserVar.VarType := vtStatic;
                     aUserVar.DataType := dtFloat;

                     FCodeMaker.PutCode(ocLoadConst, 0, aUserVar.ID);
                     end;

      udStringConst: begin
                     FTokenReader.ReadToken;

                     aUserVar := FCodeMaker.RegisterConstVar('String');
                     aUserVar.Value := FTokenReader.CurToken.Data;
                     aUserVar.VarType := vtStatic;
                     aUserVar.DataType := dtStr;

                     FCodeMaker.PutCode(ocLoadConst, 0, aUserVar.ID);
                     end;

      rcidOpenBracket: begin
                       FTokenReader.ReadToken;
                       
                       Expression;
                       FTokenReader.getCloseBracket;
                       end;

  end;

end;

procedure TAnalyExpression.Term;
var
  tmp: TToken;
begin
  Factor;

  tmp := FTokenReader.NextToken;

  while (tmp.ID = rwidAnd) or (tmp.ID = rcidStar) or (tmp.ID = rcidSlash) or
        (tmp.ID = rwidDiv) or (tmp.ID = rwidMod) do
        begin
        Case tmp.ID of
          rwidAnd: begin
                   FTokenReader.ReadToken;
                   Factor;
                   FCodeMaker.PutCode(ocAnd, 0, 0);
                   end;

          rcidStar: begin
                    FTokenReader.ReadToken;
                    Factor;
                    FCodeMaker.PutCode(ocMul, 0, 0);
                    end;

          rcidSlash: begin
                     FTokenReader.ReadToken;
                     Factor;
                     FCodeMaker.PutCode(ocDiv, 0, 0);
                     end;

          rwidMod: begin
                   FTokenReader.ReadToken;
                   Factor;
                   FCodeMaker.PutCode(ocMod, 0, 0);
                   end;
          end;

        tmp := FTokenReader.NextToken;

        end;

end;

{ TAnalyStatement }

procedure TAnalyStatement.Analy;
begin
  Statement;
end;

class procedure TAnalyStatement.Analy(aCodeMaker: TCodeMaker;
  aTokenReader: TTokenReader);
var
  aAnaly: TAnalyStatement;
begin
  aAnaly := TAnalyStatement.Create(aCodeMaker, aTokenReader);
try
  aAnaly.Analy;

  finally
  FreeAndNil(aAnaly);
  end;
end;

constructor TAnalyStatement.Create(aCodeMaker: TCodeMaker; aTokenReader: TTokenReader);
begin
  FCodeMaker := aCodeMaker;
  FTokenReader := aTokenReader;
end;

destructor TAnalyStatement.Destroy;
begin
  FCodeMaker := nil;
  FTokenReader := nil;
  
  inherited;
end;

procedure TAnalyStatement.Statement;
var
  tmp: TToken;
  c1, c2, c3, lastcode: TVMPCode;
  aCondition: TAnalyCondition;
  aExpression: TAnalyExpression;
  aUserVar: TUserVar;
  aLevel: integer;
begin
  aCondition := TAnalyCondition.Create(FCodeMaker, FTokenReader);
  aExpression := TAnalyExpression.Create(FCodeMaker, FTokenReader);
try
  
  tmp := FTokenReader.NextToken;

  Case tmp.ID of
    rwidBegin: begin
               FTokenReader.ReadToken;

               Statement;
             
               while FTokenReader.NextToken.ID = rcidDelimeter do
                 begin
                 FTokenReader.ReadToken;
                 Statement;
                 end;

               FTokenReader.ReadToken;
             
               if FTokenReader.CurToken.ID <> rwidEnd then FTokenReader.Error('期望end!');
               end;

    rwidIf: begin
            FTokenReader.ReadToken;

            aCondition.Analy;

            c1 := FCodeMaker.PutCode(ocIfFalseGoto, 0, 0);

            FTokenReader.ReadToken;

            if FTokenReader.CurToken.ID <> rwidThen then FTokenReader.Error('期望then！');

            Statement;

            c1.P2 := FCodeMaker.LastVMPCode.Addr + 1;

            if FTokenReader.NextToken.ID = rcidDelimeter then exit;

            if FTokenReader.NextToken.ID <> rwidElse then FTokenReader.Error('期望else!');

            FTokenReader.ReadToken;

            c2 := FCodeMaker.PutCode(ocGoto, 0, 0);

            c1.P2 := c2.Addr + 1;

            Statement;

            c2.P2 := FCodeMaker.LastVMPCode.Addr + 1;
            end;

    rwidWhile: begin
               FTokenReader.ReadToken;

               lastcode := FCodeMaker.LastVMPCode;

               aCondition.Analy;

               c1 := FCodeMaker.PutCode(ocIfFalseGoto, 0, 0);