?? dcurecs.pas
字號:
if NDXB<>-1 then
PutSFmt(' NDXB:%x',[NDXB]);
PutS('}');
Dec(AuxLevel);
if NDXB<>-1 then begin
case NDXB and $6 of
$2: PutS(cSoftNL+'readonly');
$4: PutS(cSoftNL+'writeonly');
end ;
end ;
PutsFmt(cSoftNL+'dispid $%x',[integer(NDX)]);
Dec(NLOfs,2);
end ;
{ TConstDeclBase. }
constructor TConstDeclBase.Create;
begin
inherited Create(false{NoInf});
// CurUnit.AddAddrDef(Self);
end ;
procedure TConstDeclBase.ReadConstVal;
begin
ValSz := ReadUIndex;
if ValSz=0 then begin
ValPtr := Nil;
Val := ReadIndex;
ValSz := NDXHi;
end
else begin
ValPtr := ScSt.CurPos;
SkipBlock(ValSz);
Val := 0;
end ;
end ;
procedure TConstDeclBase.ShowValue;
var
DP: Pointer;
DS: Cardinal;
V: TInt64Rec;
MemVal: boolean;
begin
if ValPtr=Nil then begin
V.Hi := ValSz;
V.Lo := Val;
DP := @V;
DS := 8;
end
else begin
DP := ValPtr;
DS := ValSz;
end ;
MemVal := ValPtr<>Nil;
if (CurUnit.ShowGlobalTypeValue(hDT,DP,DS,MemVal,true)<0)and not MemVal then begin
CurUnit.ShowTypeName(hDT);
NDXHi := V.Hi;
PutSFmt('(%s)',[NDXToStr(V.Lo)]);
end ;
end ;
procedure TConstDeclBase.Show;
var
RefName: PName;
TypeNamed: boolean;
begin
inherited Show;
(*
RefName := CurUnit.GetTypeName(hDT);
if RefName<>Nil then
PutSFmt('=%s{#%d}(',[RefName^,hDT])
else
PutSFmt('={#%d}',[hDT]);
if ValPtr=Nil then begin
if ValSz<>0 then
PutSFmt('$%x%8:8x',[ValSz,Val])
else
PutSFmt('$%x',[Val]);
end ;
if RefName<>Nil then
PutS(')');
*)
Inc(NLOfs,2);
PutS(' ');
Inc(AuxLevel);
if AuxLevel<=0 then begin
PutS('{:'+cSoftNL);
CurUnit.ShowTypeName(hDT);
PutS('}'+cSoftNL)
end ;
Dec(AuxLevel);
PutS('='+cSoftNL);
Inc(AuxLevel);
if (CurUnit.Ver>verD4)and(hX<>0{It is almost always=0}) then
PutSFmt('{X:#%x}',[hX]);
Dec(AuxLevel);
ShowValue;
Dec(NLOfs,2);
(*
TypeNamed := CurUnit.ShowTypeName(hDT);
if TypeNamed then
PutS('(');
if ValPtr=Nil then begin
NDXHi := ValSz;
PutS(NDXToStr(Val));
end
else begin
Inc(NLOfs,2);
NL;
ShowDump(ValPtr,0,ValSz,0,0,0,0,Nil,false);
Dec(NLOfs,2);
end ;
if TypeNamed then
PutS(')');
*)
end ;
function TConstDeclBase.GetSecKind: TDeclSecKind;
begin
Result := skConst;
end ;
{ TConstDecl. }
constructor TConstDecl.Create;
begin
inherited Create;
hDT := ReadUIndex;
if CurUnit.Ver>verD4 then
hX := ReadUIndex;
ReadConstVal;
end ;
{ TResStrDef. }
constructor TResStrDef.Create;
begin
inherited Create(false);
OfsR := Ofs;
Ofs := Cardinal(-1);
end ;
procedure TResStrDef.Show;
begin
inherited Show; //The reference to HInstance will be shown
Inc(NLOfs,2);
SoftNL;
CurUnit.ShowGlobalConstValue(hDecl+1);
Dec(NLOfs,2);
end ;
function TResStrDef.GetSecKind: TDeclSecKind;
begin
Result := skResStr;
end ;
{
procedure TResStrDef.Show;
begin
PutS('res');
inherited Show;
end ;
}
(*
constructor TResStrDef.Create;
begin
inherited Create;
hDT := ReadUIndex;
NDX := ReadIndex;
NDX1 := ReadIndex;
B1 := ReadByte;
B2 := ReadByte;
V := ReadIndex;
ReadConstVal;
RefOfs := Cardinal(-1);
end ;
procedure TResStrDef.Show;
begin
inherited Show;
PutSFmt('{NDX:%x,NDX1:%x,B1:%x,B2:%x,V:%x}',[NDX,NDX1,B1,B2,V]);
NL;
if RefOfs<>Cardinal(-1) then begin
PutS('{');
CurUnit.ShowDataBl(RefOfs,RefSz);
PutS('}');
// NL;
end ;
end ;
procedure TResStrDef.SetMem(MOfs,MSz: Cardinal);
begin
if RefOfs<>Cardinal(-1) then
DCUErrorFmt('Trying to change resourcestring memory %s',[Name^]);
RefOfs := MOfs;
RefSz := MSz;
end ;
*)
{ TSetDeftInfo. }
constructor TSetDeftInfo.Create;
begin
// inherited Create;
Def := DefStart;
hDecl := -1;
hConst := ReadUIndex;
hArg := ReadUIndex;
end ;
procedure TSetDeftInfo.Show;
begin
Inc(NLOfs,2);
PutSFmt('Let %s :='+cSoftNL,[CurUnit.GetAddrStr(hArg,false)]);
CurUnit.ShowGlobalConstValue(hConst);
Dec(NLOfs,2);
end ;
{ TCopyDecl. }
constructor TCopyDecl.Create;
{
This kind of records was observed in DRIntf.dcu of D2006 where the
unit has several records of the same structure:
TID = record Reserved: array[$1..$6] of Byte; end;
TDatabaseID = record Reserved: array[$1..$6] of Byte; end;
TTableID = --//--
TFieldID = --//--
TAttrID = --//--
Now they use drCopyDecl to point to the 1st Reserved declaration
instead of duplicating it
}
var
SrcDef: TDCURec;
begin
inherited Create0;
hBase := ReadUIndex; //index of the address to copy from
SrcDef := CurUnit.GetAddrDef(hBase);
if SrcDef=Nil then
DCUErrorFmt('CopyDecl index #%x not found',[hBase]);
if not(SrcDef is TNameDecl) then
DCUErrorFmt('CopyDecl index #%x(%s) is not a TNameDecl',[hBase,SrcDef.Name^]);
Base := TNameDecl(SrcDef);
Def := Base.Def;
end ;
procedure TCopyDecl.Show;
begin
Base.Show;
Inc(AuxLevel);
PutSFmt('{Copy of:#%x}',[hBase]);
Dec(AuxLevel);
end ;
function TCopyDecl.GetSecKind: TDeclSecKind;
begin
Result := Base.GetSecKind;
end ;
(*
{ TProcDeclBase. }
constructor TProcDeclBase.Create;
begin
inherited Create;
CodeOfs := Cardinal(-1);
// CurUnit.AddAddrDef(Self);
end ;
function TProcDeclBase.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
if CodeOfs<>Cardinal(-1) then
DCUErrorFmt('Trying to change procedure %s memory to 0x%x[0x%x]',
[Name^,MOfs,MSz]);
if Sz>MSz then
DCUErrorFmt('Procedure %s: memory size mismatch (.[0x%x]>0x%x[0x%x])',
[Name^,Sz,MOfs,MSz]);
CodeOfs := MOfs;
Result := MSz-Sz {it can happen for ($L file) with several procedures};
end ;
function TProcDeclBase.GetSecKind: TDeclSecKind;
begin
Result := skProc;
end ;
*)
{ TProcDecl. }
function ReadCallKind: TProcCallKind;
begin
Result := pcRegister;
if (Tag>=Low(TProcCallTag))and(Tag<=High(TProcCallTag)) then begin
Result := TProcCallKind(Ord(Tag)-Ord(Low(TProcCallTag))+1);
Tag := ReadTag;
end ;
end ;
constructor TProcDecl.Create(AnEmbedded: TNameDecl; NoInf: boolean);
var
NoName: boolean;
ArgP: ^TNameDecl;
Loc: TNameDecl;
begin
inherited Create(NoInf);
CodeOfs := Cardinal(-1);
{---}
Embedded := AnEmbedded;
NoName := IsUnnamed;
MethodKind := mkProc;
Locals := Nil;
B0 := ReadUIndex{ReadByte};
Sz := ReadUIndex;
if not NoName then begin
if CurUnit.Ver>verD2 then
VProc := ReadIndex;
hDTRes := ReadUIndex;
if (CurUnit.Ver>verD7)and(CurUnit.Ver<verK1) then
ReadUIndex;
Tag := ReadTag;
CallKind := ReadCallKind;
try
CurUnit.ReadDeclList(dlArgs,Args);
except
on E: Exception do begin
E.Message := Format('%s in proc %s',[E.Message,Name^]);
raise;
end ;
end ;
if Tag<>drStop1 then
TagError('Stop Tag');
ArgP := @Args;
while ArgP^<>Nil do begin
Loc := ArgP^;
if not(Loc.GetTag in [arVal,arVar]) then
Break;
ArgP := @Loc.Next;
end ;
Locals := ArgP^;
ArgP^ := Nil;
//Tag := ReadTag;
end ;
// CodeOfs := CurUnit.RegDataBl(Sz);
end ;
destructor TProcDecl.Destroy;
begin
FreeDCURecList(Locals);
FreeDCURecList(Args);
FreeDCURecList(Embedded);
inherited Destroy;
end ;
function TProcDecl.IsUnnamed: boolean;
begin
Result := (Def^.Name[0]=#0)or(Def^.Name='.')
or(CurUnit.Ver>=verD6)and(CurUnit.Ver<verK1)and(Def^.Name='..')
or((CurUnit.Ver>=verK1)or(CurUnit.Ver>=verD8))
and(Def^.Name[1]='.'){and(Def^.Name[Length(Def^.Name)]='.')};
//In Kylix are used the names of the kind '.<X>.'
//In Delphi 6 were noticed only names '..'
//In Delphi 9 were noticed names of the kind '.<X>'
end ;
function TProcDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
if CodeOfs<>Cardinal(-1) then
DCUErrorFmt('Trying to change procedure %s memory to 0x%x[0x%x]',
[Name^,MOfs,MSz]);
if Sz>MSz then
DCUErrorFmt('Procedure %s: memory size mismatch (.[0x%x]>0x%x[0x%x])',
[Name^,Sz,MOfs,MSz]);
CodeOfs := MOfs;
Result := MSz-Sz {it can happen for ($L file) with several procedures};
end ;
function TProcDecl.GetSecKind: TDeclSecKind;
begin
Result := skProc;
end ;
const
CallKindName: array[TProcCallKind] of String =
('register','cdecl','pascal','stdcall','safecall');
function TProcDecl.IsProc: boolean;
begin
Result := CurUnit.TypeIsVoid(hDTRes);
end ;
procedure TProcDecl.ShowArgs;
var
NoName: boolean;
Ofs0: Cardinal;
ArgL: TNameDecl;
begin
NoName := IsUnnamed;
Inc(AuxLevel);
PutSFmt('{B0:%x,Sz:%x',[B0,Sz]);
if not NoName then begin
if CurUnit.Ver>verD2 then
PutSFmt(',VProc:%x',[VProc]);
end ;
PutS('}');
Dec(AuxLevel);
Ofs0 := NLOfs;
Inc(NLOfs,2);
ArgL := Args;
if (not ShowSelf)and(MethodKind<>mkProc) then begin
if (ArgL<>Nil)and(ArgL.Name^='Self') then begin
ArgL := TNameDecl(ArgL.Next);
if (ArgL<>Nil)and(MethodKind<>mkMethod){Constructor or Destructor - skip the 2nd call flag}
and(ArgL.Name^='.')
then
ArgL := TNameDecl(ArgL.Next);
end ;
end ;
if ArgL<>Nil then
PutS(cSoftNL+'(');
CurUnit.ShowDeclList(dlArgs,ArgL,Ofs0,2,[{dsComma,}dsNoFirst,dsSoftNL],
ProcSecKinds,skNone);
NLOfs := Ofs0+2;
if ArgL<>Nil then
PutS(')');
if not IsProc then begin
PutS(':'+cSoftNL);
CurUnit.ShowTypeDef(hDTRes,Nil);
end ;
if CallKind<>pcRegister then begin
PutS(';'+cSoftNL);
PutS(CallKindName[CallKind]);
end ;
if (CurUnit.Ver>verD3)and(VProc and $1000 <> 0) then begin
PutS(';'+cSoftNL);
PutS('overload');
end ;
NLOfs := Ofs0;
end ;
function GetNameAtOfs(L,LBest: TDCURec; Frame: integer; var DBest: integer): TDCURec;
var
D: integer;
begin
Result := LBest;
while L<>Nil do begin
if (L is TLocalDecl)and(TLocalDecl(L).GetTag<>arFld)
and(TLocalDecl(L).LocFlags and $8=0 {not a register})
then begin
D := Frame-TLocalDecl(L).Ndx;
if (D>=0)and(D<DBest) then begin
Result := L;
DBest := D;
if D=0 then
Exit;
end ;
end ;
L := L.Next;
end ;
end ;
function TProcDecl.GetRegDebugInfo(ProcOfs: integer; hReg: THBMName; Ofs: integer): String;
const
RegId: array[0..6+12] of THBMName =
(hnEAX,hnEDX,hnECX,hnEBX,hnESI,hnEDI,hnEBP,
//Register parts:
hnAL,hnDL,hnCL,hnBL, hnAH,hnDH,hnCH,hnBH, hnAX,hnDX,hnCX,hnBX);
var
i,id,hDef: integer;
{Res: TLocalDecl;}
D: TDCURec;
TD: TTypeDef;
U: TUnit;
DOfs,Sz: integer;
LVP: PLocVarRec;
Tag: TDCURecTag;
InReg,IsVar: boolean;
begin
Result := '';
id := -1;
hReg := hReg or nf;
for i:=Low(RegId) to High(RegId) do
if RegId[i]=hReg then begin
id := i;
break;
end ;
if id<0 then begin
if hReg<>hnESP then
Exit;
//For ESP-based procedures. I can't understand how
//we can distinguish the two kinds by some flags
id := -2; //-1 denotes symbol scope end
end ;
if id>6 then
id := (id-7)and $3; //Register part
LVP := @(FProcLocVarTbl^[2]);
hDef := -1;
for i:=2 to FProcLocVarCnt-1 do begin
if LVP^.Ofs>ProcOfs then
break;
if LVP^.frame=id then
hDef := LVP^.Sym
else if (LVP^.frame=-1)and(LVP^.Sym=hDef) then
hDef := -1;
Inc(LVP);
end ;
TD := Nil;
IsVar := false;
if hDef>=0 then begin
InReg := true;
D := CurUnit.GetAddrDef(hDef);
if D=Nil then begin
Result := Format('Def #%x=Nil',[hDef]);
Exit; //Silent error
end ;
Sz := 4;
//TD := CurUnit.GetGlobalTypeDef(TLocalDecl(D).hDT,U);
case TLocalDecl(D).GetTag of
arVar: IsVar := true;
//arVal,drVar{local},arResult:;
end ;
end
else begin
if (id<>6{EBP})and(hReg<>hnESP{It can also be used as frame base}){or(Ofs=0)}
//But it's difficult to follow the ESP changes due to arg PUSHes
then
Exit;
{Seek EBP+Ofs variables}
InReg := false;
DOfs := MaxInt;
D := GetNameAtOfs(Args,Nil,Ofs,DOfs);
if DOfs<>0 then begin
D := GetNameAtOfs(Locals,D,Ofs,DOfs);
if DOfs<>0 then begin
D := GetNameAtOfs(Embedded,D,Ofs,DOfs);
if D=Nil then
Exit;
end ;
end ;
Sz := 1;
case TLocalDecl(D).GetTag of
arVar: begin
Sz := 4;
IsVar := true;
end ;
arVal,drVar{local},arResult: begin
TD := CurUnit.GetGlobalTypeDef(TLocalDecl(D).hDT,U);
if TD<>Nil then
Sz := TD.Sz
end ;
end ;
if DOfs>=Sz then
Exit;
hDef := TLocalDecl(D).hDecl;
Ofs := DOfs;
end ;
Result := GetDCURecStr(D, hDef,false);
if Ofs<0 then begin
Result := Format('%s%d',[Result,Ofs]);
Exit;
end ;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -