?? dcurecs.pas
字號:
if not(IsVar and not InReg {it doesn't make sense}) then begin
if IsVar or not InReg then
Result := Result+CurUnit.GetOfsQualifier(TLocalDecl(D).hDT,Ofs)
else {not IsVar and InReg} begin
if Ofs=0 then
Exit;
//Try to interpret the value as a pointer:
Result := Format('@%s%s',[Result,CurUnit.GetRefOfsQualifier(TLocalDecl(D).hDT,Ofs)]);
end ;
Exit;
end ;
if Ofs=0 then
Exit;
Result := Format('%s+%d',[Result,Ofs])
end ;
procedure TProcDecl.ShowDef(All: boolean);
var
Ofs0: Cardinal;
begin
if IsProc then begin
case MethodKind of
mkConstructor: PutS('constructor ');
mkDestructor: PutS('destructor ');
else
PutS('procedure ');
end ;
end
else
PutS('function ');
inherited Show;
if Def^.Name[0]=#0 then
PutS('?');
ShowArgs;
if All then begin
if FProcLocVarCnt>=2 then begin
Inc(AuxLevel);
PutSFmt('{LVFlags: %x,%x,%x,%x,%x}',[FProcLocVarTbl^[0].ofs,
FProcLocVarTbl^[0].frame,FProcLocVarTbl^[1].sym,
FProcLocVarTbl^[1].ofs,FProcLocVarTbl^[1].frame]);
Dec(AuxLevel);
end ;
Ofs0 := NLOfs;
PutS(';');
if Locals<>Nil then
CurUnit.ShowDeclList(dlEmbedded,Locals,Ofs0{+2},2,[dsLast,dsOfsProc],
BlockSecKinds,skNone);
if Embedded<>Nil then
CurUnit.ShowDeclList(dlEmbedded,Embedded,Ofs0{+2},2,[dsLast,dsOfsProc],
BlockSecKinds,skNone);
// PutS('; ');
NLOfs := Ofs0;
NL;
PutS('begin');
NLOfs := Ofs0+2;
GetRegVarInfo := GetRegDebugInfo;
if not JustData then
CurUnit.ShowCodeBl(AddrBase,CodeOfs,Sz)
else begin
NL;
PutS('data ');
CurUnit.ShowDataBl(AddrBase,CodeOfs,Sz);
end ;
GetRegVarInfo := Nil;
NLOfs := Ofs0;
NL;
PutS('end');
end ;
end ;
procedure TProcDecl.Show;
begin
ShowDef(true);
end ;
function TProcDecl.IsVisible(LK: TDeclListKind): boolean;
begin
case LK of
dlMain: Result := (F and $40<>0)and (MethodKind=mkProc);
else
Result := true;
end ;
end ;
{ TSysProcDecl. }
constructor TSysProcDecl.Create;
begin
inherited Create;
F := ReadUIndex;
Ndx := ReadIndex;
// CurUnit.AddAddrDef(Self);
// CodeOfs := CurUnit.RegDataBl(Sz);
end ;
function TSysProcDecl.GetSecKind: TDeclSecKind;
begin
Result := skProc;
end ;
procedure TSysProcDecl.Show;
begin
PutS('sysproc ');
inherited Show;
PutSFmt('{#%x}',[F]);
// PutSFmt('{%x,#%x}',[F,V]);
// NL;
// CurUnit.ShowDataBl(CodeOfs,Sz);
end ;
(*
{ TAtDecl. }
//May be start of implementation?
constructor TAtDecl.Create;
begin
inherited Create;
NDX := ReadIndex;
NDX1 := ReadIndex;
end ;
procedure TAtDecl.Show;
begin
PutSFmt('implementation ?{NDX:%x,NDX:%x}',[NDX,NDX1]);
inherited Show;
end ;
*)
{ TSysProc8Decl. }
constructor TSysProc8Decl.Create;
{var
B80,H,B0,Sz: TNDX;}
begin
{B80 := ReadUIndex;
H := ReadUIndex;
B0 := ReadUIndex;
Sz := ReadUIndex;}
inherited Create(Nil{AnEmbedded},true{NoInf});
end ;
{ TUnitAddInfo. }
constructor TUnitAddInfo.Create;
begin
inherited Create(false{NoInf});
B := ReadUIndex;
Tag := ReadTag;
CurUnit.ReadDeclList(dlUnitAddInfo,Sub);
end ;
destructor TUnitAddInfo.Destroy;
begin
FreeDCURecList(Sub);
inherited Destroy;
end ;
function TUnitAddInfo.IsVisible(LK: TDeclListKind): boolean;
begin
Result := false;
end ;
{ TSpecVar. }
procedure TSpecVar.Show;
begin
PutS('spec var'+cSoftNL);
inherited Show;
end ;
(* It's StrConstRec
{ TAddInfo6. }
constructor TAddInfo6.Create;
begin
inherited Create;
V0 := ReadUIndex;
V1 := ReadUIndex;
V2 := ReadUIndex;
V3 := ReadUIndex;
Ofs := 0;
Sz := 0;
end ;
procedure TAddInfo6.Show;
begin
inherited Show;
Puts('{AddInfo6}={'); NL;
CurUnit.ShowDataBl(0,Ofs,Sz);
Puts('}');
end ;
function TAddInfo6.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
Result := 0;
Sz := MSz;
Ofs := MOfs;
end ;
*)
{--------------------------------------------------------------------}
{ TTypeDef. }
constructor TTypeDef.Create;
begin
inherited Create(Nil,DefStart,-1);
RTTISz := ReadUIndex;
Sz := ReadIndex{ReadUIndex};
V := ReadUIndex;
if CurUnit.IsMSIL then begin
ReadUIndex;
ReadUIndex;
end
else if (CurUnit.Ver>=verD9)and(CurUnit.Ver<verK1) then
ReadUIndex;
CurUnit.AddTypeDef(Self);
{if V<>0 then
CurUnit.AddAddrDef(Self);}
RTTIOfs := Cardinal(-1){CurUnit.RegDataBl(RTTISz)};
end ;
destructor TTypeDef.Destroy;
begin
CurUnit.ClearLastTypeDef(Self);
inherited Destroy;
end ;
procedure TTypeDef.ShowBase;
begin
Inc(AuxLevel);
PutSFmt('{Sz: %x, RTTISz: %x, V: %x}',[Sz,RTTISz,V]);
Dec(AuxLevel);
// PutSFmt('{Sz: %x, V: %x}',[Sz,V]);
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 ;
procedure TTypeDef.Show;
begin
ShowBase;
end ;
function TTypeDef.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
Result := 0;
if RTTIOfs<>Cardinal(-1) then
DCUErrorFmt('Trying to change RTTI(%s) memory to 0x%x[0x%x]',
[Name^,MOfs,MSz]);
if RTTISz<>MSz then
DCUErrorFmt('RTTI %s: memory size mismatch (.[0x%x]<>0x%x[0x%x])',
[Name^,RTTISz,MOfs,MSz]);
RTTIOfs := MOfs;
end ;
function TTypeDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
begin
if Sz>DS then begin
Result := -1;
Exit;
end ;
Result := Sz;
NL;
ShowDump(DP,Nil,0,0,Sz,0,0,0,0,Nil,false);
end ;
function TTypeDef.GetOfsQualifier(Ofs: integer): String;
begin
if Ofs=0 then
Result := ''
else if Ofs<Sz then
Result := Format('.byte[%d]',[Ofs])
else
Result := Format('.?%d',[Ofs]); //Error
end ;
function TTypeDef.GetRefOfsQualifier(Ofs: integer): String;
begin
if Ofs=0 then
Result := '^'
else
Result := Format('^?%d',[Ofs]); //Error
end ;
{ TRangeBaseDef. }
procedure TRangeBaseDef.GetRange(var Lo,Hi: TInt64Rec);
var
CP0: TScanState;
begin
ChangeScanState(CP0,LH,18);
ReadIndex64(Lo);
ReadIndex64(Hi);
RestoreScanState(CP0);
end ;
function TRangeBaseDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
var
CP0: TScanState;
Neg: boolean;
Lo: TNDX;
Tag: TDCURecTag;
begin
if Sz>DS then begin
Result := -1;
Exit;
end ;
Result := Sz;
if Def=Nil then
Tag := drRangeDef{Just in case}
else
Tag := TDCURecTag(Def^);
case Tag of
drChRangeDef:
if Sz=1 then begin
PutS(CharStr(Char(DP^)));
Exit;
end ;
drWCharRangeDef:
if Sz=2 then begin
PutS(WCharStr(WideChar(DP^)));
Exit;
end ;
drBoolRangeDef: begin
PutS(BoolStr(DP,Sz));
Exit;
end ;
end ;
ChangeScanState(CP0,LH,18);
Lo := ReadIndex;
Neg := NDXHi<0{Lo<0};
RestoreScanState(CP0);
PutS(IntLStr(DP,Sz,Neg));
end ;
procedure TRangeBaseDef.Show;
var
Lo,Hi: TInt64Rec;
U: TUnit;
T: TTypeDef;
procedure ShowVal(var V: TInt64Rec);
begin
if (T=Nil)or(U.ShowTypeValue(T,@V,8,true)<0) then begin
NDXHi := V.Hi;
PutS(NDXToStr(V.Lo));
end ;
end ;
begin
inherited Show;
Inc(AuxLevel);
PutS('{');
// CurUnit.ShowTypeDef(hDTBase,Nil);
CurUnit.ShowTypeName(hDTBase);
// PutSFmt(',#%x,B:%x}',[hDTBase,B]);
PutSFmt(',B:%x}',[B]);
Dec(AuxLevel);
GetRange(Lo,Hi);
T := CurUnit.GetGlobalTypeDef(hDTBase,U);
ShowVal(Lo);
PutS('..');
ShowVal(Hi);
end ;
{ TRangeDef. }
constructor TRangeDef.Create;
var
Lo: TNDX;
Hi: TNDX;
begin
inherited Create;
hDTBase := ReadUIndex;
LH := ScSt.CurPos;
Lo := ReadIndex;
Hi := ReadIndex;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
B := ReadUIndex
else
B := ReadByte; //It could be index too, but I'm not sure
end ;
{ TEnumDef. }
constructor TEnumDef.Create;
var
Lo: TNDX;
Hi: TNDX;
begin
inherited Create;
hDTBase := ReadUIndex;
NDX := ReadIndex;
LH := ScSt.CurPos;
Lo := ReadIndex;
Hi := ReadIndex;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
B := ReadUIndex
else
B := ReadByte; //It could be index too, but I'm not sure
end ;
destructor TEnumDef.Destroy;
begin
if NameTbl<>Nil then begin
if NameTbl.Count>0 then
FreeDCURecList(NameTbl[0]);
NameTbl.Free;
end ;
inherited Destroy;
end ;
function TEnumDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
var
V: Cardinal;
begin
if Sz>DS then begin
Result := -1;
Exit;
end ;
Result := Sz;
if not MemToUInt(DP,Sz,V)or(V<0)or(NameTbl=Nil)or(V>=NameTbl.Count) then begin
ShowName;
PutS('(');
inherited ShowValue(DP,DS);
PutS(')');
Exit;
end ;
TConstDecl(NameTbl[V]).ShowName;
end ;
procedure TEnumDef.Show;
var
EnumConst: TNameDecl;
i: integer;
begin
if NameTbl=Nil then begin
inherited Show;
Exit;
end ;
ShowBase;
Inc(AuxLevel);
PutS('{');
// CurUnit.ShowTypeDef(hDTBase,Nil);
CurUnit.ShowTypeName(hDTBase);
// PutSFmt(',#%x,B:%x}',[hDTBase,B]);
PutSFmt(',B:%x}',[B]);
Dec(AuxLevel);
Inc(NLOfs,1);
SoftNL;
PutS('(');
Inc(NLOfs,1);
for i:=0 to NameTbl.Count-1 do begin
if i>0 then
PutS(','+cSoftNL);
EnumConst := NameTbl[i];
PutS(EnumConst.Name^);
end ;
PutS(')');
Dec(NLOfs,2);
end ;
{ TFloatDef. }
constructor TFloatDef.Create;
begin
inherited Create;
B := ReadByte;
end ;
function TFloatDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
var
E: Extended;
N: PName;
Ok: boolean;
begin
if Sz>DS then begin
Result := -1;
Exit;
end ;
Result := Sz;
Ok := true;
case Sz of
SizeOf(Single): E := Single(DP^);
SizeOf(Double): begin {May be TypeInfo should be used here}
N := Name;
if N=Nil then
Ok := false
else begin
if CompareText(N^,'Double')=0 then
E := Double(DP^)
else if CompareText(N^,'Currency')=0 then
E := Currency(DP^)
else if CompareText(N^,'Comp')=0 then
E := Comp(DP^)
else
Ok := false;
end ;
end ;
SizeOf(Extended): E := Extended(DP^);
SizeOf(Real): E := Real(DP^);
else
Ok := false;
end ;
if Ok then begin
PutsFmt('%g',[E]);
Exit;
end ;
Result := inherited ShowValue(DP,Sz);
end ;
procedure TFloatDef.Show;
begin
Inc(AuxLevel);
PutS('float');
Dec(AuxLevel);
inherited Show;
Inc(AuxLevel);
PutSFmt('{B:%x}',[B]);
Dec(AuxLevel);
end ;
{ TPtrDef. }
constructor TPtrDef.Create;
begin
inherited Create;
hRefDT := ReadUIndex;
end ;
type
TShowPtrValProc = function(Ndx: TNDX; Ofs: Cardinal): boolean of object;
procedure ShowPointer(DP: Pointer; NilStr: String; ShowVal: TShowPtrValProc);
var
V: Pointer;
Fix: PFixupRec;
VOk: boolean;
FxName: PName;
begin
V := Pointer(DP^);
if GetFixupFor(DP,4,true,Fix)and(Fix<>Nil) then begin
FxName := TUnit(FixUnit).AddrName[Fix^.Ndx];
VOk := (FxName^[0]=#0) {To prevent from decoding named blocks}
and Assigned(ShowVal)and ShowVal(Fix^.Ndx,Cardinal(V));
if VOk then begin
PutS(cSoftNL+'{');
end ;
PutS('@');
if not ReportFixup(Fix,Cardinal(V),false{not VOk} {UseHAl}) then
if V<>Nil then
PutSFmt('+$%x',[Cardinal(V)]);
if
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -