?? dcurecs.pas
字號(hào):
else if Ofs<>MOfs then
DCUErrorFmt('typed const %s: memory ofs mismatch (0x%x<>0x%x)',
[Name^,Ofs,MOfs]);
end ;
function TVarCDecl.GetSecKind: TDeclSecKind;
begin
if GenVarCAsVars then
Result := skVar
else
Result := skConst;
end ;
{ TAbsVarDecl. }
procedure TAbsVarDecl.Show;
begin
inherited Show;
PutSFmt(' absolute %s',[CurUnit.GetAddrStr(integer(Ofs),false)]);
end ;
{ TThreadVarDecl. }
function TThreadVarDecl.GetSecKind: TDeclSecKind;
begin
Result := skThreadVar;
end ;
{ TStrConstDecl. }
constructor TStrConstDecl.Create;
var
Tag: TDCURecTag;
begin
inherited Create(false{NoInf});
// if CurUnit.Ver<verD10 then
Sz := ReadUIndex;
hDT := ReadUIndex;
{ if CurUnit.Ver>=verD10 then begin Wrong code - to mix with UnitAddInfo
Tag := ReadTag;
if Tag<>drStop1 then
DCUError('unexplored StrConstDecl found, please report to the author.');
end ;}
if Sz=0 then
Sz := Cardinal(-1);
Ofs := Cardinal(-1);
// if (CurUnit.Ver>=verD10)and(CurUnit.Ver)
end ;
procedure TStrConstDecl.Show;
var
DP: Pointer;
{SzShown: integer;}
DS: Cardinal;
var
Fix0: integer;
MS: TFixupMemState;
begin
inherited Show;
PutS(': ');
CurUnit.ShowTypeDef(hDT,Nil);
// PutSFmt('{#%x @%x}',[hDT,Ofs]);
Inc(AuxLevel);
PutSFmt('{Ofs:0x%x}',[Ofs]);
Dec(AuxLevel);
// CurUnit.ShowTypeName(hDT);
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);
end ;
Dec(NLOfs,2);
end ;
function TStrConstDecl.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
else if Ofs<>MOfs then
DCUErrorFmt('typed const %s: memory ofs mismatch (0x%x<>0x%x)',
[Name^,Ofs,MOfs]);
end ;
function TStrConstDecl.GetSecKind: TDeclSecKind;
begin
if GenVarCAsVars then
Result := skVar
else
Result := skConst;
end ;
{ TLabelDecl. }
constructor TLabelDecl.Create;
begin
inherited Create;
Ofs := ReadUIndex;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
ReadUIndex; //=0
// CurUnit.AddAddrDef(Self);
end ;
procedure TLabelDecl.Show;
begin
// PutS('label ');
inherited Show;
PutSFmt('{at $%x}',[Ofs]);
end ;
function TLabelDecl.GetSecKind: TDeclSecKind;
begin
Result := skLabel;
end ;
//Labels can appear in the global decl. list when declared for unit init./fin.
function TLabelDecl.IsVisible(LK: TDeclListKind): boolean;
begin
{case LK of
dlMain: Result := false;
dlMainImpl: Result := true;
else
Result := true;
end ;}
Result := LK<>dlMain;
end ;
{ TExportDecl. }
constructor TExportDecl.Create;
begin
inherited Create;
hSym := ReadUIndex;
Index := ReadUIndex;
end ;
procedure TExportDecl.Show;
var
D: TDCURec;
N: PName;
begin
D := CurUnit.GetAddrDef(hSym);
N := Nil;
if D=Nil then
PutS('?')
else begin
D.ShowName;
N := D.Name;
end ;
Inc(NLOfs,2);
if (N<>Nil)and(Name<>Nil)and(N^<>Name^) then begin
PutS(cSoftNL+'name'+cSoftNL);
ShowName;
end ;
if Index<>0 then
PutSFmt(cSoftNL+'index $%x',[Index]);
Dec(NLOfs,2);
end ;
function TExportDecl.GetSecKind: TDeclSecKind;
begin
Result := skExport;
end ;
{ TLocalDecl. }
constructor TLocalDecl.Create(LK: TDeclListKind);
var
M,M2: boolean;
begin
inherited Create;
M := GetTag in [arMethod,arConstr,arDestr];
M2 := (CurUnit.Ver=verD2)and M;
LocFlags := ReadUIndex;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
ReadUIndex; //Not shure that it's right place
if not M2 then
hDT := ReadUIndex
else if M then
Ndx := ReadUIndex
else
Ndx := ReadIndex;
if LK in [dlInterface,dlDispInterface] then
NDXB := ReadUIndex
else
NDXB := -1;
// B := ReadByte;
if not M2 then begin
if M then
Ndx := ReadUIndex
else
Ndx := ReadIndex;
end
else
hDT := ReadUIndex;
{if LK=dlArgsT then
Exit;}
if not(LK in [dlClass,dlInterface,dlDispInterface,dlFields]) then
case GetTag of
arFld: Exit ;
arMethod,
arConstr,
arDestr: (*if not((LK in [dlClass,dlInterface])and(NDX1<>0{virtual?})) then*) Exit ;
end ;
// CurUnit.AddAddrDef(Self);
end ;
procedure TLocalDecl.Show;
var
RefName: PName;
MS: String;
begin
MS := '';
if ShowAuxValues then
case GetTag of
arVal: MS := 'val ';
arVar: MS := 'var ';
drVar: MS := 'local ';
arResult: MS := 'result ';
arAbsLocVar: MS := 'local absolute ';
arFld: MS := 'field ';
{arMethod: MS := 'method';
arConstr: MS := 'constructor';
arDestr: MS := 'destructor';}
end
else
case GetTag of
// arVar,drVar,arAbsLocVar: MS := 'var ';
arVar: MS := 'var ';
arResult: MS := 'result ';
end ;
if MS<>'' then
PutS(MS);
inherited Show;
(* RefName := CurUnit.GetTypeName(hDT);
if RefName<>Nil then
PutSFmt(':%s{#%d #1:%x #2:%x}',[RefName^,hDT,Ndx1,Ndx])
else
PutSFmt(':{#%d #1:%x #2:%x}',[hDT,Ndx1,Ndx]);
*)
PutS(': ');
CurUnit.ShowTypeDef(hDT,Nil);
// PutSFmt('{#%x #1:%x #2:%x}',[hDT,Ndx1,Ndx]);
Inc(AuxLevel);
PutSFmt('{F:%x Ofs:%d',[LocFlags,integer(Ndx)]);
if (LocFlags and $8<>0 {register})and(GetTag<>arFld) then begin
if (Ndx>=Low(RegName))and(Ndx<=High(RegName)) then
PutSFmt('=%s',[RegName[Ndx]])
else
PutS('=?')
end ;
if NDXB<>-1 then
PutSFmt(' NDXB:%x',[NDXB]);
PutS('}');
Dec(AuxLevel);
if GetTag=arAbsLocVar then
PutSFmt(' absolute %s',[CurUnit.GetAddrStr(integer(Ndx),false)]);
end ;
function TLocalDecl.GetLocFlagsSecKind: TDeclSecKind;
begin
case LocFlags and lfScope of
lfPrivate: Result := skPrivate;
lfProtected: Result := skProtected;
lfPublic: Result := skPublic;
lfPublished: Result := skPublished;
else
Result := skNone{Temp};
end
end ;
function TLocalDecl.GetSecKind: TDeclSecKind;
begin
if GetTag in [arFld, arMethod, arConstr, arDestr, arProperty, arClassVar] then
Result := GetLocFlagsSecKind
else if GetTag in [arResult,drVar,arAbsLocVar] then
Result := skVar
else
Result := skNone;
end ;
{ TMethodDecl. }
constructor TMethodDecl.Create(LK: TDeclListKind);
begin
inherited Create(LK);
InIntrf := LK in [dlInterface,dlDispInterface];
{ if Name^[0]=#0 then
hImport := ReadUIndex; //then hDT seems to be valid index in the
//parent class unit}
if not InIntrf then begin
if CurUnit.IsMSIL and(NDX<>0) then begin
ReadByteIfEQ(1);//I was unable to find something less perverse to skip this byte
end ;
if (CurUnit.Ver>=verD7)and(CurUnit.Ver<verK1)or(Name^[0]=#0)
then begin
hImport := ReadUIndex; //then hDT seems to be valid index in the
//parent class unit
end ;
end ;
//VMTNDX := MaxInt;
end ;
procedure TMethodDecl.Show;
var
MS: String;
D: TDCURec;
MK: TMethodKind;
PD: TProcDecl absolute D;
procedure ShowFlags;
begin
Inc(AuxLevel);
PutSFmt('{F:#%x hDT:%x} ',[LocFlags,hDT]);
if (Name^[0]=#0)and(hImport<>0) then
PutSFmt('{hImp: #%x} ',[hImport]);
Dec(AuxLevel);
end ;
begin
if LocFlags and lfClass<>0 then
PutS('class ');
PD := Nil;
if ResolveMethods then begin
if not((NDX=0)and CurUnit.IsMSIL) then begin
D := CurUnit.GetAddrDef(NDX);
if (D<>Nil)and not(D is TProcDecl) then
D := Nil;
if D<>Nil then begin
MK := mkProc;
case GetTag of
arMethod: MK := mkMethod;
arConstr: MK := mkConstructor;
arDestr: MK := mkDestructor;
end ;
TProcDecl(D).MethodKind := MK;
end ;
end ;
end ;
MS := '';
case GetTag of
arMethod: begin
if PD=Nil then
MS := 'method '
else if PD.IsProc then
MS := 'procedure '
else
MS := 'function ';
end ;
arConstr: MS := 'constructor ';
arDestr: MS := 'destructor ';
end ;
if (not InIntrf)and not((NDX=0)and CurUnit.IsMSIL) then begin
if MS<>'' then
PutS(MS);
{if (Name^[0]=#0)and(hImport<>0) then
PutS(CurUnit.GetAddrStr(integer(hImport),true))
else}
ShowName;
if PD=Nil then
PutS(': ');
ShowFlags;
if PD<>Nil then begin
Inc(AuxLevel);
PutSFmt('{%x=>%s}',[Ndx,PD.Name^]);
Dec(AuxLevel);
PD.ShowArgs;
end
else
PutS(CurUnit.GetAddrStr(Ndx,true));
Inc(NLOfs,2);
if LocFlags and lfOverride<>0 then
PutS(';'+cSoftNL+'override{');
if LocFlags and lfVirtual<>0 then
PutS(';'+cSoftNL+'virtual');
if LocFlags and lfVirtual<>0 then begin
if LocFlags and lfOverride=0 then
PutSFmt('{@%d}',[hDT*4])
else
PutSFmt(' @%d',[hDT*4]);
end ;
if LocFlags and lfDynamic<>0 then
PutS(';'+cSoftNL+'dynamic');
if LocFlags and lfOverride<>0 then
PutS('}');
Dec(NLOfs,2);
end
else begin
if MS<>'' then begin
Inc(AuxLevel);
PutS(MS);
Dec(AuxLevel);
end ;
if (NDX=0)and CurUnit.IsMSIL then
D := CurUnit.GetTypeDef(hImport) //this feature is used for copying method
//definitions of TA into that of TB when TB is defined by TB = type TA
else
D := CurUnit.GetTypeDef(NDX);
if (D<>Nil)and(D is TProcTypeDef) then begin
Inc(AuxLevel);
PutSFmt('{T#%x}',[hDT]);
Dec(AuxLevel);
PutS(TProcTypeDef(D).ProcStr);
PutS(' ');
ShowName;
SoftNL;
TProcTypeDef(D).ShowDecl(Nil);
ShowFlags;
end
else begin
ShowName;
PutS(': ');
ShowFlags;
CurUnit.ShowTypeDef(Ndx,Name);
end ;
end ;
end ;
{ TClassVarDecl. }
procedure TClassVarDecl.Show;
begin
PutS('class var'+cSoftNL);
inherited Show;
end ;
function TClassVarDecl.GetSecKind: TDeclSecKind;
begin
Result := GetLocFlagsSecKind;
end ;
{ TPropDecl. }
constructor TPropDecl.Create;
var
X,X1,X2,X3,Flags1: integer;
begin
inherited Create;
LocFlags := ReadIndex;
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
Flags1 := ReadUIndex;
hDT := ReadUIndex;
NDX := ReadIndex;
hIndex := ReadIndex;
hRead := ReadUIndex;
hWrite := ReadUIndex;
hStored := ReadUIndex;
// CurUnit.AddAddrDef(Self);
if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then begin
X := ReadUIndex;
X1 := ReadUIndex;
if CurUnit.IsMSIL then begin
X2 := ReadUIndex;
X3 := ReadUIndex;
end ;
end ;
hDeft := ReadIndex;
end ;
procedure TPropDecl.Show;
procedure PutOp(Name: String; hOp: TNDX);
var
V: String;
begin
if hOp=0 then
Exit;
V := CurUnit.GetAddrStr(hOp,true);
PutSFmt(cSoftNL+'%s %s',[Name,V])
end ;
var
D: TBaseDef;
hDT0: TDefNDX;
U: TUnit;
begin
PutS('property ');
inherited Show;
Inc(NLOfs,2);
if hDT<>0 then begin
{hDT=0 => inherited and something overrided}
D := CurUnit.GetTypeDef(hDT);
if (D<>Nil)and(D is TProcTypeDef)and(D.FName=Nil) then begin
{array property}
Inc(AuxLevel);
PutSFmt('{T#%x}',[hDT]);
Dec(AuxLevel);
//SoftNL;
Dec(NLOfs,2);
TProcTypeDef(D).ShowDecl('[]');
Inc(NLOfs,2);
end
else begin
PutS(':');
// PutSFmt(':{#%x}',[hDT]);
CurUnit.ShowTypeDef(hDT,Nil);
end
end ;
if hIndex<>TNDX($80000000) then
PutSFmt(cSoftNL+'index $%x',[hIndex]);
PutOp('read',hRead);
PutOp('write',hWrite);
PutOp('stored',hStored);
if hDeft<>TNDX($80000000) then begin
hDT0 := hDT;
U := CurUnit;
{if hDT0=0 then //ToDo: get property type in the parent class
hDT0 := GetPropType(U);}
PutS(cSoftNL+'default ');
if (U=Nil)or(U.ShowGlobalTypeValue(hDT0,@hDeft,SizeOf(hDeft),false{AndRest},true{IsConst})<0)
then
PutSFmt('$%x',[hDeft]);
end ;
Inc(AuxLevel);
SoftNL;
PutSFmt('{F:#%x,NDX:#%x}',[LocFlags,NDX]);
Dec(AuxLevel);
if LocFlags and lfDeftProp<>0 then
PutS('; default');
Dec(NLOfs,2);
end ;
function TPropDecl.GetSecKind: TDeclSecKind;
begin
case LocFlags and lfScope of
lfPrivate: Result := skPrivate;
lfProtected: Result := skProtected;
lfPublic: Result := skPublic;
lfPublished: Result := skPublished;
else
Result := skNone{Temp};
end;
end ;
{ TDispPropDecl. }
procedure TDispPropDecl.Show;
begin
PutS('property ');
ShowName;
Inc(NLOfs,2);
PutS(':'+cSoftNL);
CurUnit.ShowTypeDef(hDT,Nil);
Inc(AuxLevel);
PutSFmt('{F:%x',[LocFlags]);
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -