mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-01 20:03:39 +02:00
963 lines
31 KiB
ObjectPascal
963 lines
31 KiB
ObjectPascal
unit Unit1;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
FpImgReaderWinPE, Classes, SysUtils, math, FileUtil, LazLogger, LazLoggerProfiling, LazSysUtils,
|
|
FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst, FpPascalParser, FpDbgInfo, FpDbgDwarfDataClasses,
|
|
FpDbgUtil, FpdMemoryTools, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, EditBtn,
|
|
Menus, Clipbrd, maps, laz.VirtualTrees, types, fgl, strutils;
|
|
|
|
type
|
|
TTreeNodeData = record
|
|
Text: String;
|
|
Data: Integer;
|
|
Num, Link: Integer;
|
|
end;
|
|
|
|
PTreeNodeData = ^TTreeNodeData;
|
|
|
|
TNameMap = specialize TFPGMap<AnsiString, AnsiString>;
|
|
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
btnCopyAll: TButton;
|
|
btnLoad: TButton;
|
|
btnShowUnit: TButton;
|
|
btnCopyOne: TButton;
|
|
btnLines: TButton;
|
|
btnUnload: TButton;
|
|
FileNameEdit1: TFileNameEdit;
|
|
CompUnitListBox: TListBox;
|
|
VStringTree: TLazVirtualStringTree;
|
|
StatusBar1: TStatusBar;
|
|
procedure btnCopyAllClick(Sender: TObject);
|
|
procedure btnCopyOneClick(Sender: TObject);
|
|
procedure btnLoadClick(Sender: TObject);
|
|
procedure btnShowUnitClick(Sender: TObject);
|
|
procedure btnLinesClick(Sender: TObject);
|
|
procedure btnUnloadClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
|
|
procedure VStringTreeDblClick(Sender: TObject);
|
|
procedure VStringTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
procedure VStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
|
|
procedure VStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
|
|
var InitialStates: TVirtualNodeInitStates);
|
|
procedure VStringTreeNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Column: TColumnIndex; const NewText: String);
|
|
procedure VStringTreeNodeDblClick(Sender: TBaseVirtualTree; const HitInfo: THitInfo);
|
|
private
|
|
{ private declarations }
|
|
NameList: TNameMap;
|
|
FFileName: String;
|
|
FTestCaseTexts: TStringList;
|
|
FImageLoaderList: TDbgImageLoaderList;
|
|
FMemModel: TFpDbgMemModel;
|
|
FDwarfInfo: TFpDwarfInfo;
|
|
FCUCount : Integer;
|
|
FShowingUnit: Boolean;
|
|
function GetDataPtr(n: PVirtualNode): PTreeNodeData; inline;
|
|
procedure GotoNode(n: PVirtualNode);
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
{ public declarations }
|
|
procedure LoadDwarf;
|
|
procedure UnLoadDwarf;
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
type
|
|
TDwarfCompilationUnitHack = class(TDwarfCompilationUnit)
|
|
public
|
|
property FirstScope;
|
|
property AbbrevList;
|
|
end;
|
|
|
|
{ TForm1 }
|
|
|
|
procedure TForm1.btnLoadClick(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FileNameEdit1.FileName = '' then
|
|
FileNameEdit1.RunDialog;
|
|
FFileName := FileNameEdit1.FileName;
|
|
LoadDwarf;
|
|
|
|
if FDwarfInfo = nil then
|
|
exit;
|
|
|
|
CompUnitListBox.Clear;
|
|
for i := 0 to FCUCount - 1 do begin
|
|
CompUnitListBox.AddItem(FDwarfInfo.CompilationUnits[i].FileName,
|
|
FDwarfInfo.CompilationUnits[i] );
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.btnCopyOneClick(Sender: TObject);
|
|
var
|
|
n: PVirtualNode;
|
|
i: PtrInt;
|
|
begin
|
|
n := VStringTree.GetFirstSelected;
|
|
if n = nil then exit;
|
|
|
|
i := GetDataPtr(n)^.Data - 1;
|
|
if i < 0 then exit;
|
|
debugln(['TForm1.MenuItem1Click ']);
|
|
Clipboard.AsText := FTestCaseTexts[i];
|
|
end;
|
|
|
|
procedure TForm1.btnLinesClick(Sender: TObject);
|
|
const
|
|
B: Array [Boolean] of string = ('F', 'T');
|
|
var
|
|
i: Integer;
|
|
Node, ParentNode: PVirtualNode;
|
|
CU: TDwarfCompilationUnitHack;
|
|
SM: TDwarfLineInfoStateMachine;
|
|
begin
|
|
VStringTree.BeginUpdate;
|
|
try
|
|
VStringTree.Clear;
|
|
i := CompUnitListBox.ItemIndex;
|
|
if i < 0 then exit;
|
|
CU := TDwarfCompilationUnitHack(CompUnitListBox.Items.Objects[i]);
|
|
if CU = nil then exit;
|
|
|
|
SM := CU.FLineInfo.StateMachine;
|
|
SM.Reset;
|
|
ParentNode := nil;
|
|
|
|
while SM.NextLine do
|
|
begin
|
|
|
|
Node := VStringTree.AddChild(ParentNode);
|
|
if VStringTree.IsVisible[Node] then ; // init the node
|
|
|
|
GetDataPtr(Node)^.Text :=
|
|
Format('Line: %2d, Col: %2d, Addr: %s, IsStmt: %s, Basic: %s, EndSeq: %s, Prol: %s, Epil: %s, ISA: %u, File: %s // Ended: %s',
|
|
[SM.Line, SM.Column, IntToHex(SM.Address,16), b[SM.IsStmt], b[SM.BasicBlock],
|
|
b[SM.EndSequence], b[SM.PrologueEnd], b[SM.EpilogueBegin], SM.Isa, sm.FileName, b[SM.Ended] ]);
|
|
|
|
if ParentNode = nil then ParentNode := Node;
|
|
if SM.EndSequence then begin
|
|
ParentNode := nil;
|
|
if not SM.NextLine then break;
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
VStringTree.EndUpdate;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TForm1.btnUnloadClick(Sender: TObject);
|
|
begin
|
|
UnLoadDwarf;
|
|
end;
|
|
|
|
procedure TForm1.btnCopyAllClick(Sender: TObject);
|
|
var
|
|
nm: TStringList;
|
|
vars: String;
|
|
procedure AddChildren(n: PVirtualNode; var s: string; idnt: String);
|
|
var
|
|
i: PtrInt;
|
|
s2: String;
|
|
begin
|
|
n := VStringTree.GetFirstChildNoInit(n);
|
|
while n <> nil do begin
|
|
i := GetDataPtr(n)^.Data-1;
|
|
s2 := 'XXXXXXXXXXX.';
|
|
if i >= 0 then
|
|
s2 := FTestCaseTexts[i];
|
|
nm.Add(copy(s2, 1, max(0, pos('.', s2)-1)));
|
|
if i >= 0 then begin
|
|
vars := vars + nm[nm.Count-1] +', ';
|
|
if s2 <> '' then begin
|
|
s2 := nm[nm.Count-1] + ' := ' + nm[nm.Count-2] + '.GetNewChild;' +LineEnding
|
|
+ s2;
|
|
|
|
s2 := AnsiReplaceStr(s2, LineEnding, LineEnding+idnt);
|
|
s := s + idnt + s2 + LineEnding;;
|
|
end;
|
|
end;
|
|
AddChildren(n, s, idnt+' ');
|
|
nm.Delete(nm.Count-1);
|
|
VStringTree.GetNextSiblingNoInit(n);
|
|
end;
|
|
end;
|
|
var
|
|
s: String;
|
|
i: PtrInt;
|
|
i2: Integer;
|
|
n: PVirtualNode;
|
|
begin
|
|
nm := TStringList.Create;
|
|
n := VStringTree.GetFirstSelected;
|
|
if n = nil then exit;
|
|
i := GetDataPtr(n)^.Data-1;
|
|
if i < 0 then exit;
|
|
debugln(['TForm1.MenuItem1Click ']);
|
|
s := FTestCaseTexts[i] + LineEnding;
|
|
nm.Add(copy(s, 1, pos('.',s)-1));
|
|
vars := vars + nm[nm.Count-1] +', ';
|
|
|
|
AddChildren(n, s, ' ');
|
|
|
|
s := 'var '+vars + LineEnding + LineEnding + LineEnding + s;
|
|
for i2 := 0 to NameList.count - 1 do
|
|
s := AnsiReplaceStr(s, NameList.Keys[i2], NameList.Data[i2]);
|
|
|
|
Clipboard.AsText := s;
|
|
nm.Free;
|
|
end;
|
|
|
|
procedure TForm1.LoadDwarf;
|
|
var
|
|
ImageLoader: TDbgImageLoader;
|
|
begin
|
|
UnLoadDwarf;
|
|
ImageLoader := TDbgImageLoader.Create(FFileName);
|
|
FImageLoaderList := TDbgImageLoaderList.Create(True);
|
|
ImageLoader.AddToLoaderList(FImageLoaderList);
|
|
|
|
FMemModel := TFpDbgMemModel.Create;
|
|
FDwarfInfo := TFpDwarfInfo.Create(FImageLoaderList, nil, FMemModel);
|
|
FCUCount := FDwarfInfo.LoadCompilationUnits;
|
|
end;
|
|
|
|
|
|
procedure TForm1.btnShowUnitClick(Sender: TObject);
|
|
var
|
|
CU: TDwarfCompilationUnitHack;
|
|
BaseScopeAddr: Pointer;
|
|
|
|
function ToHex(var p: pbyte; l : integer):String; inline;
|
|
begin
|
|
Result := '';
|
|
while l > 0 do begin
|
|
Result := IntToHex(p^,2) + Result;
|
|
inc(p);
|
|
dec(l);
|
|
end;
|
|
end;
|
|
|
|
function ToHexCommaList(p: pbyte; l : integer):String;
|
|
begin
|
|
Result := '';
|
|
while l > 0 do begin
|
|
if Result <> ''
|
|
then Result := Result + ', ' + '$'+IntToHex(p^,2)
|
|
else Result := Result + '$'+IntToHex(p^,2);
|
|
inc(p);
|
|
dec(l);
|
|
end;
|
|
end;
|
|
|
|
function DecodeLocation(AData: PByte; ASize: QWord): String;
|
|
function MakeAddressString(AData: Pointer): string;
|
|
begin
|
|
Result := '$'+IntToHex(PLongWord(AData)^, 8)
|
|
//Result := '$'+IntToHex(PQWord(AData)^, 16);
|
|
end;
|
|
var
|
|
MaxData: PByte;
|
|
v: Int64;
|
|
begin
|
|
Result:='';
|
|
MaxData := AData + ASize - 1;
|
|
while AData <= MaxData do
|
|
begin
|
|
if Result <> '' then Result := Result + ', ';
|
|
case AData^ of
|
|
DW_OP_addr: begin
|
|
Result := Result + 'DW_OP_addr, AddrB(' + MakeAddressString(@AData[1]) + ')';
|
|
Inc(AData, 4);
|
|
end;
|
|
DW_OP_deref: begin
|
|
Result := Result + 'DW_OP_deref';
|
|
end;
|
|
DW_OP_const1u: begin
|
|
Result := Result + 'DW_OP_const1u, ' + IntToStr(AData[1]);
|
|
Inc(AData, 1);
|
|
end;
|
|
DW_OP_const1s: begin
|
|
Result := Result + 'DW_OP_const1s, ' + IntToStr(PShortInt(@AData[1])^);
|
|
Inc(AData, 1);
|
|
end;
|
|
DW_OP_const2u: begin
|
|
Result := Result + 'DW_OP_const2u, NumU(' + IntToStr(PWord(@AData[1])^) + ',2)';
|
|
Inc(AData, 2);
|
|
end;
|
|
DW_OP_const2s: begin
|
|
Result := Result + 'DW_OP_const2s, NumS(' + IntToStr(PSmallInt(@AData[1])^) + ',2)';
|
|
Inc(AData, 2);
|
|
end;
|
|
DW_OP_const4u: begin
|
|
Result := Result + 'DW_OP_const4u, NumU(' + IntToStr(PLongWord(@AData[1])^) + ',4)';
|
|
Inc(AData, 4);
|
|
end;
|
|
DW_OP_const4s: begin
|
|
Result := Result + 'DW_OP_const4s, NumS(' + IntToStr(PLongInt(@AData[1])^) + ',4)';
|
|
Inc(AData, 4);
|
|
end;
|
|
DW_OP_const8u: begin
|
|
Result := Result + 'DW_OP_const8u, NumU' + IntToStr(PQWord(@AData[1])^) + ',8)';
|
|
Inc(AData, 8);
|
|
end;
|
|
DW_OP_const8s: begin
|
|
Result := Result + 'DW_OP_const8s, NumS' + IntToStr(PInt64(@AData[1])^) + ',8)';
|
|
Inc(AData, 8);
|
|
end;
|
|
DW_OP_constu: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_constu, ULEB' + IntToStr(ULEB128toOrdinal(AData)) + ')';
|
|
Dec(AData);
|
|
end;
|
|
DW_OP_consts: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_consts, SLEB(' + IntToStr(SLEB128toOrdinal(AData)) + ')';
|
|
Dec(AData);
|
|
end;
|
|
DW_OP_dup: begin
|
|
Result := Result + 'DW_OP_dup';
|
|
end;
|
|
DW_OP_drop: begin
|
|
Result := Result + 'DW_OP_drop';
|
|
end;
|
|
DW_OP_over: begin
|
|
Result := Result + 'DW_OP_over';
|
|
end;
|
|
DW_OP_pick: begin
|
|
Result := Result + 'DW_OP_pick, ' + IntToStr(AData[1]);
|
|
Inc(AData, 1);
|
|
end;
|
|
DW_OP_swap: begin
|
|
Result := Result + 'DW_OP_swap';
|
|
end;
|
|
DW_OP_rot: begin
|
|
Result := Result + 'DW_OP_rot';
|
|
end;
|
|
DW_OP_xderef: begin
|
|
Result := Result + 'DW_OP_xderef';
|
|
end;
|
|
DW_OP_abs: begin
|
|
Result := Result + 'DW_OP_abs';
|
|
end;
|
|
DW_OP_and: begin
|
|
Result := Result + 'DW_OP_and';
|
|
end;
|
|
DW_OP_div: begin
|
|
Result := Result + 'DW_OP_div';
|
|
end;
|
|
DW_OP_minus: begin
|
|
Result := Result + 'DW_OP_minus';
|
|
end;
|
|
DW_OP_mod: begin
|
|
Result := Result + 'DW_OP_mod';
|
|
end;
|
|
DW_OP_mul: begin
|
|
Result := Result + 'DW_OP_mul';
|
|
end;
|
|
DW_OP_neg: begin
|
|
Result := Result + 'DW_OP_neg';
|
|
end;
|
|
DW_OP_not: begin
|
|
Result := Result + 'DW_OP_not';
|
|
end;
|
|
DW_OP_or: begin
|
|
Result := Result + 'DW_OP_or';
|
|
end;
|
|
DW_OP_plus: begin
|
|
Result := Result + 'DW_OP_plus';
|
|
end;
|
|
DW_OP_plus_uconst: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_plus_uconst, ULEB(' + IntToStr(ULEB128toOrdinal(AData))+')';
|
|
Dec(AData);
|
|
end;
|
|
DW_OP_shl: begin
|
|
Result := Result + 'DW_OP_shl';
|
|
end;
|
|
DW_OP_shr: begin
|
|
Result := Result + 'DW_OP_shr';
|
|
end;
|
|
DW_OP_shra: begin
|
|
Result := Result + 'DW_OP_shra';
|
|
end;
|
|
DW_OP_xor: begin
|
|
Result := Result + 'DW_OP_xor';
|
|
end;
|
|
DW_OP_skip: begin
|
|
Result := Result + 'DW_OP_skip, NumS(' + IntToStr(PSmallInt(@AData[1])^) + ',2)';
|
|
Inc(AData, 2);
|
|
end;
|
|
DW_OP_bra: begin
|
|
Result := Result + 'DW_OP_bra, NumS(' + IntToStr(PSmallInt(@AData[1])^) + ',2)';
|
|
Inc(AData, 2);
|
|
end;
|
|
DW_OP_eq: begin
|
|
Result := Result + 'DW_OP_eq';
|
|
end;
|
|
DW_OP_ge: begin
|
|
Result := Result + 'DW_OP_ge';
|
|
end;
|
|
DW_OP_gt: begin
|
|
Result := Result + 'DW_OP_gt';
|
|
end;
|
|
DW_OP_le: begin
|
|
Result := Result + 'DW_OP_le';
|
|
end;
|
|
DW_OP_lt: begin
|
|
Result := Result + 'DW_OP_lt';
|
|
end;
|
|
DW_OP_ne: begin
|
|
Result := Result + 'DW_OP_ne';
|
|
end;
|
|
DW_OP_lit0..DW_OP_lit31: begin
|
|
Result := Result + 'DW_OP_lit' + IntToStr(AData^ - DW_OP_lit0);
|
|
end;
|
|
DW_OP_reg0..DW_OP_reg31: begin
|
|
Result := Result + 'DW_OP_reg' + IntToStr(AData^ - DW_OP_reg0);
|
|
end;
|
|
DW_OP_breg0..DW_OP_breg31: begin
|
|
Result := Result + 'DW_OP_breg' + IntToStr(AData^ - DW_OP_breg0);
|
|
Inc(AData);
|
|
v := SLEB128toOrdinal(AData);
|
|
Dec(AData);
|
|
Result := Result + ', SLEB(';
|
|
Result := Result + IntToStr(v) + ')';
|
|
end;
|
|
DW_OP_regx: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_regx, ULEB(' + IntToStr(ULEB128toOrdinal(AData)) + ')';
|
|
Dec(AData);
|
|
end;
|
|
DW_OP_fbreg: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_fbreg, SLEB(' + IntToStr(SLEB128toOrdinal(AData)) + ')';
|
|
Dec(AData);
|
|
end;
|
|
DW_OP_bregx: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_bregx, ULEB(' + IntToStr(ULEB128toOrdinal(AData)) + ')';
|
|
v := SLEB128toOrdinal(AData);
|
|
Dec(AData);
|
|
Result := Result + ', SLEB(';
|
|
Result := Result + IntToStr(v) + ')';
|
|
end;
|
|
DW_OP_piece: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_piece, ULEB(' + IntToStr(ULEB128toOrdinal(AData)) + ')';
|
|
Dec(AData);
|
|
end;
|
|
DW_OP_deref_size: begin
|
|
Result := Result + 'DW_OP_deref_size, ' + IntToStr(AData[1]);
|
|
Inc(AData);
|
|
end;
|
|
DW_OP_xderef_size: begin
|
|
Result := Result + 'DW_OP_xderef_size, ' + IntToStr(AData[1]);
|
|
Inc(AData);
|
|
end;
|
|
DW_OP_nop: begin
|
|
Result := Result + 'DW_OP_nop';
|
|
end;
|
|
DW_OP_push_object_address: begin
|
|
Result := Result + 'DW_OP_push_object_address';
|
|
end;
|
|
DW_OP_call2: begin
|
|
Result := Result + 'DW_OP_call2, ' + IntToStr(PWord(@AData[1])^);
|
|
Inc(AData, 2);
|
|
end;
|
|
DW_OP_call4: begin
|
|
Result := Result + 'DW_OP_call4, ' + IntToStr(PLongWord(@AData[1])^);
|
|
Inc(AData, 4);
|
|
end;
|
|
DW_OP_call_ref: begin
|
|
Result := Result + 'DW_OP_call_ref, AddrB(' + MakeAddressString(@AData[1]) + ')';
|
|
Inc(AData, 4);
|
|
end;
|
|
DW_OP_form_tls_address: begin
|
|
Result := Result + 'DW_OP_form_tls_address';
|
|
end;
|
|
DW_OP_call_frame_cfa: begin
|
|
Result := Result + 'DW_OP_call_frame_cfa';
|
|
end;
|
|
DW_OP_bit_piece: begin
|
|
Inc(AData);
|
|
Result := Result + 'DW_OP_bit_piece, ULEB(' + IntToStr(ULEB128toOrdinal(AData)) + '), ULEB(' + IntToStr(ULEB128toOrdinal(AData)) + ')';
|
|
Dec(AData);
|
|
end;
|
|
DW_OP_lo_user..DW_OP_hi_user: begin
|
|
Result := Result + 'DW_OP_user, ' + IntToStr(AData^);
|
|
end;
|
|
else begin
|
|
Result := Result + 'Unknown DW_OP_' + IntToStr(AData^);
|
|
result := Result + ' RemainCnt:' + IntToStr(MaxData - AData);
|
|
break;
|
|
end
|
|
end;
|
|
Inc(AData);
|
|
//Result := Result +' / ';
|
|
end;
|
|
end;
|
|
|
|
function AddAbbrev(AParent: PVirtualNode; s: TDwarfScopeInfo; Def: TDwarfAbbrev;
|
|
var PascalTestCAseCode: String; namePreFix: String = ''): String;
|
|
var
|
|
p: Pointer;
|
|
Form: Cardinal;
|
|
Attribute: Cardinal;
|
|
i: Integer;
|
|
s1, s2, s3, s4, stest: String;
|
|
ValueSize: QWord;
|
|
Value: qword;
|
|
SValue: int64;
|
|
p2: Pointer;
|
|
AddedNode: PVirtualNode;
|
|
lnk: Integer;
|
|
nptr: PTreeNodeData;
|
|
begin
|
|
Result := '';
|
|
PascalTestCAseCode := '';
|
|
p := s.Entry;
|
|
ULEB128toOrdinal(p);
|
|
for i := def.index to Def.index + Def.count - 1 do begin
|
|
Form := CU.AbbrevList.EntryPointer[i]^.Form;
|
|
Attribute := CU.AbbrevList.EntryPointer[i]^.Attribute;
|
|
s1 := DwarfAttributeToString(Attribute);
|
|
s2 := DwarfAttributeFormToString(Form);
|
|
p2 := p;
|
|
|
|
case Form of
|
|
DW_FORM_addr : begin
|
|
s3 := ToHex(p, cu.AddressSize {4} {FCU.FAddressSize});
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddAddr(%s, %s, $%s);%s', [s1, s2, s3, LineEnding]);
|
|
end;
|
|
DW_FORM_exprloc,
|
|
DW_FORM_block : begin
|
|
p2 := p;
|
|
ValueSize := ULEB128toOrdinal(p);
|
|
stest := ToHexCommaList(p,ValueSize);
|
|
p2 := p;
|
|
s3 := IntToStr(ValueSize) + ': ' + ToHex(p, ValueSize);
|
|
if (Attribute = DW_AT_location) or (Attribute = DW_AT_data_location) or (Attribute = DW_AT_data_member_location) then
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLenU([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
|
|
else
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLenU([%s]));%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_block1 : begin
|
|
ValueSize := PByte(p)^;
|
|
Inc(p, 1);
|
|
p2 := p;
|
|
stest := ToHexCommaList(p,ValueSize);
|
|
s3 := IntToStr(ValueSize) + ': ' + ToHex(p, ValueSize);
|
|
if (Attribute = DW_AT_location) or (Attribute = DW_AT_data_location) or (Attribute = DW_AT_data_member_location) then
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLen1([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
|
|
else
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLen1([%s]));%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_block2 : begin
|
|
ValueSize := PWord(p)^;
|
|
Inc(p, 2);
|
|
p2 := p;
|
|
stest := ToHexCommaList(p,ValueSize);
|
|
s3 := IntToStr(ValueSize) + ': ' + ToHex(p, ValueSize);
|
|
if (Attribute = DW_AT_location) or (Attribute = DW_AT_data_location) or (Attribute = DW_AT_data_member_location) then
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLen2([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
|
|
else
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLen2([%s]));%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_block4 : begin
|
|
ValueSize := PLongWord(p)^;
|
|
Inc(p, 4);
|
|
p2 := p;
|
|
stest := ToHexCommaList(p,ValueSize);
|
|
s3 := IntToStr(ValueSize) + ': ' + ToHex(p, ValueSize);
|
|
if (Attribute = DW_AT_location) or (Attribute = DW_AT_data_location) or (Attribute = DW_AT_data_member_location) then
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLen4([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
|
|
else
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, BytesLen4([%s]));%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_data1 : begin
|
|
stest := ToHexCommaList(p,1);
|
|
s3 := ToHex(p, 1);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, [%s]);%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_data2 : begin
|
|
stest := ToHexCommaList(p,2);
|
|
s3 := ToHex(p, 2);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, [%s]);%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_data4 : begin
|
|
stest := ToHexCommaList(p,4);
|
|
s3 := ToHex(p, 4);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, [%s]);%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_data8 : begin
|
|
stest := ToHexCommaList(p,8);
|
|
s3 := ToHex(p, 8);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, [%s]);%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_sdata : begin
|
|
SValue := SLEB128toOrdinal(p);
|
|
s3 := IntToStr(SValue);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddSLEB(%s, %s, %d);%s', [s1, s2, SValue, LineEnding]);
|
|
end;
|
|
DW_FORM_udata : begin
|
|
Value := ULEB128toOrdinal(p);
|
|
s3 := IntToStr(Value);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddULEB(%s, %s, %u);%s', [s1, s2, Value, LineEnding]);
|
|
end;
|
|
DW_FORM_flag : begin
|
|
stest := ToHexCommaList(p,1);
|
|
s3 := ToHex(p, 1);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, [%s]);%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_ref1 : begin
|
|
stest := ToHexCommaList(p,1);
|
|
s3 := ToHex(p, 1);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PByte(p-1)^), stest, LineEnding]);
|
|
//Format(namePreFix+'AddRef(%s, %s, FOO); // %s %s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_ref2 : begin
|
|
stest := ToHexCommaList(p,3);
|
|
s3 := ToHex(p, 2);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PWord(p-2)^), stest, LineEnding]);
|
|
//Format(namePreFix+'AddRef(%s, %s, FOO); // %s %s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_ref4 : begin
|
|
stest := ToHexCommaList(p,4);
|
|
lnk := PInteger(p)^ -11;
|
|
s4 := IntToHex(PInteger(p)^ -11, 8);;
|
|
s3 := ToHex(p, 4) + ' // '+ s4;
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PDWord(p-4)^), stest, LineEnding]);
|
|
//Format(namePreFix+'AddRef(%s, %s, FOO); // %s %s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_ref8 : begin
|
|
stest := ToHexCommaList(p,8);
|
|
s3 := ToHex(p, 8);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PQWord(p-8)^), stest, LineEnding]);
|
|
//Format(namePreFix+'AddRef(%s, %s, FOO); // %s %s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_ref_udata: begin
|
|
Value := ULEB128toOrdinal(p);
|
|
s3 := IntToStr(Value);
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddRef(%s, %s, FOO); // %u // ULEB %s', [s1, s2, Value, LineEnding]);
|
|
end;
|
|
DW_FORM_ref_addr : begin
|
|
stest := ToHexCommaList(p,4);
|
|
s3 := ToHex(p, 4 {FCU.FAddressSize});
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddRef(%s, %s, FOO); // %s // %s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_string : begin
|
|
s3 := copy(pchar(p),1,1000);
|
|
while pbyte( p)^ <> 0 do begin
|
|
inc(pbyte(p));
|
|
end;
|
|
inc(pbyte(p));
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, ''%s''+#0);%s', [s1, s2, s3, LineEnding]);
|
|
end;
|
|
DW_FORM_strp : begin
|
|
stest := ToHexCommaList(p,4);
|
|
s3 := ToHex(p, 4 {FCU.FAddressSize});
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, [%s]);%s', [s1, s2, stest, LineEnding]);
|
|
end;
|
|
DW_FORM_indirect : begin
|
|
Value := ULEB128toOrdinal(p);
|
|
s3 := IntToStr(Value);
|
|
//Form := ULEB128toOrdinal(p);
|
|
//Continue;
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'AddULEB(%s, %s, %u);%s', [s1, s2, Value, LineEnding]);
|
|
end;
|
|
DW_FORM_sec_offset: begin
|
|
if CU.IsDwarf64 then begin
|
|
Value := PQWord(p)^;
|
|
s3 := ToHex(p, 8);
|
|
inc(p, 8);
|
|
end
|
|
else begin
|
|
Value := PLongWord(P)^;
|
|
s3 := ToHex(p, 4);
|
|
inc(p, 4);
|
|
end;
|
|
end;
|
|
DW_FORM_flag_present: begin
|
|
s3 := 'Yes';
|
|
end;
|
|
DW_FORM_ref_sig8: begin
|
|
Value := PQWord(p)^;
|
|
s3 := ToHex(p, 8);
|
|
inc(p, 8);
|
|
end;
|
|
else
|
|
s3 := '?????';
|
|
PascalTestCAseCode := PascalTestCAseCode +
|
|
Format(namePreFix+'Add(%s, %s, %s);%s', [s1, s2, '???????????', LineEnding]);
|
|
end;
|
|
|
|
if Attribute = DW_AT_name then Result := s3;
|
|
|
|
if (Attribute = DW_AT_location) or (Attribute = DW_AT_data_location) or (Attribute = DW_AT_data_member_location)
|
|
or (Attribute = DW_AT_upper_bound) or (Attribute = DW_AT_lower_bound)
|
|
then begin
|
|
stest := DecodeLocation(p2, ValueSize);
|
|
s3 := s3 + ' // ' +stest;
|
|
end;
|
|
|
|
AddedNode := VStringTree.AddChild(AParent);
|
|
if VStringTree.IsVisible[AddedNode] then ; // init the node
|
|
nptr := GetDataPtr(AddedNode);
|
|
VStringTree.Text[AddedNode, 0] := Format(' -- Attr: %20s(%4x) Form: %18s(%4x) >> %s', [s1, Attribute, s2, Form, s3]);
|
|
nptr^.Link := lnk;
|
|
end;
|
|
end;
|
|
|
|
function AddNode(AParent, Asibling: PVirtualNode; s: TDwarfScopeInfo): PVirtualNode;
|
|
var
|
|
p: Pointer;
|
|
Abbrev: QWord;
|
|
Node: PVirtualNode;
|
|
s2: TDwarfScopeInfo;
|
|
n: PVirtualNode;
|
|
i: Integer;
|
|
Def: TDwarfAbbrev;
|
|
entryname: String;
|
|
TestCaseText: String;
|
|
NMLIdx: Integer;
|
|
pre, sName, t: String;
|
|
nptr: PTreeNodeData;
|
|
begin
|
|
Result := nil;
|
|
p := s.Entry;
|
|
Abbrev := ULEB128toOrdinal(p);
|
|
p := s.Entry;
|
|
CU.GetDefinition(p, Def);
|
|
Node := VStringTree.AddChild(AParent);
|
|
if VStringTree.IsVisible[Node] then ; // init the node
|
|
GetDataPtr(Node)^.Text := Format('Abr: %d Tag: %d %s ', [Abbrev, Def.tag, DwarfTagToString(Def.tag)]);
|
|
|
|
sName := 'Info__'+IntToStr(s.Entry - BaseScopeAddr + 11)+'_.';
|
|
entryname := AddAbbrev(Node, s, Def, TestCaseText, sName);
|
|
|
|
pre := '';
|
|
Case def.tag of
|
|
DW_TAG_base_type, DW_TAG_string_type, DW_TAG_union_type, DW_TAG_ptr_to_member_type,
|
|
DW_TAG_file_type, DW_TAG_thrown_type, DW_TAG_subroutine_type, DW_TAG_packed_type,
|
|
DW_TAG_const_type, DW_TAG_volatile_type, DW_TAG_reference_type,
|
|
DW_TAG_subrange_type, DW_TAG_enumeration_type,
|
|
DW_TAG_enumerator, DW_TAG_set_type, DW_TAG_structure_type, DW_TAG_class_type,
|
|
DW_TAG_array_type: pre:= 'Type';
|
|
DW_TAG_typedef: pre:= 'TypeDecl';
|
|
DW_TAG_pointer_type: pre:= 'TypePtr';
|
|
DW_TAG_variable, DW_TAG_formal_parameter, DW_TAG_member: pre:= 'Var';
|
|
DW_TAG_subprogram: pre:= 'Prog';
|
|
DW_TAG_compile_unit: pre:= 'Unit';
|
|
else pre:= 'XX';
|
|
end;
|
|
pre := pre + entryname;
|
|
pre := AnsiReplaceStr(pre, '$', '');
|
|
pre := AnsiReplaceStr(pre, '.', '_');
|
|
pre := AnsiReplaceStr(pre, ' ', '_');
|
|
pre := AnsiReplaceStr(pre, ' ', '_');
|
|
|
|
NameList['Info__'+IntToStr(s.Entry - BaseScopeAddr + 11)+'_']
|
|
:= pre+'_'+IntToStr(FTestCaseTexts.Count);
|
|
i := 0;
|
|
if s.HasChild then i := 1;
|
|
TestCaseText :=
|
|
Format('%sTag := %s;%s',
|
|
[sName, DwarfTagToString(Def.tag), LineEnding])
|
|
+ Format('%sChildren := %d;%s', [sName, i, LineEnding])
|
|
+ TestCaseText;
|
|
GetDataPtr(node)^.Data := FTestCaseTexts.Add(TestCaseText)+1;
|
|
|
|
i := 0;
|
|
if s.HasChild then begin
|
|
n:=nil;
|
|
s2 := s.Child;
|
|
while s2.IsValid do begin
|
|
n := AddNode(Node,n,s2);
|
|
s2.GoNext;
|
|
inc(i);
|
|
if (i and 255) = 0 then begin
|
|
StatusBar1.SimpleText := IntToHex(s2.Index,8) + ' / '+ IntToHex(s2.ScopeListPtr^.HighestKnown,8)+' // '+format('%2.1f',[s2.Index*100/s2.ScopeListPtr^.HighestKnown]);
|
|
Application.ProcessMessages;
|
|
if not FShowingUnit then break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
t := Format('At %4x Abr: %d Tag: %d %s ChildCnt: %d %s', [s.Entry-BaseScopeAddr, Abbrev, Def.tag, DwarfTagToString(Def.tag), i, entryname]);
|
|
nptr := GetDataPtr(Node);
|
|
nptr^.Text := t;
|
|
nptr^.Num:= s.Entry-BaseScopeAddr;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
s: TDwarfScopeInfo;
|
|
Node: PVirtualNode;
|
|
begin
|
|
FShowingUnit := not FShowingUnit;//////////////////
|
|
if not FShowingUnit then exit;/////////////////
|
|
VStringTree.BeginUpdate;
|
|
try
|
|
VStringTree.Clear;
|
|
i := CompUnitListBox.ItemIndex;
|
|
if i < 0 then exit;
|
|
CU := TDwarfCompilationUnitHack(CompUnitListBox.Items.Objects[i]);
|
|
if CU = nil then exit;
|
|
s := CU.FirstScope;
|
|
BaseScopeAddr := s.Entry;
|
|
|
|
Node := nil;
|
|
while s.IsValid do begin
|
|
Node := AddNode(nil,Node,s);
|
|
s.GoNext;
|
|
end;
|
|
finally
|
|
VStringTree.EndUpdate;
|
|
FShowingUnit := False; ////////////////////
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
FTestCaseTexts:= TStringList.Create;
|
|
FTestCaseTexts.Capacity := 5000;
|
|
NameList:= TNameMap.Create;
|
|
NameList.Capacity := 5000;
|
|
end;
|
|
|
|
procedure TForm1.FormDestroy(Sender: TObject);
|
|
begin
|
|
UnLoadDwarf;
|
|
FTestCaseTexts.Free;
|
|
end;
|
|
|
|
procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String
|
|
);
|
|
begin
|
|
if Length(FileNames) > 0 then
|
|
FileNameEdit1.Text := FileNames[0];
|
|
end;
|
|
|
|
procedure TForm1.VStringTreeDblClick(Sender: TObject);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TForm1.VStringTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
begin
|
|
PTreeNodeData(VStringTree.GetNodeData(Node))^.Text := '';
|
|
end;
|
|
|
|
procedure TForm1.VStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
|
|
var
|
|
nd: PTreeNodeData;
|
|
begin
|
|
nd := PTreeNodeData(VStringTree.GetNodeData(Node));
|
|
CellText := nd^.Text;
|
|
end;
|
|
|
|
procedure TForm1.VStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
|
|
var InitialStates: TVirtualNodeInitStates);
|
|
begin
|
|
Pointer(PTreeNodeData(VStringTree.GetNodeData(Node))^.Text) := nil;
|
|
end;
|
|
|
|
procedure TForm1.VStringTreeNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Column: TColumnIndex; const NewText: String);
|
|
begin
|
|
PTreeNodeData(VStringTree.GetNodeData(Node))^.Text := NewText;
|
|
end;
|
|
|
|
procedure TForm1.VStringTreeNodeDblClick(Sender: TBaseVirtualTree; const HitInfo: THitInfo);
|
|
var
|
|
n: PVirtualNode;
|
|
nptr, nptr2: PTreeNodeData;
|
|
begin
|
|
if HitInfo.HitNode = nil then exit;
|
|
nptr := GetDataPtr(HitInfo.HitNode);
|
|
if nptr^.Link = 0 then exit;
|
|
|
|
for n in VStringTree.Nodes do begin
|
|
nptr2 := GetDataPtr(n);
|
|
if nptr2^.Num = nptr^.Link then begin
|
|
GotoNode(n);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TForm1.GetDataPtr(n: PVirtualNode): PTreeNodeData;
|
|
begin
|
|
result := PTreeNodeData(VStringTree.GetNodeData(N));
|
|
end;
|
|
|
|
procedure TForm1.GotoNode(n: PVirtualNode);
|
|
begin
|
|
VStringTree.FocusedNode := n;
|
|
end;
|
|
|
|
constructor TForm1.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
VStringTree.NodeDataSize := sizeof(TTreeNodeData);
|
|
end;
|
|
|
|
procedure TForm1.UnLoadDwarf;
|
|
begin
|
|
FreeAndNil(FDwarfInfo);
|
|
FreeAndNil(FImageLoaderList);
|
|
FreeAndNil(FMemModel);
|
|
FCUCount := 0;
|
|
end;
|
|
|
|
end.
|
|
|