untpasscriptcompile.~pas

delphi编写的pascal解释器

                end;

         ocLoadConst: begin
                      aUserVar := FConstVarList.getVarByID(p2);
                      FStack.Put(aUserVar.Value);
                      end;

         ocSto: begin
                aUserVar := FVarList.getVarByID(p2);
                 
                if aUserVar.VarType = vtStatic then FVarList.getVarByID(p2).Value := FStack.Pop
                    else if (aUserVar.VarType = vtDynamic) or (aUserVar.VarType = vtParam) then
                            begin
                            aCallInfo := FCallStack.GetPreCallInfo(p1);

                            aDynaAddr := aCallInfo.BaseDynaVarAddr + aUserVar.OffPos;

                            FDynaVarStack.GetVarByPos(aDynaAddr).Value := FStack.Pop;
                            end;
                end;

         ocAdd: begin
                v1 := FStack.Pop;
                v2 := FStack.Pop;
                FStack.Put(v1 + v2);
                end;

         ocIncVar: begin
                   v1 := FStack.Pop;
                   FStack.Put(v1 + p2);
                   end;

         ocSub: begin
                v1 := FStack.Pop;
                v2 := FStack.Pop;
                FStack.Put(v2 - v1);
                end;

         ocMul: begin
                v1 := FStack.Pop;
                v2 := FStack.Pop;
                FStack.Put(v2 * v1);
                end;

         ocDiv: begin
                v1 := FStack.Pop;
                v2 := FStack.Pop;
                FStack.Put(v2 / v1);
                end;

         ocEqual: begin
                  v1 := FStack.Pop;
                  v2 := FStack.Pop;
                  FStack.Put(v1 = v2);
                  end;

         ocGreater: begin
                    v2 := FStack.Pop;
                    v1 := FStack.Pop;
                    FStack.Put(v1 > v2);
                    end;

         ocGreaterEqual: begin
                         v2 := FStack.Pop;
                         v1 := FStack.Pop;
                         FStack.Put(v1 >= v2);
                         end;

         ocLess: begin
                 v2 := FStack.Pop;
                 v1 := FStack.Pop;
                 FStack.Put(v1 < v2);
                 end;

         ocLessEqual: begin
                      v2 := FStack.Pop;
                      v1 := FStack.Pop;
                      FStack.Put(v1 <= v2);
                      end;

         ocNotEqual: begin
                     v2 := FStack.Pop;
                     v1 := FStack.Pop;
                     FStack.Put(v1 <> v2);
                     end;

         ocIfFalseGoto: begin
                        v2 := FStack.Pop;
                        if not v2 then
                            begin
                            i := p2;
                            continue;
                            end;

                        end;

         ocGoto: begin
                 i := p2;
                 continue; 
                 end;

         ocCall: begin
                 aMethod := FMethodList.getMethodByID(p2);

                 aCallInfo := FCallStack.PutMethodCall(aMethod, i);

                 FDynaVarStack.LoadMethodVar(aMethod);

                 for j := 0 to aMethod.ParamList.Count - 1 do
                   begin
                   aUserVar := TUserVar(aMethod.ParamList.Items[j]);
                   FDynaVarStack.FVarList.FUserVarList[aCallInfo.BaseDynaVarAddr + aUserVar.OffPos].Value := FStack.Pop;
                   end;

                 if not aMethod.SysMethodFlag then
                    begin
                    i := aMethod.Addr;
                    continue;
                    end
                   else begin
                        for j := 0 to aMethod.ParamList.Count - 1 do
                            begin
                            aUserVarList.FCount := 0;
                            aUserVarList.AddVar(FDynaVarStack.FVarList.FUserVarList[aCallInfo.BaseDynaVarAddr + j]);
                            aMethod.SysProcMethod(aUserVarList);
                            end;

                        i := aMethod.Addr;
                        continue;
                        end;
                 end;

         ocReturn: begin
                   aCallInfo := FCallStack.LastCallInfo;

                   if aCallInfo.FMethod.FMethodType = mtFun then
                       begin
                       FStack.Put(FDynaVarStack.getTopValue);
                       end;

                   FDynaVarStack.UnLoadVar(aCallInfo.VarCount);

                   i := aCallInfo.CallAddr + 1;

                   FCallStack.RemoveLastCall;

                   continue;
                   end;

           else raise Exception.Create('未知命令！');
         end;

    Inc(i);

    end;
   
   
end;

{ TUserVarList }

function TUserVarList.AddVar(aName: string): TUserVar;
begin
  CheckArray;

  FUserVarList[FCount] := TUserVar.Create;
  FUserVarList[FCount].ID := FCount;
  FUserVarList[FCount].Name := aName;

  Result := FUserVarList[FCount];

  Inc(FCount);
end;

procedure TUserVarList.AddVar(aUserVar: TUserVar);
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    //if FUserVarList[i].ID = aUserVar.ID then raise Exception.Create('已经有ID等于' + IntToStr(aUserVar.ID) + '的变量！');
    end;

  CheckArray;
  FUserVarList[FCount] := aUserVar;

  Inc(FCount);
end;

function TUserVarList.AddVar(aID: integer; aName: string; aValue: variant;
  aDataType: TDataType; aVarType: TVarType; aOffPos: integer): TUserVar;
begin
  CheckArray;

  FUserVarList[FCount] := TUserVar.Create;
  FUserVarList[FCount].ID := aID;
  FUserVarList[FCount].Name := aName;
  FUserVarList[FCount].Value := aValue;
  FUserVarList[FCount].DataType := aDataType;
  FUserVarList[FCount].VarType := aVarType;
  FUserVarList[FCount].OffPos := aOffPos;

  Result := FUserVarList[FCount];

  Inc(FCount);
end;

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

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

  setLength(FUserVarList, 30);

  FCount := 0;

end;

constructor TUserVarList.Create;
begin
  SetLength(FUserVarList, 30);
  FCount := 0;
end;

procedure TUserVarList.DelLastVar;
begin
  DelVarByIndex(FCount - 1);
end;

procedure TUserVarList.DelVarByID(aID: integer);
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    if FUserVarList[i].ID = aID then
        begin
        DelVarByIndex(i);
        exit;
        end;
    end;

  raise Exception.Create('没有找到ID为' + IntToStr(aID) +'的变量！');

end;

procedure TUserVarList.DelVarByIndex(aIndex: integer);
var
  i: integer;
begin
  if (aIndex < 0) or (aIndex >= FCount) then raise Exception.Create('索引超出范围！');

  FreeAndNil(FUserVarList[aIndex]);
  
  for i := aIndex to FCount - 2 do
    begin
    FUserVarList[i] := FUserVarList[i + 1];
    end;

  Dec(FCount);
end;

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

  setLength(FUserVarList, 0);

  inherited;
end;

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

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

function TUserVarList.getVarByID(aID: integer): TUserVar;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    if FUserVarList[i].ID = aID then
        begin
        Result := FUserVarList[i];
        exit;
        end;
    end;

  raise Exception.Create('没有找到ID为' + IntToStr(aID) +'的变量！');
end;

function TUserVarList.GetVarByIndex(aIndex: integer): TUserVar;
begin
  if (aIndex < 0) or (aIndex >= FCount) then raise Exception.Create('索引超出范围！');
  
  Result := FUserVarList[aIndex];

end;

function TUserVarList.GetVarByName(aName: string): TUserVar;
var
  i: integer;
begin
  for i := 0 to FCount - 1 do
    begin
    if SameText(FUserVarList[i].Name, aName) then
        begin
        Result := FUserVarList[i];
        exit;
        end;
    end;

  Result := nil;
end;

{ TUserMethod }

procedure TUserMethod.AddDynaVar(aUserVar: TUserVar);
begin
  FDynaVarList.Add(Pointer(aUserVar));
  aUserVar.OffPos := FCurOffPos;
  aUserVar.VarType := vtDynamic;

  Inc(FCurOffPos);
end;

procedure TUserMethod.AddParamVar(aUserVar: TUserVar);
begin
  FParamList.Add(Pointer(aUserVar));
  aUserVar.OffPos := FCurOffPos;
  aUserVar.VarType := vtParam;

  Inc(FCurOffPos);
end;

procedure TUserMethod.AddResultVar(aUserVar: TUserVar);
begin
  FResultVar := aUserVar;
  
  aUserVar.OffPos := FCurOffPos;
  aUserVar.VarType := vtResult;

  Inc(FCurOffPos);
end;

procedure TUserMethod.Clone(aUserMethod: TUserMethod);
begin
  FID := aUserMethod.ID;
  FName := aUserMethod.Name;

  FMethodType := aUserMethod.MethodType;

  //FParamList: TUserVarList;

  //FDynaVarList: TUserVarList;

  FCurOffPos := aUserMethod.CurOffPos;

  //FResultVar: TUserVar;

  FAddr := aUserMethod.Addr;
end;

constructor TUserMethod.Create;
begin
  FParamList := TList.Create;
  FDynaVarList := TList.Create;

  FCurOffPos := 0;

  FSysMethodFlag := false;
end;

function TUserMethod.GetDyanVarByIndex(aIndex: integer): TUserVar;
begin
  if (aIndex < 0) or (aIndex >= FDynaVarList.Count) then raise Exception.Create('索引超出范围！');
  Result := TUserVar(FDynaVarList.Items[aIndex]);
end;

function TUserMethod.GetParamVarByIndex(aIndex: integer): TUserVar;
begin
  if (aIndex < 0) or (aIndex >= FParamList.Count) then raise Exception.Create('索引超出范围！');
  Result := TUserVar(FParamList.Items[aIndex]);
end;

function TUserMethod.getText: string;
var
  m, p, d: string;
  i: integer;
begin
  if FMethodType = mtProc then m := '过程'
     else m := '函数';

  p := '';
  for i := 0 to FParamList.Count - 1 do
    begin
    if p = '' then p := IntToStr(TUserVar(FParamList.Items[i]).ID)
        else p := p + ', ' + IntToStr(TUserVar(FParamList.Items[i]).ID);
    end;
  p := '(' + p + ')';

  d := '';
  for i := 0 to FDynaVarList.Count - 1 do
    begin
    if d = '' then d := IntToStr(TUserVar(FDynaVarList.Items[i]).ID)
        else d := d + ', ' + IntToStr(TUserVar(FDynaVarList.Items[i]).ID);
    end;
  d := '(' + d + ')';


  Result := 'ID = ' + IntToStr(FID) + ', ' +
            'Name = ' + FName + ', ' +
            'MethodType = ' + m + ', ' +
            'ParamList = ' + p + ', ' +
            'DynaVarList = ' + d + ', ' +
            'Addr = ' + IntToStr(FAddr);
end;

{ TUserMethodList }

function TUserMethodList.AddMethod(aName: string): TUserMethod;
var
  aMethod: TUserMethod;
begin
  aMethod := TUserMethod.Create;

  try
    aMethod.Name := aName;
    aMethod.ID := FCount;
    AddMethod(aMethod);
  except
    FreeAndNil(aMethod);
    raise;
  end;

  Result := aMethod;

end;

function TUserMethodList.AddMethod(aMethod: TUserMethod): TUserMethod;
var
  i: integer;
begin
  CheckArray;

  for i := 0 to FCount - 1 do
    begin
    if FUserMethodList[i].ID = aMethod.ID then
      begin
      raise Exception.Create('已经有了该ID的方法！');
      end;
    end;
    
  FUserMethodList[FCount] := aMethod;

  Result := aMethod;

  Inc(FCount);
end;

function TUserMethodList.AddMethod(aID: integer; aName: string;
  aMethodType: TMethodType; aCurOffPos, aAddr: integer): TUserMethod;
var
  aMethod: TUserMethod;
begin
  aMethod := TUserMethod.Create;

  try
    aMethod.Name := aName;
    aMethod.ID := aID;
    aMethod.MethodType := aMethodType;
    aMethod.CurOffPos := aCurOffPos;
    aMethod.Addr := aAddr;

    AddMethod(aMethod);
  except
    FreeAndNil(aMethod);
    raise;
  end;

  Result := aMethod;


end;

procedure TUserMethodList.CheckArray;
begin
  if FCount >= Length(FUserMethodList) then
    begin