mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-29 01:11:07 +02:00
+ added exception dissection
+ added linenr address resolving + added setting of breakpoints git-svn-id: trunk@10166 -
This commit is contained in:
marc
parent
168e90b7ce
commit
90f62672f2
@ -36,7 +36,7 @@ unit FPWDCommand;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Windows, WinDExtra, LCLProc;
|
||||
SysUtils, Classes, Windows, WinDExtra, WinDebugger, LCLProc;
|
||||
|
||||
procedure HandleCommand(ACommand: String);
|
||||
|
||||
@ -181,8 +181,83 @@ begin
|
||||
end;
|
||||
|
||||
procedure HandleBreak(AParams: String);
|
||||
var
|
||||
S, P: String;
|
||||
Remove: Boolean;
|
||||
Address: TDbgPtr;
|
||||
e: Integer;
|
||||
Line: Cardinal;
|
||||
bp: TDbgBreakpoint;
|
||||
begin
|
||||
WriteLN('not implemented: break');
|
||||
S := AParams;
|
||||
P := GetPart([], [' ', #9], S);
|
||||
Remove := P = '-d';
|
||||
if not Remove
|
||||
then S := P;
|
||||
|
||||
if S = ''
|
||||
then begin
|
||||
// current addr
|
||||
P := '';
|
||||
{$ifdef cpui386}
|
||||
Address := GCurrentContext^.Eip;
|
||||
{$else}
|
||||
Address := GCurrentContext^.Rip;
|
||||
{$endif}
|
||||
end
|
||||
else begin
|
||||
P := GetPart([], [':'], S);
|
||||
end;
|
||||
|
||||
if S = ''
|
||||
then begin
|
||||
if P <> ''
|
||||
then begin
|
||||
// address given
|
||||
Val(P, Address, e);
|
||||
if e <> 0
|
||||
then begin
|
||||
WriteLN('Illegal address: ', P);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
if Remove
|
||||
then begin
|
||||
if GCurrentProcess.RemoveBreak(Address)
|
||||
then WriteLn('breakpoint removed')
|
||||
else WriteLn('remove breakpoint failed');
|
||||
end
|
||||
else begin
|
||||
if GCurrentProcess.AddBreak(Address) <> nil
|
||||
then WriteLn('breakpoint added')
|
||||
else WriteLn('add breakpoint failed');
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
S := GetPart([':'], [], S);
|
||||
Val(S, Line, e);
|
||||
if e <> 0
|
||||
then begin
|
||||
WriteLN('Illegal line: ', S);
|
||||
Exit;
|
||||
end;
|
||||
if Remove
|
||||
then begin
|
||||
if TDbgInstance(GCurrentProcess).RemoveBreak(P, Line)
|
||||
then WriteLn('breakpoint removed')
|
||||
else WriteLn('remove breakpoint failed');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
bp := TDbgInstance(GCurrentProcess).AddBreak(P, Line);
|
||||
if bp = nil
|
||||
then begin
|
||||
WriteLn('add breakpoint failed');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
WriteLn('breakpoint added at: ', FormatAddress(bp.Location));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure HandleContinue(AParams: String);
|
||||
@ -235,7 +310,7 @@ procedure HandleMemory(AParams: String);
|
||||
var
|
||||
P: array[1..3] of String;
|
||||
Size, Count: Integer;
|
||||
Adress: QWord;
|
||||
Address: QWord;
|
||||
e, idx: Integer;
|
||||
buf: array[0..256*16 - 1] of Byte;
|
||||
BytesRead: Cardinal;
|
||||
@ -255,9 +330,9 @@ begin
|
||||
Size := 4;
|
||||
|
||||
{$ifdef cpui386}
|
||||
Adress := GCurrentContext^.Eip;
|
||||
Address := GCurrentContext^.Eip;
|
||||
{$else}
|
||||
Adress := GCurrentContext^.Rip;
|
||||
Address := GCurrentContext^.Rip;
|
||||
{$endif}
|
||||
|
||||
if P[idx] <> ''
|
||||
@ -279,7 +354,7 @@ begin
|
||||
|
||||
end
|
||||
else begin
|
||||
Val(P[idx], Adress, e);
|
||||
Val(P[idx], Address, e);
|
||||
if e <> 0
|
||||
then begin
|
||||
WriteLN('Location "',P[idx],'": Symbol resolving not implemented');
|
||||
@ -303,9 +378,9 @@ begin
|
||||
|
||||
|
||||
BytesRead := Count * Size;
|
||||
if not GMainProcess.ReadData(Adress, BytesRead, buf)
|
||||
if not GMainProcess.ReadData(Address, BytesRead, buf)
|
||||
then begin
|
||||
WriteLN('Could not read memory at: ', FormatAddress(Adress));
|
||||
WriteLN('Could not read memory at: ', FormatAddress(Address));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
@ -313,7 +388,7 @@ begin
|
||||
while BytesRead >= size do
|
||||
begin
|
||||
if e and ((32 div Size) - 1) = 0
|
||||
then Write('[', FormatAddress(Adress), '] ');
|
||||
then Write('[', FormatAddress(Address), '] ');
|
||||
|
||||
for idx := Size - 1 downto 0 do Write(IntToHex(buf[e * size + idx], 2));
|
||||
|
||||
@ -322,7 +397,7 @@ begin
|
||||
then WriteLn
|
||||
else Write(' ');
|
||||
Dec(BytesRead, Size);
|
||||
Inc(Adress, Size);
|
||||
Inc(Address, Size);
|
||||
end;
|
||||
if e <> 32 div Size
|
||||
then WriteLn;
|
||||
@ -596,7 +671,7 @@ begin
|
||||
MCommands.AddCommand(['show', 's'], @HandleShow, 'show <info>: Enter show help for more info');
|
||||
MCommands.AddCommand(['set'], @HandleSet, 'set param: Enter set help for more info');
|
||||
MCommands.AddCommand(['run', 'r'], @HandleRun, 'run: Starts the loaded debuggee');
|
||||
MCommands.AddCommand(['break', 'b'], @HandleBreak, 'break [-d] <adress>: Set a breakpoint at <adress>. -d removes');
|
||||
MCommands.AddCommand(['break', 'b'], @HandleBreak, 'break [-d] <adress>|<filename:line>: Set a breakpoint at <adress> or <filename:line>. -d removes');
|
||||
MCommands.AddCommand(['continue', 'cont', 'c'], @HandleContinue, 'continue: Continues execution');
|
||||
MCommands.AddCommand(['kill', 'k'], @HandleKill, 'kill: Stops execution of the debuggee');
|
||||
MCommands.AddCommand(['next', 'n'], @HandleNext, 'next: Steps one instruction');
|
||||
|
||||
@ -42,6 +42,9 @@ type
|
||||
TMWDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent);
|
||||
TMWDMode = (dm32, dm64);
|
||||
TMWDImageInfo = (iiNone, iiName, iiDetail);
|
||||
|
||||
const
|
||||
DBGPTRSIZE: array[TMWDMode] of Integer = (4, 8);
|
||||
|
||||
var
|
||||
GState: TMWDState;
|
||||
@ -75,10 +78,8 @@ begin
|
||||
end;
|
||||
|
||||
function FormatAddress(const AAddress): String;
|
||||
const
|
||||
SIZE: array[TMWDMode] of Integer = (4, 8);
|
||||
begin
|
||||
Result := HexValue(AAddress, SIZE[GMode], [hvfIncludeHexchar]);
|
||||
Result := HexValue(AAddress, DBGPTRSIZE[GMode], [hvfIncludeHexchar]);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -45,7 +45,7 @@ procedure DebugLoop;
|
||||
implementation
|
||||
|
||||
uses
|
||||
FPWDGlobal, FPWDPEImage;
|
||||
FPWDGlobal, FPWDPEImage, FPWDType;
|
||||
|
||||
var
|
||||
MDebugEvent: TDebugEvent;
|
||||
@ -90,11 +90,14 @@ var
|
||||
Info1: QWORD;
|
||||
Info1Str: String;
|
||||
P: PByte;
|
||||
ExInfo32: TExceptionDebugInfo32 absolute AEvent.Exception;
|
||||
ExInfo64: TExceptionDebugInfo64 absolute AEvent.Exception;
|
||||
begin
|
||||
if AEvent.Exception.dwFirstChance = 0
|
||||
then Write('Exception: ')
|
||||
else Write('First chance exception: ');
|
||||
|
||||
// in both 32 and 64 case is the exceptioncode the first, so no difference
|
||||
case AEvent.Exception.ExceptionRecord.ExceptionCode of
|
||||
EXCEPTION_ACCESS_VIOLATION : Write('ACCESS_VIOLATION');
|
||||
EXCEPTION_ARRAY_BOUNDS_EXCEEDED : Write('ARRAY_BOUNDS_EXCEEDED');
|
||||
@ -112,50 +115,109 @@ begin
|
||||
EXCEPTION_INT_DIVIDE_BY_ZERO : Write('INT_DIVIDE_BY_ZERO');
|
||||
EXCEPTION_INT_OVERFLOW : Write('INT_OVERFLOW');
|
||||
EXCEPTION_INVALID_DISPOSITION : Write('INVALID_DISPOSITION');
|
||||
EXCEPTION_INVALID_HANDLE : Write('EXCEPTION_INVALID_HANDLE');
|
||||
EXCEPTION_NONCONTINUABLE_EXCEPTION : Write('NONCONTINUABLE_EXCEPTION');
|
||||
EXCEPTION_POSSIBLE_DEADLOCK : Write('EXCEPTION_POSSIBLE_DEADLOCK');
|
||||
EXCEPTION_PRIV_INSTRUCTION : Write('PRIV_INSTRUCTION');
|
||||
EXCEPTION_SINGLE_STEP : Write('SINGLE_STEP');
|
||||
EXCEPTION_STACK_OVERFLOW : Write('STACK_OVERFLOW');
|
||||
|
||||
// add some status - don't know if we can get them here
|
||||
DBG_EXCEPTION_NOT_HANDLED : Write('DBG_EXCEPTION_NOT_HANDLED');
|
||||
STATUS_GUARD_PAGE_VIOLATION : Write('STATUS_GUARD_PAGE_VIOLATION');
|
||||
STATUS_NO_MEMORY : Write('STATUS_NO_MEMORY');
|
||||
STATUS_CONTROL_C_EXIT : Write('STATUS_CONTROL_C_EXIT');
|
||||
STATUS_FLOAT_MULTIPLE_FAULTS : Write('STATUS_FLOAT_MULTIPLE_FAULTS');
|
||||
STATUS_FLOAT_MULTIPLE_TRAPS : Write('STATUS_FLOAT_MULTIPLE_TRAPS');
|
||||
STATUS_REG_NAT_CONSUMPTION : Write('STATUS_REG_NAT_CONSUMPTION');
|
||||
STATUS_SXS_EARLY_DEACTIVATION : Write('STATUS_SXS_EARLY_DEACTIVATION');
|
||||
STATUS_SXS_INVALID_DEACTIVATION : Write('STATUS_SXS_INVALID_DEACTIVATION');
|
||||
else
|
||||
Write(' Unknown code: ', AEvent.Exception.ExceptionRecord.ExceptionCode);
|
||||
Write(' Unknown code: $', IntToHex(ExInfo32.ExceptionRecord.ExceptionCode, 8));
|
||||
Write(' [');
|
||||
case ExInfo32.ExceptionRecord.ExceptionCode and $C0000000 of
|
||||
STATUS_SEVERITY_SUCCESS : Write('SEVERITY_ERROR');
|
||||
STATUS_SEVERITY_INFORMATIONAL : Write('SEVERITY_ERROR');
|
||||
STATUS_SEVERITY_WARNING : Write('SEVERITY_WARNING');
|
||||
STATUS_SEVERITY_ERROR : Write('SEVERITY_ERROR');
|
||||
end;
|
||||
if ExInfo32.ExceptionRecord.ExceptionCode and $20000000 <> 0
|
||||
then Write (' Customer');
|
||||
if ExInfo32.ExceptionRecord.ExceptionCode and $10000000 <> 0
|
||||
then Write (' Reserved');
|
||||
case (ExInfo32.ExceptionRecord.ExceptionCode and $0FFF0000) shr 16 of
|
||||
FACILITY_DEBUGGER : Write('FACILITY_DEBUGGER');
|
||||
FACILITY_RPC_RUNTIME : Write('FACILITY_RPC_RUNTIME');
|
||||
FACILITY_RPC_STUBS : Write('FACILITY_RPC_STUBS');
|
||||
FACILITY_IO_ERROR_CODE : Write('FACILITY_IO_ERROR_CODE');
|
||||
FACILITY_TERMINAL_SERVER : Write('FACILITY_TERMINAL_SERVER');
|
||||
FACILITY_USB_ERROR_CODE : Write('FACILITY_USB_ERROR_CODE');
|
||||
FACILITY_HID_ERROR_CODE : Write('FACILITY_HID_ERROR_CODE');
|
||||
FACILITY_FIREWIRE_ERROR_CODE : Write('FACILITY_FIREWIRE_ERROR_CODE');
|
||||
FACILITY_CLUSTER_ERROR_CODE : Write('FACILITY_CLUSTER_ERROR_CODE');
|
||||
FACILITY_ACPI_ERROR_CODE : Write('FACILITY_ACPI_ERROR_CODE');
|
||||
FACILITY_SXS_ERROR_CODE : Write('FACILITY_SXS_ERROR_CODE');
|
||||
else
|
||||
Write(' Facility: $', IntToHex((ExInfo32.ExceptionRecord.ExceptionCode and $0FFF0000) shr 16, 3));
|
||||
end;
|
||||
Write(' Code: $', IntToHex((ExInfo32.ExceptionRecord.ExceptionCode and $0000FFFF), 4));
|
||||
|
||||
end;
|
||||
Info0 := PtrUInt(AEvent.Exception.ExceptionRecord.ExceptionAddress);
|
||||
if GMode = dm32
|
||||
then Info0 := PtrUInt(ExInfo32.ExceptionRecord.ExceptionAddress)
|
||||
else Info0 := PtrUInt(ExInfo64.ExceptionRecord.ExceptionAddress);
|
||||
Write(' at: ', FormatAddress(Info0));
|
||||
Write(' Flags:', Format('%x', [AEvent.Exception.ExceptionRecord.ExceptionFlags]), ' [');
|
||||
|
||||
if AEvent.Exception.ExceptionRecord.ExceptionFlags = 0
|
||||
then Write('Continuable')
|
||||
else Write('Not continuable');
|
||||
Write(']');
|
||||
Write(' ParamCount:', AEvent.Exception.ExceptionRecord.NumberParameters);
|
||||
if GMode = dm32
|
||||
then Write(' ParamCount:', ExInfo32.ExceptionRecord.NumberParameters)
|
||||
else Write(' ParamCount:', ExInfo64.ExceptionRecord.NumberParameters);
|
||||
|
||||
case AEvent.Exception.ExceptionRecord.ExceptionCode of
|
||||
EXCEPTION_ACCESS_VIOLATION: begin
|
||||
Info0 := AEvent.Exception.ExceptionRecord.ExceptionInformation[0];
|
||||
Info1Str := FormatAddress(AEvent.Exception.ExceptionRecord.ExceptionInformation[1]);
|
||||
if GMode = dm32
|
||||
then begin
|
||||
Info0 := ExInfo32.ExceptionRecord.ExceptionInformation[0];
|
||||
Info1 := ExInfo32.ExceptionRecord.ExceptionInformation[1];
|
||||
end
|
||||
else begin
|
||||
Info0 := ExInfo64.ExceptionRecord.ExceptionInformation[0];
|
||||
Info1 := ExInfo64.ExceptionRecord.ExceptionInformation[1];
|
||||
end;
|
||||
Info1Str := FormatAddress(Info1);
|
||||
|
||||
case Info0 of
|
||||
0: begin
|
||||
EXCEPTION_READ_FAULT: begin
|
||||
Write(' Read of address: ', Info1Str);
|
||||
end;
|
||||
1: begin
|
||||
EXCEPTION_WRITE_FAULT: begin
|
||||
Write(' Write of address: ', Info1Str);
|
||||
end;
|
||||
EXCEPTION_EXECUTE_FAULT: begin
|
||||
Write(' Execute of address: ', Info1Str);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
WriteLN;
|
||||
|
||||
Write(' Info: ');
|
||||
with AEvent.Exception.ExceptionRecord do
|
||||
for n := Low(ExceptionInformation) to high(ExceptionInformation) do
|
||||
begin
|
||||
Write(IntToHex(ExceptionInformation[n], SizeOf(Pointer) * 2), ' ');
|
||||
if n and (PARAMCOLS - 1) = (PARAMCOLS - 1)
|
||||
then begin
|
||||
WriteLN;
|
||||
Write(' ');
|
||||
end;
|
||||
for n := 0 to EXCEPTION_MAXIMUM_PARAMETERS - 1 do
|
||||
begin
|
||||
if GMode = dm32
|
||||
then Info0 := ExInfo32.ExceptionRecord.ExceptionInformation[n]
|
||||
else Info0 := ExInfo64.ExceptionRecord.ExceptionInformation[n];
|
||||
Write(IntToHex(Info0, DBGPTRSIZE[GMode] * 2), ' ');
|
||||
if n and (PARAMCOLS - 1) = (PARAMCOLS - 1)
|
||||
then begin
|
||||
WriteLN;
|
||||
Write(' ');
|
||||
end;
|
||||
end;
|
||||
WriteLn;
|
||||
GState := dsPause;
|
||||
end;
|
||||
|
||||
@ -31,19 +31,46 @@ unit FPWDType;
|
||||
{$mode objfpc}{$H+}
|
||||
{$ALIGN ON}
|
||||
|
||||
// Additional 64bit types
|
||||
// Additional bit types, not all in RTL
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows;
|
||||
|
||||
const
|
||||
FACILITY_DEBUGGER = $001;
|
||||
FACILITY_RPC_RUNTIME = $002;
|
||||
FACILITY_RPC_STUBS = $003;
|
||||
FACILITY_IO_ERROR_CODE = $004;
|
||||
FACILITY_TERMINAL_SERVER = $00A;
|
||||
FACILITY_USB_ERROR_CODE = $010;
|
||||
FACILITY_HID_ERROR_CODE = $011;
|
||||
FACILITY_FIREWIRE_ERROR_CODE = $012;
|
||||
FACILITY_CLUSTER_ERROR_CODE = $013;
|
||||
FACILITY_ACPI_ERROR_CODE = $014;
|
||||
FACILITY_SXS_ERROR_CODE = $015;
|
||||
|
||||
STATUS_SEVERITY_SUCCESS = $0;
|
||||
STATUS_SEVERITY_INFORMATIONAL = $1;
|
||||
STATUS_SEVERITY_WARNING = $2;
|
||||
STATUS_SEVERITY_ERROR = $3;
|
||||
|
||||
STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4;
|
||||
STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5;
|
||||
STATUS_REG_NAT_CONSUMPTION = $C00002C9;
|
||||
STATUS_SXS_EARLY_DEACTIVATION = $C015000F;
|
||||
STATUS_SXS_INVALID_DEACTIVATION = $C0150010;
|
||||
|
||||
|
||||
//type
|
||||
// DWORD64 = QWORD;
|
||||
// ULONGLONG = QWORD;
|
||||
// LONGLONG = int64;
|
||||
//QWORD = type cardinal;
|
||||
|
||||
{.$if declared(THREAD_SUSPEND_RESUME)}
|
||||
{.$else}
|
||||
const
|
||||
THREAD_TERMINATE = $0001;
|
||||
THREAD_SUSPEND_RESUME = $0002;
|
||||
@ -56,22 +83,66 @@ const
|
||||
THREAD_DIRECT_IMPERSONATION = $0200;
|
||||
|
||||
THREAD_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3FF;
|
||||
{.$endif}
|
||||
|
||||
{$if declared(EXCEPTION_READ_FAULT)}
|
||||
{$else}
|
||||
const
|
||||
EXCEPTION_READ_FAULT = 0; // Access violation was caused by a read
|
||||
EXCEPTION_WRITE_FAULT = 1; // Access violation was caused by a write
|
||||
EXCEPTION_EXECUTE_FAULT = 8; // Access violation was caused by an instruction fetch
|
||||
{$endif}
|
||||
|
||||
{$if declared(TExceptionRecord32)}
|
||||
{$else}
|
||||
type
|
||||
PExceptionRecord64 = QWORD;
|
||||
// PExceptionRecord64 = ^_EXCEPTION_RECORD64;
|
||||
_EXCEPTION_RECORD64 = record
|
||||
TExceptionRecord32 = record
|
||||
ExceptionCode : DWORD;
|
||||
ExceptionFlags : DWORD;
|
||||
ExceptionRecord : DWORD;
|
||||
ExceptionAddress : DWORD;
|
||||
NumberParameters : DWORD;
|
||||
ExceptionInformation : array[0..(EXCEPTION_MAXIMUM_PARAMETERS)-1] of DWORD;
|
||||
end;
|
||||
PExceptionRecord32 = ^TExceptionRecord32;
|
||||
{$endif}
|
||||
|
||||
{$if declared(TExceptionDebugInfo32)}
|
||||
{$else}
|
||||
type
|
||||
TExceptionDebugInfo32 = record
|
||||
ExceptionRecord : TExceptionRecord32;
|
||||
dwFirstChance : DWORD;
|
||||
end;
|
||||
PExceptionDebugInfo32 = ^TExceptionDebugInfo32;
|
||||
{$endif}
|
||||
|
||||
{$if declared(TExceptionRecord64)}
|
||||
{$else}
|
||||
type
|
||||
TExceptionRecord64 = record
|
||||
ExceptionCode: DWORD;
|
||||
ExceptionFlags: DWORD;
|
||||
ExceptionRecord: PExceptionRecord64;
|
||||
ExceptionAddress: QWORD;
|
||||
ExceptionRecord: DWORD64;
|
||||
ExceptionAddress: DWORD64;
|
||||
NumberParameters: DWORD;
|
||||
__unusedAlignment: DWORD;
|
||||
ExceptionInformation: array[0..EXCEPTION_MAXIMUM_PARAMETERS - 1] of QWORD;
|
||||
ExceptionInformation: array[0..EXCEPTION_MAXIMUM_PARAMETERS - 1] of DWORD64;
|
||||
end;
|
||||
TExceptionRecord64 = _EXCEPTION_RECORD64;
|
||||
EXCEPTION_RECORD64 = _EXCEPTION_RECORD64;
|
||||
PExceptionRecord64 = ^TExceptionRecord64;
|
||||
{$endif}
|
||||
|
||||
{$if declared(TExceptionDebugInfo64)}
|
||||
{$else}
|
||||
type
|
||||
TExceptionDebugInfo64 = record
|
||||
ExceptionRecord : TExceptionRecord64;
|
||||
dwFirstChance : DWORD;
|
||||
end;
|
||||
PExceptionDebugInfo64 = ^TExceptionDebugInfo64;
|
||||
{$endif}
|
||||
|
||||
|
||||
|
||||
(*
|
||||
PContext64 = QWORD;
|
||||
|
||||
@ -244,14 +244,17 @@ type
|
||||
StateMachines: TFPObjectList; // list of state machines to be freed
|
||||
end;
|
||||
|
||||
FLineNumberMap: TStringList;
|
||||
|
||||
FAddressMap: TMap;
|
||||
FAddressMapBuild: Boolean;
|
||||
|
||||
FMinPC: QWord; // the min and max PC value found in this unit.
|
||||
FMaxPC: QWord; //
|
||||
FScope: TDwarfScopeInfo;
|
||||
|
||||
procedure BuildAddessMap(AScope: TDwarfScopeInfo);
|
||||
procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo);
|
||||
procedure BuildAddressMap;
|
||||
procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean);
|
||||
function MakeAddress(AData: Pointer): QWord;
|
||||
procedure LoadAbbrevs(ANeeded: Cardinal);
|
||||
protected
|
||||
@ -269,6 +272,7 @@ type
|
||||
constructor Create(AOwner: TDbgDwarf; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean); virtual;
|
||||
destructor Destroy; override;
|
||||
function GetDefinition(AAbbrev: Cardinal; out ADefinition: TDwarfAbbrev): Boolean;
|
||||
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
property FileName: String read FFileName;
|
||||
property Valid: Boolean read FValid;
|
||||
end;
|
||||
@ -368,6 +372,7 @@ type
|
||||
constructor Create(ALoader: TDbgImageLoader); override;
|
||||
destructor Destroy; override;
|
||||
function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; override;
|
||||
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override;
|
||||
function LoadCompilationUnits: Integer;
|
||||
function PointerFromRVA(ARVA: QWord): Pointer;
|
||||
function PointerFromVA(ASection: TDwarfSection; AVA: QWord): Pointer;
|
||||
@ -812,7 +817,7 @@ begin
|
||||
|
||||
if FAddressInfo^.StateMachine = nil
|
||||
then begin
|
||||
FCU.BuildLineInfo(FAddressInfo);
|
||||
FCU.BuildLineInfo(FAddressInfo, False);
|
||||
if FAddressInfo^.StateMachine = nil then Exit;
|
||||
end;
|
||||
|
||||
@ -894,7 +899,7 @@ begin
|
||||
if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC))
|
||||
then Continue;
|
||||
|
||||
CU.BuildAddessMap(CU.FScope);
|
||||
CU.BuildAddressMap;
|
||||
|
||||
Iter := TMapIterator.Create(CU.FAddressMap);
|
||||
try
|
||||
@ -944,6 +949,20 @@ begin
|
||||
Result := TDwarfCompilationUnit;
|
||||
end;
|
||||
|
||||
function TDbgDwarf.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
var
|
||||
n: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
begin
|
||||
for n := 0 to FCompilationUnits.Count - 1 do
|
||||
begin
|
||||
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
|
||||
Result := CU.GetLineAddress(AFileName, ALine);
|
||||
if Result <> 0 then Exit;
|
||||
end;
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgDwarf.LoadCompilationUnits: Integer;
|
||||
var
|
||||
p: Pointer;
|
||||
@ -1073,7 +1092,6 @@ var
|
||||
pb: PByte absolute FLineInfoPtr;
|
||||
p: Pointer;
|
||||
Opcode: Byte;
|
||||
FileNr: Integer;
|
||||
instrlen: Cardinal;
|
||||
diridx: Cardinal;
|
||||
begin
|
||||
@ -1220,29 +1238,79 @@ end;
|
||||
|
||||
{ TDwarfCompilationUnit }
|
||||
|
||||
procedure TDwarfCompilationUnit.BuildAddessMap(AScope: TDwarfScopeInfo);
|
||||
procedure TDwarfCompilationUnit.BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean);
|
||||
var
|
||||
Iter: TMapIterator;
|
||||
Info: PDwarfAddressInfo;
|
||||
SM: TDwarfLineInfoStateMachine absolute FLineInfo.StateMachine;
|
||||
idx: Integer;
|
||||
LineMap: TMap;
|
||||
begin
|
||||
if not ADoAll
|
||||
then begin
|
||||
if AAddressInfo = nil then Exit;
|
||||
if AAddressInfo^.StateMachine <> nil then Exit;
|
||||
end;
|
||||
if SM.Ended then Exit;
|
||||
|
||||
Iter := TMapIterator.Create(FAddressMap);
|
||||
|
||||
while SM.NextLine do
|
||||
begin
|
||||
idx := FLineNumberMap.IndexOf(SM.FileName);
|
||||
if idx = -1
|
||||
then begin
|
||||
LineMap := TMap.Create(itu4, SizeOf(SM.Address));
|
||||
FLineNumberMap.AddObject(SM.FileName, LineMap);
|
||||
end
|
||||
else begin
|
||||
LineMap := TMap(FLineNumberMap.Objects[idx]);
|
||||
end;
|
||||
if not LineMap.HasId(SM.Line)
|
||||
then LineMap.Add(SM.Line, SM.Address);
|
||||
|
||||
if Iter.Locate(SM.Address)
|
||||
then begin
|
||||
// set lineinfo
|
||||
Info := Iter.DataPtr;
|
||||
if Info^.StateMachine = nil
|
||||
then begin
|
||||
Info^.StateMachine := SM.Clone;
|
||||
FLineInfo.StateMachines.Add(Info^.StateMachine);
|
||||
end;
|
||||
if not ADoAll and (Info = AAddressInfo)
|
||||
then Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
Iter.Free;
|
||||
end;
|
||||
|
||||
procedure TDwarfCompilationUnit.BuildAddressMap;
|
||||
var
|
||||
AttribList: TPointerDynArray;
|
||||
Attrib: Pointer;
|
||||
Form: Cardinal;
|
||||
Info: TDwarfAddressInfo;
|
||||
Scope: TDwarfScopeInfo;
|
||||
Scope, ResultScope: TDwarfScopeInfo;
|
||||
begin
|
||||
if FAddressMapBuild then Exit;
|
||||
while AScope <> nil do
|
||||
|
||||
Scope := FScope;
|
||||
while Scope <> nil do
|
||||
begin
|
||||
if LocateEntry(DW_TAG_subprogram, AScope, [lefCreateAttribList, lefContinuable, lefSearchChild], Scope, AttribList)
|
||||
if LocateEntry(DW_TAG_subprogram, Scope, [lefCreateAttribList, lefContinuable, lefSearchChild], ResultScope, AttribList)
|
||||
then begin
|
||||
Info.Scope := Scope;
|
||||
if LocateAttribute(Scope.Entry, DW_AT_low_pc, AttribList, Attrib, Form)
|
||||
Info.Scope := ResultScope;
|
||||
if LocateAttribute(ResultScope.Entry, DW_AT_low_pc, AttribList, Attrib, Form)
|
||||
then begin
|
||||
ReadValue(Attrib, Form, Info.StartPC);
|
||||
|
||||
if LocateAttribute(Scope.Entry, DW_AT_high_pc, AttribList, Attrib, Form)
|
||||
if LocateAttribute(ResultScope.Entry, DW_AT_high_pc, AttribList, Attrib, Form)
|
||||
then ReadValue(Attrib, Form, Info.EndPC)
|
||||
else Info.EndPC := Info.StartPC;
|
||||
|
||||
if LocateAttribute(Scope.Entry, DW_AT_name, AttribList, Attrib, Form)
|
||||
if LocateAttribute(ResultScope.Entry, DW_AT_name, AttribList, Attrib, Form)
|
||||
then ReadValue(Attrib, Form, Info.Name)
|
||||
else Info.Name := 'undefined';
|
||||
|
||||
@ -1256,51 +1324,18 @@ begin
|
||||
end;
|
||||
|
||||
// TAG found, try continue with the found scope
|
||||
AScope := Scope.Child;
|
||||
if AScope <> nil then Continue;
|
||||
end
|
||||
else begin
|
||||
Scope := AScope;
|
||||
Scope := ResultScope.Child;
|
||||
if Scope <> nil then Continue;
|
||||
Scope := ResultScope;
|
||||
end;
|
||||
|
||||
while (Scope.Next = nil) and (Scope.Parent <> nil) do Scope := Scope.Parent;
|
||||
AScope := Scope.Next;
|
||||
Scope := Scope.Next;
|
||||
end;
|
||||
|
||||
|
||||
FAddressMapBuild := True;
|
||||
end;
|
||||
|
||||
procedure TDwarfCompilationUnit.BuildLineInfo(AAddressInfo: PDwarfAddressInfo);
|
||||
var
|
||||
Iter: TMapIterator;
|
||||
Info: PDwarfAddressInfo;
|
||||
SM: TDwarfLineInfoStateMachine absolute FLineInfo.StateMachine;
|
||||
begin
|
||||
if AAddressInfo = nil then Exit;
|
||||
if AAddressInfo^.StateMachine <> nil then Exit;
|
||||
if SM.Ended then Exit;
|
||||
|
||||
Iter := TMapIterator.Create(FAddressMap);
|
||||
|
||||
while SM.NextLine do
|
||||
begin
|
||||
if Iter.Locate(SM.Address)
|
||||
then begin
|
||||
// set lineinfo
|
||||
Info := Iter.DataPtr;
|
||||
if Info^.StateMachine = nil
|
||||
then begin
|
||||
Info^.StateMachine := SM.Clone;
|
||||
FLineInfo.StateMachines.Add(Info^.StateMachine);
|
||||
end;
|
||||
if Info = AAddressInfo
|
||||
then Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
Iter.Free;
|
||||
end;
|
||||
|
||||
constructor TDwarfCompilationUnit.Create(AOwner: TDbgDwarf; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean);
|
||||
procedure FillLineInfo(AData: Pointer);
|
||||
var
|
||||
@ -1419,6 +1454,10 @@ begin
|
||||
|
||||
// use internally 64 bit target pointer
|
||||
FAddressMap := TMap.Create(itu8, SizeOf(TDwarfAddressInfo));
|
||||
FLineNumberMap := TStringList.Create;
|
||||
FLineNumberMap.Sorted := True;
|
||||
FLineNumberMap.Duplicates := dupError;
|
||||
|
||||
|
||||
FScope := TDwarfScopeInfo.Create(FInfoData);
|
||||
// retrieve some info about this unit
|
||||
@ -1435,7 +1474,7 @@ begin
|
||||
if not LocateAttribute(Scope.Entry, DW_AT_identifier_case, AttribList, Attrib, Form)
|
||||
and not ReadValue(Attrib, Form, FIdentifierCase)
|
||||
then FIdentifierCase := DW_ID_case_sensitive;
|
||||
|
||||
|
||||
if LocateAttribute(Scope.Entry, DW_AT_stmt_list, AttribList, Attrib, Form)
|
||||
and ReadValue(Attrib, Form, StatementListOffs)
|
||||
then begin
|
||||
@ -1462,8 +1501,6 @@ begin
|
||||
|
||||
if FMinPC = 0 then FMinPC := FMaxPC;
|
||||
if FMaxPC = 0 then FMAxPC := FMinPC;
|
||||
|
||||
// BuildAddessMap(Scope.Child);
|
||||
end;
|
||||
|
||||
destructor TDwarfCompilationUnit.Destroy;
|
||||
@ -1484,11 +1521,21 @@ destructor TDwarfCompilationUnit.Destroy;
|
||||
end;
|
||||
FScope := nil;
|
||||
end;
|
||||
|
||||
procedure FreeLineNumberMap;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
for n := 0 to FLineNumberMap.Count - 1 do
|
||||
FLineNumberMap.Objects[n].Free;
|
||||
FreeAndNil(FLineNumberMap);
|
||||
end;
|
||||
|
||||
begin
|
||||
FreeScope;
|
||||
FreeAndNil(FMap);
|
||||
FreeAndNil(FAddressMap);
|
||||
FreeLineNumberMap;
|
||||
FreeAndNil(FLineInfo.StateMachines);
|
||||
FreeAndNil(FLineInfo.StateMachine);
|
||||
FreeAndNil(FLineInfo.Directories);
|
||||
@ -1503,6 +1550,43 @@ begin
|
||||
Result := FMap.GetData(AAbbrev, ADefinition);
|
||||
end;
|
||||
|
||||
function TDwarfCompilationUnit.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
function FindIndex: Integer;
|
||||
var
|
||||
Name: String;
|
||||
begin
|
||||
// try fullname first
|
||||
Result := FLineNumberMap.IndexOf(AFileName);
|
||||
if Result <> -1 then Exit;
|
||||
|
||||
Name := ExtractFileName(AFileName);
|
||||
Result := FLineNumberMap.IndexOf(Name);
|
||||
if Result <> -1 then Exit;
|
||||
|
||||
Name := UpperCase(Name);
|
||||
for Result := 0 to FLineNumberMap.Count - 1 do
|
||||
begin
|
||||
if Name = UpperCase(ExtractFileName(FLineNumberMap[Result]))
|
||||
then Exit;
|
||||
end;
|
||||
Result := -1
|
||||
end;
|
||||
var
|
||||
idx: Integer;
|
||||
Map: TMap;
|
||||
begin
|
||||
Result := 0;
|
||||
if not Valid then Exit;
|
||||
|
||||
// make sure all filenames are there
|
||||
BuildLineInfo(nil, True);
|
||||
idx := FindIndex;
|
||||
if idx = -1 then Exit;
|
||||
|
||||
Map := TMap(FLineNumberMap.Objects[idx]);
|
||||
Map.GetData(ALine, Result);
|
||||
end;
|
||||
|
||||
procedure TDwarfCompilationUnit.LoadAbbrevs(ANeeded: Cardinal);
|
||||
procedure MakeRoom(AMinSize: Integer);
|
||||
var
|
||||
|
||||
@ -137,6 +137,8 @@ type
|
||||
end;
|
||||
|
||||
|
||||
{ TDbgInfo }
|
||||
|
||||
TDbgInfo = class(TObject)
|
||||
private
|
||||
FHasInfo: Boolean;
|
||||
@ -147,6 +149,7 @@ type
|
||||
function FindSymbol(const AName: String): TDbgSymbol; virtual;
|
||||
function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; virtual;
|
||||
property HasInfo: Boolean read FHasInfo;
|
||||
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; virtual;
|
||||
end;
|
||||
|
||||
|
||||
@ -164,6 +167,7 @@ type
|
||||
constructor Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr);
|
||||
destructor Destroy; override;
|
||||
function Hit(const AThreadID: Integer): Boolean;
|
||||
property Location: TDbgPtr read FLocation;
|
||||
end;
|
||||
|
||||
|
||||
@ -185,6 +189,12 @@ type
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean);
|
||||
destructor Destroy; override;
|
||||
|
||||
function AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint;
|
||||
function AddrOffset: Int64; // gives the offset between the loaded addresses and the compiled addresses
|
||||
function FindSymbol(AAdress: TDbgPtr): TDbgSymbol;
|
||||
function RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean;
|
||||
|
||||
property Process: TDbgProcess read FProcess;
|
||||
property ModuleHandle: THandle read FModuleHandle;
|
||||
property BaseAddr: TDbgPtr read FBaseAddr;
|
||||
@ -234,7 +244,7 @@ type
|
||||
procedure Interrupt;
|
||||
procedure ContinueDebugEvent(const AThread: TDbgThread; const ADebugEvent: TDebugEvent);
|
||||
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
|
||||
function RemoveBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
|
||||
function RemoveBreak(const ALocation: TDbgPtr): Boolean;
|
||||
procedure RemoveLib(const AInfo: TUnloadDLLDebugInfo);
|
||||
procedure RemoveThread(const AID: DWord);
|
||||
|
||||
@ -263,6 +273,22 @@ end;
|
||||
|
||||
{ TDbgInstance }
|
||||
|
||||
function TDbgInstance.AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint;
|
||||
var
|
||||
addr: TDbgPtr;
|
||||
begin
|
||||
Result := nil;
|
||||
if not FDbgInfo.HasInfo then Exit;
|
||||
addr := FDbgInfo.GetLineAddress(AFileName, ALine);
|
||||
if addr = 0 then Exit;
|
||||
Result := FProcess.AddBreak(addr - AddrOffset);
|
||||
end;
|
||||
|
||||
function TDbgInstance.AddrOffset: Int64;
|
||||
begin
|
||||
Result := FLoader.ImageBase - BaseAddr;
|
||||
end;
|
||||
|
||||
procedure TDbgInstance.CheckName;
|
||||
begin
|
||||
if FName = ''
|
||||
@ -333,6 +359,11 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TDbgInstance.FindSymbol(AAdress: TDbgPtr): TDbgSymbol;
|
||||
begin
|
||||
Result := FDbgInfo.FindSymbol(AAdress + AddrOffset);
|
||||
end;
|
||||
|
||||
procedure TDbgInstance.LoadInfo;
|
||||
begin
|
||||
FLoader := TDbgWinPEImageLoader.Create(FModuleHandle);
|
||||
@ -340,6 +371,17 @@ begin
|
||||
TDbgDwarf(FDbgInfo).LoadCompilationUnits;
|
||||
end;
|
||||
|
||||
function TDbgInstance.RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean;
|
||||
var
|
||||
addr: TDbgPtr;
|
||||
begin
|
||||
Result := False;
|
||||
if not FDbgInfo.HasInfo then Exit;
|
||||
addr := FDbgInfo.GetLineAddress(AFileName, ALine);
|
||||
if addr = 0 then Exit;
|
||||
Result := FProcess.RemoveBreak(addr - AddrOffset);
|
||||
end;
|
||||
|
||||
procedure TDbgInstance.SetName(const AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
@ -444,13 +486,11 @@ function TDbgProcess.FindSymbol(AAdress: TDbgPtr): TDbgSymbol;
|
||||
var
|
||||
n: Integer;
|
||||
Inst: TDbgInstance;
|
||||
Offset: Int64;
|
||||
begin
|
||||
for n := 0 to FSymInstances.Count - 1 do
|
||||
begin
|
||||
Inst := TDbgInstance(FSymInstances[n]);
|
||||
Offset := Inst.FLoader.ImageBase - Inst.BaseAddr;
|
||||
Result := Inst.FDbgInfo.FindSymbol(AAdress + Offset);
|
||||
Result := Inst.FindSymbol(AAdress);
|
||||
if Result <> nil then Exit;
|
||||
end;
|
||||
Result := nil;
|
||||
@ -655,10 +695,11 @@ begin
|
||||
AData := PWChar(@Buf[0]);
|
||||
end;
|
||||
|
||||
function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
|
||||
function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): Boolean;
|
||||
begin
|
||||
if FBreakMap = nil then Exit;
|
||||
FBreakMap.Delete(ALocation);
|
||||
if FBreakMap = nil
|
||||
then Result := False
|
||||
else Result := FBreakMap.Delete(ALocation);
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.RemoveLib(const AInfo: TUnloadDLLDebugInfo);
|
||||
@ -765,6 +806,11 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TDbgInfo.SetHasInfo;
|
||||
begin
|
||||
FHasInfo := True;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user