?? dcurecs.pas
字號:
InstBaseRTTISz: TNDX; //Size of RTTI for the type, if available
InstBaseSz: TNDX; //Size of corresponding variable
InstBaseV: TNDX;
VMCnt: TNDX;//number of virtual methods
NdxFE: TNDX;//BFE: Byte
Ndx00a: TNDX;//B00a: Byte
B04: TNDX;
//%$IF Ver>2;
ICnt: TNDX;
// DAdd: case @.B00b=0 of
{DAddB0: Byte;
DAddB1: Byte;}
ITbl: PNDXTbl;
// endc
//$END
constructor Create;
destructor Destroy; override;
function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
procedure Show; override;
function GetParentType: TNDX; override;
function GetRefOfsQualifier(Ofs: integer): String; override;
procedure ReadBeforeIntf; virtual;
end ;
TMetaClassDef = class(TClassDef)
hCl: TNDX;
procedure ReadBeforeIntf; override;
end ;
TInterfaceDef = class(TRecBaseDef)
hParent: TNDX;
VMCnt: TNDX;
GUID: PGUID;
B: Byte;
constructor Create;
procedure Show; override;
end ;
TVoidDef = class(TTypeDef)
procedure Show; override;
end ;
{TStrConstTypeDef = class(TTypeDef)
hBase: TNDX;
constructor Create;
procedure Show; override;
end ;}
const
NoName: String[1]='?';
const
{Register, where register variable is located,
I am not sure that it is valid for smaller than 4 bytes variables}
RegName: array[0..6] of String[3] =
('EAX','EDX','ECX','EBX','ESI','EDI','EBP');
procedure FreeDCURecList(L: TDCURec);
function GetDCURecListEnd(L: TDCURec): PTDCURec;
implementation
uses
DCU32, op;
procedure FreeDCURecList(L: TDCURec);
var
Tmp: TDCURec;
begin
while L<>Nil do begin
Tmp := L;
L := L.Next;
Tmp.Free;
end ;
end ;
function GetDCURecListEnd(L: TDCURec): PTDCURec;
begin
Result := @L;
while Result^<>Nil do
Result := @Result^.Next;
end ;
{ TDCURec. }
function TDCURec.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
Result := 0;
DCUErrorFmt('Trying to set memory 0x%x[0x%x] to %s',[MOfs,MSz,Name^]);
end ;
function TDCURec.NameIsUnique: boolean;
begin
Result := false;
end ;
{ TBaseDef. }
constructor TBaseDef.Create(AName: PName; ADef: PDef; AUnit: integer);
begin
inherited Create;
FName := AName;
Def := ADef;
hUnit := AUnit;
end ;
procedure TBaseDef.ShowName;
var
U: PUnitImpRec;
NP: PName;
begin
NP := FName;
if (NP=Nil)or(NP^[0]=#0) then
NP := @NoName;
if hUnit<0 then begin
if NP^[0]<>#0 {Temp.} then
PutS(GetDCURecStr(Self,-1{dummy - won't be used},false));
end
else if NameIsUnique then
PutS(NP^)
else begin
U := CurUnit.UnitImpRec[hUnit];
PutSFmt('%s.%s',[U^.Name^,NP^]);
end ;
end ;
procedure TBaseDef.Show;
var
NP: PName;
begin
NP := FName;
if (NP=Nil)or(NP^[0]=#0) then
NP := @NoName;
PutS(NP^);
// PutS('?');
// ShowName;
end ;
procedure TBaseDef.ShowNamed(N: PName);
begin
if ((N<>Nil)and(N=FName)or(FName=Nil)or(FName^[0]=#0)or
(not ShowDotTypes and(FName^[1]='.')and(Self is TTypeDef)))
and CurUnit.RegTypeShow(Self)
{if RegTypeShow fails the type name will be shown instead of its
definition}
then
try
Show;
finally
CurUnit.UnRegTypeShow(Self)
end
else
ShowName;
end ;
function TBaseDef.GetName: PName;
begin
Result := FName;
if Result=Nil then
Result := @NoName;
end ;
function TBaseDef.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
Result := 0;
DCUErrorFmt('Trying to set memory 0x%x[0x%x] to %s[0x%x]',[MOfs,MSz,Name^,
PChar(Def)-CurUnit.MemPtr]);
end ;
{ TImpDef. }
constructor TImpDef.Create(AIK: TImpKind; AName: PName; AnInf: integer;
ADef: PDef; AUnit: integer);
begin
inherited Create(AName,ADef,AUnit);
Inf := AnInf;
ik := AIK;
end ;
procedure TImpDef.Show;
begin
PutSFmt('%s:',[ik]);
inherited Show;
end ;
function TImpDef.NameIsUnique: boolean;
begin
Result := FNameIsUnique;
end ;
{ TDLLImpRec. }
constructor TDLLImpRec.Create(AName: PName; ANDX: integer; ADef: PDef; AUnit: integer);
begin
inherited Create({'A',}AName,ADef,AUnit);
NDX := ANDX;
end ;
procedure TDLLImpRec.Show;
var
NoName: boolean;
begin
NoName := (FName=Nil)or(FName^[0]=#0);
if not NoName then
PutSFmt('name ''%s''',[FName^]);
if NoName or(NDX<>0) then
PutSFmt('index $%x',[NDX])
end ;
{ TImpTypeDefRec. }
constructor TImpTypeDefRec.Create(AName: PName; AnInf: integer;
ARTTISz: Cardinal{AL: Byte}; ADef: PDef; AUnit: integer);
begin
inherited Create('T',AName,AnInf,ADef,AUnit);
// L := AL;
RTTISz := ARTTISz;
RTTIOfs := Cardinal(-1);
hImpUnit := hUnit;
hUnit := -1;
ImpName := FName;
FName := Nil {Will be named later in the corresponding TTypeDecl};
end ;
procedure TImpTypeDefRec.Show;
var
U: PUnitImpRec;
begin
PutS('type'+cSoftNL);
// ShowName;
if hImpUnit>=0 then begin
U := CurUnit.UnitImpRec[hImpUnit];
PutS(U^.Name^);
PutS('.');
end ;
PutS(ImpName^);
// PutSFmt('[%d]',[L]);
if RTTISz>0 then begin
Inc(AuxLevel);
PutS('{ RTTI: ');
Inc(NLOfs,2);
NL;
CurUnit.ShowDataBl(0,RTTIOfs,RTTISz);
Dec(NLOfs,2);
PutS('}');
Dec(AuxLevel);
end ;
end ;
function TImpTypeDefRec.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
Result := 0;
if RTTIOfs<>Cardinal(-1) then
DCUErrorFmt('Trying to change ImpRTTI(%s) memory to 0x%x[0x%x]',
[Name^,MOfs,MSz]);
if RTTISz<>MSz then
DCUErrorFmt('ImpRTTI %s: memory size mismatch (.[0x%x]<>0x%x[0x%x])',
[Name^,RTTISz,MOfs,MSz]);
RTTIOfs := MOfs;
end ;
{**************************************************}
{ TNameDecl. }
constructor TNameDecl.Create0;
begin
inherited Create;
hDecl := CurUnit.AddAddrDef(Self);
end ;
constructor TNameDecl.Create;
var
N: PName;
begin
Create0;
Def := DefStart;
N := ReadName;
end ;
destructor TNameDecl.Destroy;
begin
CurUnit.ClearAddrDef(Self);
inherited Destroy;
end ;
function TNameDecl.GetTag: TDCURecTag;
begin
Result := CurUnit.FixTag(Def^.Tag);
end ;
procedure TNameDecl.ShowName;
begin
PutS(GetDCURecStr(Self,hDecl,false));
end ;
{var
N: PName;
begin
N := Name;
if (N^[0]<>#0) then
PutS(N^)
else
PutSFmt('_N_%x',[hDecl])
end ;
}
procedure TNameDecl.Show;
begin
ShowName;
end ;
procedure TNameDecl.ShowDef(All: boolean);
begin
Show;
end ;
function TNameDecl.GetName: PName;
begin
if Def=Nil then
Result := @NoName
else
Result := @Def^.Name;
end ;
function TNameDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
Result := 0;
DCUErrorFmt('Trying to set memory 0x%x[0x%x] to %s[0x%x]',[MOfs,MSz,Name^,
PChar(Def)-CurUnit.MemPtr]);
end ;
function TNameDecl.GetSecKind: TDeclSecKind;
begin
Result := skNone;
end ;
function TNameDecl.IsVisible(LK: TDeclListKind): boolean;
begin
Result := true;
end ;
{ TNameFDecl.}
constructor TNameFDecl.Create(NoInf: boolean);
var
F1,F3: integer;
begin
inherited Create;
F := ReadUIndex;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then begin
F1 := ReadUIndex;
end ;
{if F and $1<>0 then
raise Exception.CreateFmt('Flag 1 found: 0x%x',[F]);}
if not NoInf and(F and $40<>0) then
Inf := ReadULong;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then begin
if F1 and $80<>0 then begin//Could be valid for MSIL only
B2 := ReadUIndex;
if (CurUnit.Ver=verD8)and(F and $08<>0) then
F3 := ReadUIndex;
end ;
end ;
end ;
procedure TNameFDecl.Show;
begin
inherited Show;
Inc(AuxLevel);
PutSFmt('{%x,%x}',[F,Inf]);
Dec(AuxLevel);
end ;
function TNameFDecl.IsVisible(LK: TDeclListKind): boolean;
begin
case LK of
dlMain: Result := (F and $40<>0);
dlMainImpl: Result := (F and $40=0);
else
Result := true;
end ;
end ;
{ TTypeDecl. }
constructor TTypeDecl.Create;
begin
inherited Create(false{NoInf});
hDef := ReadUIndex;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1)and(B2<>0) then
hDef := B2;
CurUnit.AddTypeName(hDef,{hDecl,}@Def^.Name);
// CurUnit.AddAddrDef(Self); moved to TNameDecl
end ;
function TTypeDecl.IsVisible(LK: TDeclListKind): boolean;
var
RefName: PName;
begin
Result := inherited IsVisible(LK);
if not Result then
Exit;
if ShowDotTypes or(Def=Nil) then
Exit;
RefName := @Def^.Name;
Result := not((RefName^[0]>#0)and(RefName^[1]='.'));
end ;
procedure TTypeDecl.Show;
var
RefName: PName;
begin
inherited Show;
if (Def=Nil) then
RefName := Nil
else
RefName := @Def^.Name;
(*
RefName := CurUnit.GetTypeName(hDef);
if (Def=Nil)or(RefName=@Def^.Name) then
RefName := Nil;
if RefName<>Nil then
PutSFmt('=%s{#%d}',[RefName^,hDef])
else
PutSFmt('=#%d',[hDef]);
*)
PutS('=');
{ PutS('type'+cSoftNL);}
CurUnit.ShowTypeDef(hDef,RefName);
// PutSFmt('{#%x}',[hDef])
end ;
function TTypeDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
var
D: TTypeDef;
begin
Result := 0;
D := CurUnit.GetTypeDef(hDef);
if D=Nil then
Exit;
Result := D.SetMem(MOfs,MSz);
end ;
function TTypeDecl.GetSecKind: TDeclSecKind;
begin
Result := skType;
end ;
{ TTypePDecl. }
constructor TTypePDecl.Create;
begin
inherited Create(false);
// B1 := ReadByte;
end ;
procedure TTypePDecl.Show;
begin
// PutS('VMT of ');
inherited Show;
// PutSFmt('{B1:%x}',[B1]);
PutS(',VMT');
end ;
function TTypePDecl.IsVisible(LK: TDeclListKind): boolean;
begin
Result := ShowVMT;
end ;
{ TVarDecl. }
constructor TVarDecl.Create;
begin
inherited Create(false{NoInf});
hDT := ReadUIndex;
Ofs := ReadUIndex;
// CurUnit.AddAddrDef(Self);
end ;
procedure TVarDecl.Show;
{var
RefName: PName;}
begin
// PutS('var ');
inherited Show;
(* RefName := CurUnit.GetTypeName(hDT);
if RefName<>Nil then
PutSFmt(':%s{#%d @%x}',[RefName^,hDT,Ofs])
else
PutSFmt(':{#%d @%x}',[hDT,Ofs]);
*)
PutS(': ');
CurUnit.ShowTypeDef(hDT,Nil);
// PutSFmt('{#%x @%x}',[hDT,Ofs]);
Inc(AuxLevel);
PutSFmt('{Ofs:0x%x}',[Ofs]);
Dec(AuxLevel);
end ;
function TVarDecl.GetSecKind: TDeclSecKind;
begin
Result := skVar;
end ;
{ TVarCDecl. }
constructor TVarCDecl.Create(OfsValid: boolean);
begin
inherited Create;
Sz := Cardinal(-1);
OfsR := Ofs;
if not OfsValid then
Ofs := Cardinal(-1);
end ;
procedure TVarCDecl.Show;
var
DP: Pointer;
{SzShown: integer;}
DS: Cardinal;
var
Fix0: integer;
MS: TFixupMemState;
begin
inherited Show;
Inc(NLOfs,2);
PutS(' ='+cSoftNL);
if Sz=Cardinal(-1) then
PutS(' ?')
else begin
DP := Nil;
if ResolveConsts then begin
DP := CurUnit.GetBlockMem(Ofs,Sz,DS);
if DP<>Nil then begin
SaveFixupMemState(MS);
SetCodeRange(CurUnit.DataBlPtr,DP,DS);
Fix0 := CurUnit.GetStartFixup(Ofs);
CurUnit.SetStartFixupInfo(Fix0);
end ;
end ;
CurUnit.ShowGlobalTypeValue(hDT,DP,DS,true,false);
if DP<>Nil then
RestoreFixupMemState(MS);
{
SzShown := 0;
if DP<>Nil then begin
SzShown := CurUnit.ShowGlobalTypeValue(hDT,DP,Sz,true);
if SzShown<0 then
SzShown := 0;
end ;
if SzShown<Sz then
CurUnit.ShowDataBl(SzShown,Ofs,Sz);}
end ;
Dec(NLOfs,2);
end ;
function TVarCDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
Result := 0;
if Sz=Cardinal(-1) then
Sz := MSz
else if Sz<>MSz then //Changed for StrConstRec
DCUErrorFmt('Trying to change typed const %s memory to 0x%x[0x%x]',
[Name^,MOfs,MSz]);
if Ofs=Cardinal(-1) then
Ofs := MOfs
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -