paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-06 14:54:42 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ added exception dissection

Browse Source 
+ added linenr address resolving
+ added setting of breakpoints

git-svn-id: trunk@10166 -
This commit is contained in:
marc 2006-11-03 00:54:34 +00:00
parent 168e90b7ce
commit 90f62672f2
6 changed files with 440 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
debugger/windebug/fpwd/fpwdcommand.pas
View File

@ -36,7 +36,7 @@ unit FPWDCommand;
interface interface
uses uses
SysUtils, Classes, Windows, WinDExtra, LCLProc; SysUtils, Classes, Windows, WinDExtra, WinDebugger, LCLProc;
procedure HandleCommand(ACommand: String); procedure HandleCommand(ACommand: String);
@ -181,8 +181,83 @@ begin
end; end;
procedure HandleBreak(AParams: String); procedure HandleBreak(AParams: String);
var
S, P: String;
Remove: Boolean;
Address: TDbgPtr;
e: Integer;
Line: Cardinal;
bp: TDbgBreakpoint;
begin 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; end;
procedure HandleContinue(AParams: String); procedure HandleContinue(AParams: String);
@ -235,7 +310,7 @@ procedure HandleMemory(AParams: String);
var var
P: array[1..3] of String; P: array[1..3] of String;
Size, Count: Integer; Size, Count: Integer;
Adress: QWord; Address: QWord;
e, idx: Integer; e, idx: Integer;
buf: array[0..256*16 - 1] of Byte; buf: array[0..256*16 - 1] of Byte;
BytesRead: Cardinal; BytesRead: Cardinal;
@ -255,9 +330,9 @@ begin
Size := 4; Size := 4;
{$ifdef cpui386} {$ifdef cpui386}
Adress := GCurrentContext^.Eip; Address := GCurrentContext^.Eip;
{$else} {$else}
Adress := GCurrentContext^.Rip; Address := GCurrentContext^.Rip;
{$endif} {$endif}
if P[idx] <> '' if P[idx] <> ''
@ -279,7 +354,7 @@ begin
end end
else begin else begin
Val(P[idx], Adress, e); Val(P[idx], Address, e);
if e <> 0 if e <> 0
then begin then begin
WriteLN('Location "',P[idx],'": Symbol resolving not implemented'); WriteLN('Location "',P[idx],'": Symbol resolving not implemented');
@ -303,9 +378,9 @@ begin
BytesRead := Count * Size; BytesRead := Count * Size;
if not GMainProcess.ReadData(Adress, BytesRead, buf) if not GMainProcess.ReadData(Address, BytesRead, buf)
then begin then begin
WriteLN('Could not read memory at: ', FormatAddress(Adress)); WriteLN('Could not read memory at: ', FormatAddress(Address));
Exit; Exit;
end; end;
@ -313,7 +388,7 @@ begin
while BytesRead >= size do while BytesRead >= size do
begin begin
if e and ((32 div Size) - 1) = 0 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)); for idx := Size - 1 downto 0 do Write(IntToHex(buf[e * size + idx], 2));
@ -322,7 +397,7 @@ begin
then WriteLn then WriteLn
else Write(' '); else Write(' ');
Dec(BytesRead, Size); Dec(BytesRead, Size);
Inc(Adress, Size); Inc(Address, Size);
end; end;
if e <> 32 div Size if e <> 32 div Size
then WriteLn; then WriteLn;
@ -596,7 +671,7 @@ begin
MCommands.AddCommand(['show', 's'], @HandleShow, 'show <info>: Enter show help for more info'); 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(['set'], @HandleSet, 'set param: Enter set help for more info');
MCommands.AddCommand(['run', 'r'], @HandleRun, 'run: Starts the loaded debuggee'); 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(['continue', 'cont', 'c'], @HandleContinue, 'continue: Continues execution');
MCommands.AddCommand(['kill', 'k'], @HandleKill, 'kill: Stops execution of the debuggee'); MCommands.AddCommand(['kill', 'k'], @HandleKill, 'kill: Stops execution of the debuggee');
MCommands.AddCommand(['next', 'n'], @HandleNext, 'next: Steps one instruction'); MCommands.AddCommand(['next', 'n'], @HandleNext, 'next: Steps one instruction');

7
debugger/windebug/fpwd/fpwdglobal.pas
View File

@ -42,6 +42,9 @@ type
TMWDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent); TMWDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent);
TMWDMode = (dm32, dm64); TMWDMode = (dm32, dm64);
TMWDImageInfo = (iiNone, iiName, iiDetail); TMWDImageInfo = (iiNone, iiName, iiDetail);
const
DBGPTRSIZE: array[TMWDMode] of Integer = (4, 8);
var var
GState: TMWDState; GState: TMWDState;
@ -75,10 +78,8 @@ begin
end; end;
function FormatAddress(const AAddress): String; function FormatAddress(const AAddress): String;
const
SIZE: array[TMWDMode] of Integer = (4, 8);
begin begin
Result := HexValue(AAddress, SIZE[GMode], [hvfIncludeHexchar]); Result := HexValue(AAddress, DBGPTRSIZE[GMode], [hvfIncludeHexchar]);
end; end;

96
debugger/windebug/fpwd/fpwdloop.pas
View File

@ -45,7 +45,7 @@ procedure DebugLoop;
implementation implementation
uses uses
FPWDGlobal, FPWDPEImage; FPWDGlobal, FPWDPEImage, FPWDType;
var var
MDebugEvent: TDebugEvent; MDebugEvent: TDebugEvent;
@ -90,11 +90,14 @@ var
Info1: QWORD; Info1: QWORD;
Info1Str: String; Info1Str: String;
P: PByte; P: PByte;
ExInfo32: TExceptionDebugInfo32 absolute AEvent.Exception;
ExInfo64: TExceptionDebugInfo64 absolute AEvent.Exception;
begin begin
if AEvent.Exception.dwFirstChance = 0 if AEvent.Exception.dwFirstChance = 0
then Write('Exception: ') then Write('Exception: ')
else Write('First chance 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 case AEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_ACCESS_VIOLATION : Write('ACCESS_VIOLATION'); EXCEPTION_ACCESS_VIOLATION : Write('ACCESS_VIOLATION');
EXCEPTION_ARRAY_BOUNDS_EXCEEDED : Write('ARRAY_BOUNDS_EXCEEDED'); 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_DIVIDE_BY_ZERO : Write('INT_DIVIDE_BY_ZERO');
EXCEPTION_INT_OVERFLOW : Write('INT_OVERFLOW'); EXCEPTION_INT_OVERFLOW : Write('INT_OVERFLOW');
EXCEPTION_INVALID_DISPOSITION : Write('INVALID_DISPOSITION'); EXCEPTION_INVALID_DISPOSITION : Write('INVALID_DISPOSITION');
EXCEPTION_INVALID_HANDLE : Write('EXCEPTION_INVALID_HANDLE');
EXCEPTION_NONCONTINUABLE_EXCEPTION : Write('NONCONTINUABLE_EXCEPTION'); EXCEPTION_NONCONTINUABLE_EXCEPTION : Write('NONCONTINUABLE_EXCEPTION');
EXCEPTION_POSSIBLE_DEADLOCK : Write('EXCEPTION_POSSIBLE_DEADLOCK');
EXCEPTION_PRIV_INSTRUCTION : Write('PRIV_INSTRUCTION'); EXCEPTION_PRIV_INSTRUCTION : Write('PRIV_INSTRUCTION');
EXCEPTION_SINGLE_STEP : Write('SINGLE_STEP'); EXCEPTION_SINGLE_STEP : Write('SINGLE_STEP');
EXCEPTION_STACK_OVERFLOW : Write('STACK_OVERFLOW'); 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 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; 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(' at: ', FormatAddress(Info0));
Write(' Flags:', Format('%x', [AEvent.Exception.ExceptionRecord.ExceptionFlags]), ' ['); Write(' Flags:', Format('%x', [AEvent.Exception.ExceptionRecord.ExceptionFlags]), ' [');
if AEvent.Exception.ExceptionRecord.ExceptionFlags = 0 if AEvent.Exception.ExceptionRecord.ExceptionFlags = 0
then Write('Continuable') then Write('Continuable')
else Write('Not continuable'); else Write('Not continuable');
Write(']'); 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 case AEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_ACCESS_VIOLATION: begin EXCEPTION_ACCESS_VIOLATION: begin
Info0 := AEvent.Exception.ExceptionRecord.ExceptionInformation[0]; if GMode = dm32
Info1Str := FormatAddress(AEvent.Exception.ExceptionRecord.ExceptionInformation[1]); 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 case Info0 of
0: begin EXCEPTION_READ_FAULT: begin
Write(' Read of address: ', Info1Str); Write(' Read of address: ', Info1Str);
end; end;
1: begin EXCEPTION_WRITE_FAULT: begin
Write(' Write of address: ', Info1Str); Write(' Write of address: ', Info1Str);
end; end;
EXCEPTION_EXECUTE_FAULT: begin
Write(' Execute of address: ', Info1Str);
end;
end; end;
end; end;
end; end;
WriteLN; WriteLN;
Write(' Info: '); Write(' Info: ');
with AEvent.Exception.ExceptionRecord do for n := 0 to EXCEPTION_MAXIMUM_PARAMETERS - 1 do
for n := Low(ExceptionInformation) to high(ExceptionInformation) do begin
begin if GMode = dm32
Write(IntToHex(ExceptionInformation[n], SizeOf(Pointer) * 2), ' '); then Info0 := ExInfo32.ExceptionRecord.ExceptionInformation[n]
if n and (PARAMCOLS - 1) = (PARAMCOLS - 1) else Info0 := ExInfo64.ExceptionRecord.ExceptionInformation[n];
then begin Write(IntToHex(Info0, DBGPTRSIZE[GMode] * 2), ' ');
WriteLN; if n and (PARAMCOLS - 1) = (PARAMCOLS - 1)
Write(' '); then begin
end; WriteLN;
Write(' ');
end; end;
end;
WriteLn; WriteLn;
GState := dsPause; GState := dsPause;
end; end;

89
debugger/windebug/fpwd/fpwdtype.pas
View File

@ -31,19 +31,46 @@ unit FPWDType;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$ALIGN ON} {$ALIGN ON}
// Additional 64bit types // Additional bit types, not all in RTL
interface interface
uses uses
Windows; 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 //type
// DWORD64 = QWORD; // DWORD64 = QWORD;
// ULONGLONG = QWORD; // ULONGLONG = QWORD;
// LONGLONG = int64; // LONGLONG = int64;
//QWORD = type cardinal; //QWORD = type cardinal;
{.$if declared(THREAD_SUSPEND_RESUME)}
{.$else}
const const
THREAD_TERMINATE = $0001; THREAD_TERMINATE = $0001;
THREAD_SUSPEND_RESUME = $0002; THREAD_SUSPEND_RESUME = $0002;
@ -56,22 +83,66 @@ const
THREAD_DIRECT_IMPERSONATION = $0200; THREAD_DIRECT_IMPERSONATION = $0200;
THREAD_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3FF; 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 type
PExceptionRecord64 = QWORD; TExceptionRecord32 = record
// PExceptionRecord64 = ^_EXCEPTION_RECORD64; ExceptionCode : DWORD;
_EXCEPTION_RECORD64 = record 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; ExceptionCode: DWORD;
ExceptionFlags: DWORD; ExceptionFlags: DWORD;
ExceptionRecord: PExceptionRecord64; ExceptionRecord: DWORD64;
ExceptionAddress: QWORD; ExceptionAddress: DWORD64;
NumberParameters: DWORD; NumberParameters: DWORD;
__unusedAlignment: DWORD; __unusedAlignment: DWORD;
ExceptionInformation: array[0..EXCEPTION_MAXIMUM_PARAMETERS - 1] of QWORD; ExceptionInformation: array[0..EXCEPTION_MAXIMUM_PARAMETERS - 1] of DWORD64;
end; end;
TExceptionRecord64 = _EXCEPTION_RECORD64; PExceptionRecord64 = ^TExceptionRecord64;
EXCEPTION_RECORD64 = _EXCEPTION_RECORD64; {$endif}
{$if declared(TExceptionDebugInfo64)}
{$else}
type
TExceptionDebugInfo64 = record
ExceptionRecord : TExceptionRecord64;
dwFirstChance : DWORD;
end;
PExceptionDebugInfo64 = ^TExceptionDebugInfo64;
{$endif}
(* (*
PContext64 = QWORD; PContext64 = QWORD;

192
debugger/windebug/winddwarf.pas
View File

@ -244,14 +244,17 @@ type
StateMachines: TFPObjectList; // list of state machines to be freed StateMachines: TFPObjectList; // list of state machines to be freed
end; end;
FLineNumberMap: TStringList;
FAddressMap: TMap; FAddressMap: TMap;
FAddressMapBuild: Boolean; FAddressMapBuild: Boolean;
FMinPC: QWord; // the min and max PC value found in this unit. FMinPC: QWord; // the min and max PC value found in this unit.
FMaxPC: QWord; // FMaxPC: QWord; //
FScope: TDwarfScopeInfo; FScope: TDwarfScopeInfo;
procedure BuildAddessMap(AScope: TDwarfScopeInfo); procedure BuildAddressMap;
procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo); procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean);
function MakeAddress(AData: Pointer): QWord; function MakeAddress(AData: Pointer): QWord;
procedure LoadAbbrevs(ANeeded: Cardinal); procedure LoadAbbrevs(ANeeded: Cardinal);
protected protected
@ -269,6 +272,7 @@ type
constructor Create(AOwner: TDbgDwarf; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean); virtual; constructor Create(AOwner: TDbgDwarf; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean); virtual;
destructor Destroy; override; destructor Destroy; override;
function GetDefinition(AAbbrev: Cardinal; out ADefinition: TDwarfAbbrev): Boolean; function GetDefinition(AAbbrev: Cardinal; out ADefinition: TDwarfAbbrev): Boolean;
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
property FileName: String read FFileName; property FileName: String read FFileName;
property Valid: Boolean read FValid; property Valid: Boolean read FValid;
end; end;
@ -368,6 +372,7 @@ type
constructor Create(ALoader: TDbgImageLoader); override; constructor Create(ALoader: TDbgImageLoader); override;
destructor Destroy; override; destructor Destroy; override;
function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; override; function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; override;
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override;
function LoadCompilationUnits: Integer; function LoadCompilationUnits: Integer;
function PointerFromRVA(ARVA: QWord): Pointer; function PointerFromRVA(ARVA: QWord): Pointer;
function PointerFromVA(ASection: TDwarfSection; AVA: QWord): Pointer; function PointerFromVA(ASection: TDwarfSection; AVA: QWord): Pointer;
@ -812,7 +817,7 @@ begin
if FAddressInfo^.StateMachine = nil if FAddressInfo^.StateMachine = nil
then begin then begin
FCU.BuildLineInfo(FAddressInfo); FCU.BuildLineInfo(FAddressInfo, False);
if FAddressInfo^.StateMachine = nil then Exit; if FAddressInfo^.StateMachine = nil then Exit;
end; end;
@ -894,7 +899,7 @@ begin
if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC)) if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC))
then Continue; then Continue;
CU.BuildAddessMap(CU.FScope); CU.BuildAddressMap;
Iter := TMapIterator.Create(CU.FAddressMap); Iter := TMapIterator.Create(CU.FAddressMap);
try try
@ -944,6 +949,20 @@ begin
Result := TDwarfCompilationUnit; Result := TDwarfCompilationUnit;
end; 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; function TDbgDwarf.LoadCompilationUnits: Integer;
var var
p: Pointer; p: Pointer;
@ -1073,7 +1092,6 @@ var
pb: PByte absolute FLineInfoPtr; pb: PByte absolute FLineInfoPtr;
p: Pointer; p: Pointer;
Opcode: Byte; Opcode: Byte;
FileNr: Integer;
instrlen: Cardinal; instrlen: Cardinal;
diridx: Cardinal; diridx: Cardinal;
begin begin
@ -1220,29 +1238,79 @@ end;
{ TDwarfCompilationUnit } { 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 var
AttribList: TPointerDynArray; AttribList: TPointerDynArray;
Attrib: Pointer; Attrib: Pointer;
Form: Cardinal; Form: Cardinal;
Info: TDwarfAddressInfo; Info: TDwarfAddressInfo;
Scope: TDwarfScopeInfo; Scope, ResultScope: TDwarfScopeInfo;
begin begin
if FAddressMapBuild then Exit; if FAddressMapBuild then Exit;
while AScope <> nil do
Scope := FScope;
while Scope <> nil do
begin 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 then begin
Info.Scope := Scope; Info.Scope := ResultScope;
if LocateAttribute(Scope.Entry, DW_AT_low_pc, AttribList, Attrib, Form) if LocateAttribute(ResultScope.Entry, DW_AT_low_pc, AttribList, Attrib, Form)
then begin then begin
ReadValue(Attrib, Form, Info.StartPC); 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) then ReadValue(Attrib, Form, Info.EndPC)
else Info.EndPC := Info.StartPC; 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) then ReadValue(Attrib, Form, Info.Name)
else Info.Name := 'undefined'; else Info.Name := 'undefined';
@ -1256,51 +1324,18 @@ begin
end; end;
// TAG found, try continue with the found scope // TAG found, try continue with the found scope
AScope := Scope.Child; Scope := ResultScope.Child;
if AScope <> nil then Continue; if Scope <> nil then Continue;
end Scope := ResultScope;
else begin
Scope := AScope;
end; end;
while (Scope.Next = nil) and (Scope.Parent <> nil) do Scope := Scope.Parent; while (Scope.Next = nil) and (Scope.Parent <> nil) do Scope := Scope.Parent;
AScope := Scope.Next; Scope := Scope.Next;
end; end;
FAddressMapBuild := True; FAddressMapBuild := True;
end; 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); constructor TDwarfCompilationUnit.Create(AOwner: TDbgDwarf; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean);
procedure FillLineInfo(AData: Pointer); procedure FillLineInfo(AData: Pointer);
var var
@ -1419,6 +1454,10 @@ begin
// use internally 64 bit target pointer // use internally 64 bit target pointer
FAddressMap := TMap.Create(itu8, SizeOf(TDwarfAddressInfo)); FAddressMap := TMap.Create(itu8, SizeOf(TDwarfAddressInfo));
FLineNumberMap := TStringList.Create;
FLineNumberMap.Sorted := True;
FLineNumberMap.Duplicates := dupError;
FScope := TDwarfScopeInfo.Create(FInfoData); FScope := TDwarfScopeInfo.Create(FInfoData);
// retrieve some info about this unit // retrieve some info about this unit
@ -1435,7 +1474,7 @@ begin
if not LocateAttribute(Scope.Entry, DW_AT_identifier_case, AttribList, Attrib, Form) if not LocateAttribute(Scope.Entry, DW_AT_identifier_case, AttribList, Attrib, Form)
and not ReadValue(Attrib, Form, FIdentifierCase) and not ReadValue(Attrib, Form, FIdentifierCase)
then FIdentifierCase := DW_ID_case_sensitive; then FIdentifierCase := DW_ID_case_sensitive;
if LocateAttribute(Scope.Entry, DW_AT_stmt_list, AttribList, Attrib, Form) if LocateAttribute(Scope.Entry, DW_AT_stmt_list, AttribList, Attrib, Form)
and ReadValue(Attrib, Form, StatementListOffs) and ReadValue(Attrib, Form, StatementListOffs)
then begin then begin
@ -1462,8 +1501,6 @@ begin
if FMinPC = 0 then FMinPC := FMaxPC; if FMinPC = 0 then FMinPC := FMaxPC;
if FMaxPC = 0 then FMAxPC := FMinPC; if FMaxPC = 0 then FMAxPC := FMinPC;
// BuildAddessMap(Scope.Child);
end; end;
destructor TDwarfCompilationUnit.Destroy; destructor TDwarfCompilationUnit.Destroy;
@ -1484,11 +1521,21 @@ destructor TDwarfCompilationUnit.Destroy;
end; end;
FScope := nil; FScope := nil;
end; end;
procedure FreeLineNumberMap;
var
n: Integer;
begin
for n := 0 to FLineNumberMap.Count - 1 do
FLineNumberMap.Objects[n].Free;
FreeAndNil(FLineNumberMap);
end;
begin begin
FreeScope; FreeScope;
FreeAndNil(FMap); FreeAndNil(FMap);
FreeAndNil(FAddressMap); FreeAndNil(FAddressMap);
FreeLineNumberMap;
FreeAndNil(FLineInfo.StateMachines); FreeAndNil(FLineInfo.StateMachines);
FreeAndNil(FLineInfo.StateMachine); FreeAndNil(FLineInfo.StateMachine);
FreeAndNil(FLineInfo.Directories); FreeAndNil(FLineInfo.Directories);
@ -1503,6 +1550,43 @@ begin
Result := FMap.GetData(AAbbrev, ADefinition); Result := FMap.GetData(AAbbrev, ADefinition);
end; 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 TDwarfCompilationUnit.LoadAbbrevs(ANeeded: Cardinal);
procedure MakeRoom(AMinSize: Integer); procedure MakeRoom(AMinSize: Integer);
var var

60
debugger/windebug/windebugger.pp
View File

@ -137,6 +137,8 @@ type
end; end;
{ TDbgInfo }
TDbgInfo = class(TObject) TDbgInfo = class(TObject)
private private
FHasInfo: Boolean; FHasInfo: Boolean;
@ -147,6 +149,7 @@ type
function FindSymbol(const AName: String): TDbgSymbol; virtual; function FindSymbol(const AName: String): TDbgSymbol; virtual;
function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; virtual; function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; virtual;
property HasInfo: Boolean read FHasInfo; property HasInfo: Boolean read FHasInfo;
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; virtual;
end; end;
@ -164,6 +167,7 @@ type
constructor Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr); constructor Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr);
destructor Destroy; override; destructor Destroy; override;
function Hit(const AThreadID: Integer): Boolean; function Hit(const AThreadID: Integer): Boolean;
property Location: TDbgPtr read FLocation;
end; end;
@ -185,6 +189,12 @@ type
public public
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean); constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean);
destructor Destroy; override; 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 Process: TDbgProcess read FProcess;
property ModuleHandle: THandle read FModuleHandle; property ModuleHandle: THandle read FModuleHandle;
property BaseAddr: TDbgPtr read FBaseAddr; property BaseAddr: TDbgPtr read FBaseAddr;
@ -234,7 +244,7 @@ type
procedure Interrupt; procedure Interrupt;
procedure ContinueDebugEvent(const AThread: TDbgThread; const ADebugEvent: TDebugEvent); procedure ContinueDebugEvent(const AThread: TDbgThread; const ADebugEvent: TDebugEvent);
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean; function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
function RemoveBreak(const ALocation: TDbgPtr): TDbgBreakpoint; function RemoveBreak(const ALocation: TDbgPtr): Boolean;
procedure RemoveLib(const AInfo: TUnloadDLLDebugInfo); procedure RemoveLib(const AInfo: TUnloadDLLDebugInfo);
procedure RemoveThread(const AID: DWord); procedure RemoveThread(const AID: DWord);
@ -263,6 +273,22 @@ end;
{ TDbgInstance } { 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; procedure TDbgInstance.CheckName;
begin begin
if FName = '' if FName = ''
@ -333,6 +359,11 @@ begin
inherited; inherited;
end; end;
function TDbgInstance.FindSymbol(AAdress: TDbgPtr): TDbgSymbol;
begin
Result := FDbgInfo.FindSymbol(AAdress + AddrOffset);
end;
procedure TDbgInstance.LoadInfo; procedure TDbgInstance.LoadInfo;
begin begin
FLoader := TDbgWinPEImageLoader.Create(FModuleHandle); FLoader := TDbgWinPEImageLoader.Create(FModuleHandle);
@ -340,6 +371,17 @@ begin
TDbgDwarf(FDbgInfo).LoadCompilationUnits; TDbgDwarf(FDbgInfo).LoadCompilationUnits;
end; 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); procedure TDbgInstance.SetName(const AValue: String);
begin begin
FName := AValue; FName := AValue;
@ -444,13 +486,11 @@ function TDbgProcess.FindSymbol(AAdress: TDbgPtr): TDbgSymbol;
var var
n: Integer; n: Integer;
Inst: TDbgInstance; Inst: TDbgInstance;
Offset: Int64;
begin begin
for n := 0 to FSymInstances.Count - 1 do for n := 0 to FSymInstances.Count - 1 do
begin begin
Inst := TDbgInstance(FSymInstances[n]); Inst := TDbgInstance(FSymInstances[n]);
Offset := Inst.FLoader.ImageBase - Inst.BaseAddr; Result := Inst.FindSymbol(AAdress);
Result := Inst.FDbgInfo.FindSymbol(AAdress + Offset);
if Result <> nil then Exit; if Result <> nil then Exit;
end; end;
Result := nil; Result := nil;
@ -655,10 +695,11 @@ begin
AData := PWChar(@Buf[0]); AData := PWChar(@Buf[0]);
end; end;
function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): TDbgBreakpoint; function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): Boolean;
begin begin
if FBreakMap = nil then Exit; if FBreakMap = nil
FBreakMap.Delete(ALocation); then Result := False
else Result := FBreakMap.Delete(ALocation);
end; end;
procedure TDbgProcess.RemoveLib(const AInfo: TUnloadDLLDebugInfo); procedure TDbgProcess.RemoveLib(const AInfo: TUnloadDLLDebugInfo);
@ -765,6 +806,11 @@ begin
Result := nil; Result := nil;
end; end;
function TDbgInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
begin
Result := 0;
end;
procedure TDbgInfo.SetHasInfo; procedure TDbgInfo.SetHasInfo;
begin begin
FHasInfo := True; FHasInfo := True;