paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 14:29:25 +01:00
Code Issues Packages Projects Releases Wiki Activity
4785d293ae
lazarus/components/fpdebug/test/dwarfviewer/unit1.pas
martin 66beffb223 FpDebug: restructure dwarf classes, preparation for adding fpc specific subclasses 
git-svn-id: trunk@44594 -
2014-04-03 17:44:49 +00:00

757 lines
25 KiB
ObjectPascal
Raw Blame History

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
FpImgReaderWinPE, Classes, SysUtils, math, FileUtil, LazLogger, LazLoggerProfiling,
lazutf8sysutils, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst, FpPascalParser, FpDbgInfo,
FpDbgDwarfDataClasses, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, EditBtn,
Menus, Clipbrd, maps, types, strutils;
type
{ TForm1 }
TForm1 = class(TForm)
btnCopyAll: TButton;
btnLoad: TButton;
btnShowUnit: TButton;
btnCopyOne: TButton;
FileNameEdit1: TFileNameEdit;
CompUnitListBox: TListBox;
TreeView1: TTreeView;
procedure btnCopyAllClick(Sender: TObject);
procedure btnCopyOneClick(Sender: TObject);
procedure btnLoadClick(Sender: TObject);
procedure btnShowUnitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
NameList: TStringList;
FFileName: String;
FTestCaseTexts: TStringList;
FImageLoader: TDbgImageLoader;
FDwarfInfo: TDbgDwarf;
FCUCount : Integer;
public
{ public declarations }
procedure LoadDwarf;
procedure UnLoadDwarf;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.btnLoadClick(Sender: TObject);
var
i: Integer;
begin
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: TTreeNode;
i: PtrInt;
begin
n := TreeView1.Selected;
if n = nil then exit;
i := ptrint(n.Data)-1;
if i < 0 then exit;
debugln(['TForm1.MenuItem1Click ']);
Clipboard.AsText := FTestCaseTexts[i];
end;
procedure TForm1.btnCopyAllClick(Sender: TObject);
var
nm: TStringList;
vars: String;
procedure AddChildren(n: TTreeNode; var s: string; idnt: String);
var
i: PtrInt;
s2: String;
begin
n := n.GetFirstChild;
while n <> nil do begin
i := ptrint(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);
n := n.GetNextSibling;
end;
end;
var
s: String;
n: TTreeNode;
i: PtrInt;
i2: Integer;
begin
nm := TStringList.Create;
n := TreeView1.Selected;
if n = nil then exit;
i := ptrint(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.Names[i2], NameList.ValueFromIndex[i2]);
Clipboard.AsText := s;
nm.Free;
end;
procedure TForm1.LoadDwarf;
begin
UnLoadDwarf;
FImageLoader := TDbgImageLoader.Create(FFileName);
FDwarfInfo := TDbgDwarf.Create(FImageLoader);
FCUCount := FDwarfInfo.LoadCompilationUnits;
end;
type
TDwarfCompilationUnitHack = class(TDwarfCompilationUnit)
public
property FirstScope;
property AbbrevList;
end;
procedure TForm1.btnShowUnitClick(Sender: TObject);
var
CU: TDwarfCompilationUnitHack;
BaseScopeAddr: Pointer;
function ToHex(var p: pbyte; l : integer):String;
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
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
Result := Result + 'Unknown DW_OP_' + IntToStr(AData^);
end;
Inc(AData);
//Result := Result +' / ';
end;
end;
function AddAbbrev(AParent: TTreeNode; s: TDwarfScopeInfo; Def: TDwarfAbbrev;
var PascalTestCAseCode: 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: TTreeNode;
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, 4 {FCU.FAddressSize});
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.AddAddr(%s, %s, $%s);%s', [s1, s2, s3, LineEnding]);
end;
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_member_location) then
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.Add(%s, %s, BytesLenU([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
else
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.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_member_location) then
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.Add(%s, %s, BytesLen1([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
else
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.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_member_location) then
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.Add(%s, %s, BytesLen2([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
else
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.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_member_location) then
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.Add(%s, %s, BytesLen4([%s])); // %s%s', [s1, s2, DecodeLocation(p2, ValueSize), stest, LineEnding])
else
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.Add(%s, %s, [%s]);%s', [s1, s2, stest, LineEnding]);
end;
DW_FORM_sdata : begin
SValue := SLEB128toOrdinal(p);
s3 := IntToStr(SValue);
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.AddSLEB(%s, %s, %d);%s', [s1, s2, SValue, LineEnding]);
end;
DW_FORM_udata : begin
Value := ULEB128toOrdinal(p);
s3 := IntToStr(Value);
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PByte(p-1)^), stest, LineEnding]);
//Format('XX_X_CurInfo992X.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('XX_X_CurInfo992X.AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PWord(p-2)^), stest, LineEnding]);
//Format('XX_X_CurInfo992X.AddRef(%s, %s, FOO); // %s %s', [s1, s2, stest, LineEnding]);
end;
DW_FORM_ref4 : begin
stest := ToHexCommaList(p,4);
s4 := IntToHex(PInteger(p)^ -11, 8);;
s3 := ToHex(p, 4) + ' // '+ s4;
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PDWord(p-4)^), stest, LineEnding]);
//Format('XX_X_CurInfo992X.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('XX_X_CurInfo992X.AddRef(%s, %s, @Info__%s_); // %s %s', [s1, s2, IntToStr(PQWord(p-8)^), stest, LineEnding]);
//Format('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.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('XX_X_CurInfo992X.AddULEB(%s, %s, %u);%s', [s1, s2, Value, LineEnding]);
end;
else
s3 := '?????';
PascalTestCAseCode := PascalTestCAseCode +
Format('XX_X_CurInfo992X.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_member_location) then begin
stest := DecodeLocation(p2, ValueSize);
s3 := s3 + ' // ' +stest;
end;
addednode := TreeView1.Items.AddChild(AParent, Format(' -- Attr: %20s(%4x) Form: %18s(%4x) >> %s', [s1, Attribute, s2, Form, s3]));
end;
end;
function AddNode(AParent, Asibling: TTreeNode; s: TDwarfScopeInfo): TTreeNode;
var
p: Pointer;
Abbrev: QWord;
Node: TTreeNode;
s2: TDwarfScopeInfo;
n: TTreeNode;
i: Integer;
Def: TDwarfAbbrev;
entryname: String;
TestCaseText: String;
NMLIdx: Integer;
pre: String;
begin
p := s.Entry;
Abbrev := ULEB128toOrdinal(p);
p := s.Entry;
CU.GetDefinition(p, Def);
Node := TreeView1.Items.AddChild(AParent, Format('Abr: %d Tag: %d %s ', [Abbrev, Def.tag, DwarfTagToString(Def.tag)]));
entryname := AddAbbrev(Node, s, Def, TestCaseText);
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.Values['Info__'+IntToStr(s.Entry - BaseScopeAddr + 11)+'_']
:= pre+'_'+IntToStr(FTestCaseTexts.Count);
i := 0;
if s.HasChild then i := 1;
TestCaseText :=
Format('XX_X_CurInfo992X.Tag := %s;%s',
[DwarfTagToString(Def.tag), LineEnding])
+ Format('XX_X_CurInfo992X.Children := %d;%s', [i, LineEnding])
+ TestCaseText;
TestCaseText := AnsiReplaceStr(TestCaseText, 'XX_X_CurInfo992X.',
'Info__'+IntToStr(s.Entry - BaseScopeAddr + 11)+'_.'
//'Info'+IntToStr(FTestCaseTexts.Count+1)+entryname+'.'
);
node.Data := pointer(ptruint(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);
end;
end;
Node.Text := Format('At %4x Abr: %d Tag: %d %s ChildCnt: %d %s', [s.Entry-BaseScopeAddr, Abbrev, Def.tag, DwarfTagToString(Def.tag), i, entryname]);
end;
var
i: Integer;
s: TDwarfScopeInfo;
Node: TTreeNode;
rs: TDwarfScopeInfo;
begin
TreeView1.BeginUpdate;
try
TreeView1.Items.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;
CU.LocateEntry(0, rs);
Node := nil;
while s.IsValid do begin
Node := AddNode(nil,Node,s);
s.GoNext;
end;
finally
TreeView1.EndUpdate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FTestCaseTexts:= TStringList.Create;
NameList:= TStringList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnLoadDwarf;
FTestCaseTexts.Free;
end;
procedure TForm1.UnLoadDwarf;
begin
FreeAndNil(FDwarfInfo);
FreeAndNil(FImageLoader);
FCUCount := 0;
end;
end.
Reference in New Issue View Git Blame Copy Permalink