mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-05 16:20:58 +02:00
FpDebug: Set breakpoints in libraries (dll/so). Update existing breakpoints when library is loaded. Add state (ok, fail, pending) to breakpoints.
This commit is contained in:
Martin
parent
5d091f5d5b
commit
04b384b34d
@ -416,14 +416,23 @@ type
|
||||
|
||||
{ TFpDbgBreakpoint }
|
||||
|
||||
TFpDbgBreakpoint = class;
|
||||
|
||||
TFpDbgBreakpointState = (bksUnknown, bksOk, bksFailed, bksPending);
|
||||
TFpDbgBreakpointStateChangeEvent = procedure(Sender: TFpDbgBreakpoint; ANewState: TFpDbgBreakpointState) of object;
|
||||
|
||||
TFpDbgBreakpoint = class(TObject)
|
||||
private
|
||||
FFreeByDbgProcess: Boolean;
|
||||
FEnabled: boolean;
|
||||
FOn_Thread_StateChange: TFpDbgBreakpointStateChangeEvent;
|
||||
protected
|
||||
procedure SetEnabled(AValue: boolean);
|
||||
function GetState: TFpDbgBreakpointState; virtual;
|
||||
public
|
||||
function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; virtual; abstract;
|
||||
function HasLocation(const ALocation: TDBGPtr): Boolean; virtual; abstract;
|
||||
// A breakpoint could also be inside/part of a library.
|
||||
function BelongsToInstance(const AnInstance: TDbgInstance): Boolean; virtual; abstract;
|
||||
|
||||
procedure AddAddress(const ALocation: TDBGPtr); virtual; abstract;
|
||||
procedure RemoveAddress(const ALocation: TDBGPtr); virtual; abstract;
|
||||
@ -434,6 +443,10 @@ type
|
||||
|
||||
// FreeByDbgProcess: The breakpoint will be freed by TDbgProcess.Destroy
|
||||
property FreeByDbgProcess: Boolean read FFreeByDbgProcess write FFreeByDbgProcess;
|
||||
property Enabled: boolean read FEnabled write SetEnabled;
|
||||
property State: TFpDbgBreakpointState read GetState;
|
||||
// Event runs in dbg-thread
|
||||
property On_Thread_StateChange: TFpDbgBreakpointStateChangeEvent read FOn_Thread_StateChange write FOn_Thread_StateChange;
|
||||
end;
|
||||
|
||||
{ TFpInternalBreakBase }
|
||||
@ -442,6 +455,8 @@ type
|
||||
private
|
||||
FProcess: TDbgProcess;
|
||||
protected
|
||||
procedure UpdateForLibraryLoaded(ALib: TDbgLibrary); virtual;
|
||||
procedure UpdateForLibrareUnloaded(ALib: TDbgLibrary); virtual;
|
||||
property Process: TDbgProcess read FProcess;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess); virtual;
|
||||
@ -455,21 +470,27 @@ type
|
||||
private
|
||||
FLocation: TDBGPtrArray;
|
||||
FInternal: Boolean;
|
||||
FState: TFpDbgBreakpointState;
|
||||
protected
|
||||
function GetState: TFpDbgBreakpointState; override;
|
||||
procedure SetState(AState: TFpDbgBreakpointState);
|
||||
procedure UpdateState; virtual;
|
||||
procedure UpdateForLibrareUnloaded(ALib: TDbgLibrary); override;
|
||||
property Location: TDBGPtrArray read FLocation;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const ALocation: TDBGPtrArray; AnEnabled: Boolean); virtual;
|
||||
destructor Destroy; override;
|
||||
function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; override;
|
||||
function HasLocation(const ALocation: TDBGPtr): Boolean; override;
|
||||
function BelongsToInstance(const AnInstance: TDbgInstance): Boolean; override;
|
||||
|
||||
procedure AddAddress(const ALocation: TDBGPtr); override;
|
||||
procedure AddAddress(const ALocations: TDBGPtrArray);
|
||||
procedure RemoveAddress(const ALocation: TDBGPtr); override;
|
||||
procedure RemoveAllAddresses; override;
|
||||
|
||||
procedure SetBreak; override;
|
||||
procedure ResetBreak; override;
|
||||
|
||||
end;
|
||||
|
||||
{ TFpInternalBreakpointAtSymbol }
|
||||
@ -477,6 +498,10 @@ type
|
||||
TFpInternalBreakpointAtSymbol = class(TFpInternalBreakpoint)
|
||||
private
|
||||
FFuncName: String;
|
||||
FSymInstance: TDbgInstance;
|
||||
protected
|
||||
procedure UpdateState; override;
|
||||
procedure UpdateForLibraryLoaded(ALib: TDbgLibrary); override;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const AFuncName: String; AnEnabled: Boolean; ASymInstance: TDbgInstance = nil); virtual;
|
||||
end;
|
||||
@ -487,6 +512,11 @@ type
|
||||
private
|
||||
FFileName: String;
|
||||
FLine: Cardinal;
|
||||
FSymInstance: TDbgInstance;
|
||||
FFoundFileWithoutLine: Boolean;
|
||||
protected
|
||||
procedure UpdateState; override;
|
||||
procedure UpdateForLibraryLoaded(ALib: TDbgLibrary); override;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const AFileName: String; ALine: Cardinal; AnEnabled: Boolean; ASymInstance: TDbgInstance = nil); virtual;
|
||||
end;
|
||||
@ -514,7 +544,6 @@ type
|
||||
constructor Create(const AProcess: TDbgProcess; const ALocation: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind;
|
||||
AScope: TDBGWatchPointScope); virtual;
|
||||
destructor Destroy; override;
|
||||
function BelongsToInstance(const AnInstance: TDbgInstance): Boolean; override;
|
||||
|
||||
procedure SetBreak; override;
|
||||
procedure ResetBreak; override;
|
||||
@ -534,6 +563,7 @@ type
|
||||
FProcess: TDbgProcess;
|
||||
FSymbolTableInfo: TFpSymbolInfo;
|
||||
FLoaderList: TDbgImageLoaderList;
|
||||
FLastLineAddressesFoundFile: Boolean;
|
||||
function GetOSDbgClasses: TOSDbgClasses;
|
||||
function GetPointerSize: Integer;
|
||||
|
||||
@ -578,6 +608,7 @@ type
|
||||
TDbgLibrary = class(TDbgInstance)
|
||||
private
|
||||
FModuleHandle: THandle;
|
||||
FBreakUpdateDone: Boolean;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle);
|
||||
property Name: String read FFileName;
|
||||
@ -674,6 +705,7 @@ type
|
||||
function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
|
||||
procedure SetLastLibraryUnloaded(ALib: TDbgLibrary);
|
||||
procedure SetLastLibraryUnloadedNil(ALib: TDbgLibrary);
|
||||
procedure AddLibrary(ALib: TDbgLibrary; AnID: TDbgPtr);
|
||||
function GetRequiresExecutionInDebuggerThread: boolean; virtual;
|
||||
|
||||
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte; AMakeTempRemoved: Boolean): Boolean; virtual;
|
||||
@ -721,6 +753,7 @@ type
|
||||
*)
|
||||
function FindProcSymbol(const AName: String): TFpSymbol; overload; // deprecated 'backward compatible / use FindProcSymbol(AName, TheDbgProcess)';
|
||||
function FindProcSymbol(const AName: String; ASymInstance: TDbgInstance): TFpSymbol; overload;
|
||||
procedure FindProcSymbol(const AName: String; ASymInstance: TDbgInstance; out ASymList: TFpSymbolArray);
|
||||
function FindProcSymbol(const AName, ALibraryName: String; IsFullLibName: Boolean = True): TFpSymbol; overload;
|
||||
function FindProcSymbol(AAdress: TDbgPtr): TFpSymbol; overload;
|
||||
function FindSymbolScope(AThreadId, AStackFrame: Integer): TFpDbgSymbolScope;
|
||||
@ -731,6 +764,8 @@ type
|
||||
function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
|
||||
property LastLibrariesLoaded: TDbgLibraryArr read GetLastLibrariesLoaded;
|
||||
property LastLibrariesUnloaded: TDbgLibraryArr read GetLastLibrariesUnloaded;
|
||||
procedure UpdateBreakpointsForLibraryLoaded(ALib: TDbgLibrary);
|
||||
procedure UpdateBreakpointsForLibraryUnloaded(ALib: TDbgLibrary);
|
||||
function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
|
||||
procedure RemoveBreak(const ABreakPoint: TFpDbgBreakpoint);
|
||||
procedure DoBeforeBreakLocationMapChange;
|
||||
@ -760,7 +795,7 @@ type
|
||||
// Remove (and free if applicable) all breakpoints for this process. When a
|
||||
// library is specified as OnlyForLibrary, only breakpoints that belong to this
|
||||
// library are cleared.
|
||||
procedure RemoveAllBreakPoints(const OnlyForLibrary: TDbgLibrary = nil);
|
||||
procedure RemoveAllBreakPoints;
|
||||
|
||||
function CheckForConsoleOutput(ATimeOutMs: integer): integer; virtual;
|
||||
function GetConsoleOutput: string; virtual;
|
||||
@ -908,6 +943,21 @@ begin
|
||||
RegisteredDbgProcessClasses.Add(ADbgOsClasses);
|
||||
end;
|
||||
|
||||
{ TFpDbgBreakpoint }
|
||||
|
||||
function TFpDbgBreakpoint.GetState: TFpDbgBreakpointState;
|
||||
begin
|
||||
Result := bksUnknown;
|
||||
end;
|
||||
|
||||
procedure TFpDbgBreakpoint.SetEnabled(AValue: boolean);
|
||||
begin
|
||||
if AValue then
|
||||
SetBreak
|
||||
else
|
||||
ResetBreak;
|
||||
end;
|
||||
|
||||
{ TDbgCallstackEntryList }
|
||||
|
||||
procedure TDbgCallstackEntryList.SetHasReadAllAvailableFrames;
|
||||
@ -1840,9 +1890,11 @@ begin
|
||||
end;
|
||||
|
||||
function TDbgInstance.GetLineAddresses(AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean;
|
||||
var
|
||||
FoundLine: Integer;
|
||||
begin
|
||||
if Assigned(DbgInfo) and DbgInfo.HasInfo then
|
||||
Result := DbgInfo.GetLineAddresses(AFileName, ALine, AResultList)
|
||||
Result := DbgInfo.GetLineAddresses(AFileName, ALine, AResultList, fsNone, @FoundLine, @FLastLineAddressesFoundFile)
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
@ -1999,6 +2051,38 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.FindProcSymbol(const AName: String;
|
||||
ASymInstance: TDbgInstance; out ASymList: TFpSymbolArray);
|
||||
var
|
||||
Lib: TDbgLibrary;
|
||||
Sym: TFpSymbol;
|
||||
begin
|
||||
// TODO: find multiple symbols within the same DbgInfo
|
||||
ASymList := nil;
|
||||
if ASymInstance <> nil then begin
|
||||
Sym := ASymInstance.FindProcSymbol(AName);
|
||||
if Sym <> nil then begin
|
||||
SetLength(ASymList, 1);
|
||||
ASymList[0] := Sym;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
Sym := FindProcSymbol(AName);
|
||||
if Sym <> nil then begin
|
||||
SetLength(ASymList, 1);
|
||||
ASymList[0] := Sym;
|
||||
end;
|
||||
|
||||
for Lib in FLibMap do begin
|
||||
Sym := Lib.FindProcSymbol(AName);
|
||||
if Sym <> nil then begin
|
||||
SetLength(ASymList, 1);
|
||||
ASymList[0] := Sym;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgProcess.FindProcSymbol(const AName: String): TFpSymbol;
|
||||
begin
|
||||
Result := inherited FindProcSymbol(AName);
|
||||
@ -2203,17 +2287,23 @@ var
|
||||
Lib: TDbgLibrary;
|
||||
begin
|
||||
if ASymInstance <> nil then begin
|
||||
if ASymInstance = self then
|
||||
Result := inherited GetLineAddresses(AFileName, ALine, AResultList)
|
||||
else
|
||||
if ASymInstance = self then begin
|
||||
Result := inherited GetLineAddresses(AFileName, ALine, AResultList);
|
||||
end
|
||||
else begin
|
||||
Result := ASymInstance.GetLineAddresses(AFileName, ALine, AResultList);
|
||||
FLastLineAddressesFoundFile := ASymInstance.FLastLineAddressesFoundFile;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := inherited GetLineAddresses(AFileName, ALine, AResultList);
|
||||
for Lib in FLibMap do
|
||||
for Lib in FLibMap do begin
|
||||
if Lib.GetLineAddresses(AFileName, ALine, AResultList) then
|
||||
Result := True;
|
||||
if Lib.FLastLineAddressesFoundFile then
|
||||
FLastLineAddressesFoundFile := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgProcess.ContextFromProc(AThreadId, AStackFrame: Integer;
|
||||
@ -2227,6 +2317,46 @@ begin
|
||||
Result := FLibMap.GetLib(AHandle, ALib);
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.UpdateBreakpointsForLibraryLoaded(ALib: TDbgLibrary);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if (ALib.DbgInfo.HasInfo) or (ALib.SymbolTableInfo.HasInfo) then begin
|
||||
debugln(DBG_VERBOSE and (ALib.FBreakUpdateDone), ['TDbgProcess.UpdateBreakpointsForLibraryLoaded: Called twice for ', ALib.Name]);
|
||||
assert(not ALib.FBreakUpdateDone, 'TDbgProcess.UpdateBreakpointsForLibraryLoaded: not ALib.FBreakUpdateDone');
|
||||
if ALib.FBreakUpdateDone then
|
||||
exit;
|
||||
ALib.FBreakUpdateDone := True;
|
||||
debuglnEnter(DBG_BREAKPOINTS,['> TDbgProcess.UpdateBreakpointsForLibraryLoaded ',ALib.Name ]); try
|
||||
for i := 0 to FBreakpointList.Count - 1 do
|
||||
FBreakpointList[i].UpdateForLibraryLoaded(ALib);
|
||||
finally debuglnExit(DBG_BREAKPOINTS,['< TDbgProcess.UpdateBreakpointsForLibraryLoaded ' ]); end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.UpdateBreakpointsForLibraryUnloaded(ALib: TDbgLibrary);
|
||||
var
|
||||
i: LongInt;
|
||||
b: TFpInternalBreakBase;
|
||||
begin
|
||||
// The library is unloaded by the OS, so all breakpoints are already gone.
|
||||
// This is more to update our administration and free some memory.
|
||||
debuglnEnter(DBG_BREAKPOINTS, ['> TDbgProcess.UpdateBreakpointsForLibraryUnloaded ' ]); try if ALib <> nil then debugln(DBG_BREAKPOINTS, [ALib.Name]);
|
||||
i := FBreakpointList.Count - 1;
|
||||
while i >= 0 do begin
|
||||
b := FBreakpointList[i];
|
||||
b.UpdateForLibrareUnloaded(ALib);
|
||||
dec(i);
|
||||
end;
|
||||
i := FWatchPointList.Count - 1;
|
||||
while i >= 0 do begin
|
||||
b := FWatchPointList[i];
|
||||
b.UpdateForLibrareUnloaded(ALib);
|
||||
dec(i);
|
||||
end;
|
||||
finally debuglnExit(DBG_BREAKPOINTS,['< TDbgProcess.UpdateBreakpointsForLibraryUnloaded ' ]); end;
|
||||
end;
|
||||
|
||||
function TDbgProcess.GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
|
||||
var
|
||||
Thread: TDbgThread;
|
||||
@ -2620,6 +2750,14 @@ begin
|
||||
SetLastLibraryUnloaded(nil);
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.AddLibrary(ALib: TDbgLibrary; AnID: TDbgPtr);
|
||||
begin
|
||||
FLibMap.Add(AnID, ALib);
|
||||
|
||||
if (ALib.DbgInfo.HasInfo) or (ALib.SymbolTableInfo.HasInfo) then
|
||||
FSymInstances.Add(ALib);
|
||||
end;
|
||||
|
||||
function TDbgProcess.InsertBreakInstructionCode(const ALocation: TDBGPtr; out
|
||||
OrigValue: Byte; AMakeTempRemoved: Boolean): Boolean;
|
||||
var
|
||||
@ -2661,7 +2799,7 @@ begin
|
||||
AfterChangingInstructionCode(ALocation, 1);
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.RemoveAllBreakPoints(const OnlyForLibrary: TDbgLibrary = nil);
|
||||
procedure TDbgProcess.RemoveAllBreakPoints;
|
||||
var
|
||||
i: LongInt;
|
||||
b: TFpInternalBreakBase;
|
||||
@ -2669,24 +2807,19 @@ begin
|
||||
i := FBreakpointList.Count - 1;
|
||||
while i >= 0 do begin
|
||||
b := FBreakpointList[i];
|
||||
if not Assigned(OnlyForLibrary) or b.BelongsToInstance(OnlyForLibrary) then begin
|
||||
b.ResetBreak;
|
||||
b.FProcess := nil;
|
||||
FBreakpointList.Delete(i);
|
||||
end;
|
||||
b.ResetBreak;
|
||||
b.FProcess := nil;
|
||||
FBreakpointList.Delete(i);
|
||||
dec(i);
|
||||
end;
|
||||
i := FWatchPointList.Count - 1;
|
||||
while i >= 0 do begin
|
||||
b := FWatchPointList[i];
|
||||
if not Assigned(OnlyForLibrary) or b.BelongsToInstance(OnlyForLibrary) then begin
|
||||
b.ResetBreak;
|
||||
b.FProcess := nil;
|
||||
FWatchPointList.Delete(i);
|
||||
end;
|
||||
b.ResetBreak;
|
||||
b.FProcess := nil;
|
||||
FWatchPointList.Delete(i);
|
||||
dec(i);
|
||||
end;
|
||||
assert(Assigned(OnlyForLibrary) or (FBreakMap.Count = 0), 'TDbgProcess.RemoveAllBreakPoints: FBreakMap.Count = 0');
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer);
|
||||
@ -3503,6 +3636,16 @@ end;
|
||||
|
||||
{ TFpInternalBreakBase }
|
||||
|
||||
procedure TFpInternalBreakBase.UpdateForLibraryLoaded(ALib: TDbgLibrary);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakBase.UpdateForLibrareUnloaded(ALib: TDbgLibrary);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
constructor TFpInternalBreakBase.Create(const AProcess: TDbgProcess);
|
||||
begin
|
||||
inherited Create;
|
||||
@ -3511,18 +3654,64 @@ end;
|
||||
|
||||
{ TDbgBreak }
|
||||
|
||||
function TFpInternalBreakpoint.GetState: TFpDbgBreakpointState;
|
||||
begin
|
||||
Result := FState;
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.SetState(AState: TFpDbgBreakpointState);
|
||||
begin
|
||||
if AState = FState then
|
||||
exit;
|
||||
FState := AState;
|
||||
if FOn_Thread_StateChange <> nil then
|
||||
FOn_Thread_StateChange(Self, AState);
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.UpdateState;
|
||||
begin
|
||||
if Length(FLocation) > 0 then
|
||||
SetState(bksOk)
|
||||
else
|
||||
SetState(bksFailed);
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.UpdateForLibrareUnloaded(ALib: TDbgLibrary);
|
||||
var
|
||||
i, j: Integer;
|
||||
a: TDBGPtr;
|
||||
begin
|
||||
j := 0;
|
||||
for i := 0 to Length(FLocation) - 1 do begin
|
||||
a := FLocation[i];
|
||||
FLocation[j] := a;
|
||||
if ALib.EnclosesAddressRange(a, a) then
|
||||
FProcess.FBreakMap.RemoveLocation(a, Self)
|
||||
else
|
||||
inc(j);
|
||||
end;
|
||||
if j < Length(FLocation) then begin
|
||||
SetLength(FLocation, j);
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFpInternalBreakpoint.Create(const AProcess: TDbgProcess;
|
||||
const ALocation: TDBGPtrArray; AnEnabled: Boolean);
|
||||
begin
|
||||
inherited Create(AProcess);
|
||||
FProcess.FBreakpointList.Add(Self);
|
||||
FLocation := ALocation;
|
||||
FEnabled := AnEnabled;
|
||||
FState := bksUnknown;
|
||||
if AnEnabled then
|
||||
SetBreak;
|
||||
UpdateState;
|
||||
end;
|
||||
|
||||
destructor TFpInternalBreakpoint.Destroy;
|
||||
begin
|
||||
On_Thread_StateChange := nil;
|
||||
if FProcess <> nil then
|
||||
FProcess.FBreakpointList.Remove(Self);
|
||||
ResetBreak;
|
||||
@ -3555,30 +3744,6 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TFpInternalBreakpoint.BelongsToInstance(const AnInstance: TDbgInstance): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
Hi: TDBGPtr;
|
||||
Lo: TDBGPtr;
|
||||
begin
|
||||
if Length(FLocation) = 0 then
|
||||
Exit(False);
|
||||
|
||||
// Search for the lowest and higest locations
|
||||
Lo := FLocation[0];
|
||||
Hi := FLocation[0];
|
||||
for i := 0 to High(FLocation) do
|
||||
begin
|
||||
if FLocation[i] > Hi then
|
||||
Hi := FLocation[i]
|
||||
else if FLocation[i] < Lo then
|
||||
Lo := FLocation[i];
|
||||
end;
|
||||
// Check if the range between the lowest and highest location belongs to (fits into)
|
||||
// the instance
|
||||
Result := AnInstance.EnclosesAddressRange(Lo, Hi);
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.AddAddress(const ALocation: TDBGPtr);
|
||||
var
|
||||
l: Integer;
|
||||
@ -3586,6 +3751,29 @@ begin
|
||||
l := Length(FLocation);
|
||||
SetLength(FLocation, l+1);
|
||||
FLocation[l] := ALocation;
|
||||
if Enabled then
|
||||
FProcess.FBreakMap.AddLocation(ALocation, Self, True);
|
||||
UpdateState;
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.AddAddress(const ALocations: TDBGPtrArray);
|
||||
var
|
||||
l, i: Integer;
|
||||
begin
|
||||
l := Length(FLocation);
|
||||
SetLength(FLocation, l + Length(ALocations));
|
||||
|
||||
if Enabled then begin
|
||||
for i := 0 to Length(ALocations) - 1 do begin
|
||||
FLocation[l + i] := ALocations[i];
|
||||
FProcess.FBreakMap.AddLocation(ALocations[i], Self, True);
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
for i := 0 to Length(ALocations) - 1 do
|
||||
FLocation[l + i] := ALocations[i];
|
||||
end;
|
||||
UpdateState;
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.RemoveAddress(const ALocation: TDBGPtr);
|
||||
@ -3601,12 +3789,14 @@ begin
|
||||
FLocation[i] := FLocation[l];
|
||||
SetLength(FLocation, l);
|
||||
FProcess.FBreakMap.RemoveLocation(ALocation, Self);
|
||||
UpdateState;
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.RemoveAllAddresses;
|
||||
begin
|
||||
ResetBreak;
|
||||
SetLength(FLocation, 0);
|
||||
UpdateState;
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpoint.ResetBreak;
|
||||
@ -3616,6 +3806,8 @@ begin
|
||||
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.ResetBreak');{$ENDIF}
|
||||
if FProcess = nil then
|
||||
exit;
|
||||
|
||||
FEnabled := False;
|
||||
for i := 0 to High(FLocation) do
|
||||
FProcess.FBreakMap.RemoveLocation(FLocation[i], Self);
|
||||
end;
|
||||
@ -3627,26 +3819,57 @@ begin
|
||||
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.SetBreak');{$ENDIF}
|
||||
if FProcess = nil then
|
||||
exit;
|
||||
|
||||
FEnabled := True;
|
||||
for i := 0 to High(FLocation) do
|
||||
FProcess.FBreakMap.AddLocation(FLocation[i], Self, True);
|
||||
end;
|
||||
|
||||
{ TFpInternalBreakpointAtSymbol }
|
||||
|
||||
procedure TFpInternalBreakpointAtSymbol.UpdateState;
|
||||
begin
|
||||
if Length(FLocation) > 0 then
|
||||
SetState(bksOk)
|
||||
else
|
||||
SetState(bksPending);
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpointAtSymbol.UpdateForLibraryLoaded(ALib: TDbgLibrary
|
||||
);
|
||||
var
|
||||
a: TDBGPtrArray;
|
||||
AProcList: TFpSymbolArray;
|
||||
i: Integer;
|
||||
begin
|
||||
if FSymInstance <> nil then // Can not be the newly created ...
|
||||
exit;
|
||||
|
||||
FProcess.FindProcSymbol(FFuncName, ALib, AProcList);
|
||||
SetLength(a, Length(AProcList));
|
||||
for i := 0 to Length(AProcList) - 1 do begin
|
||||
a[i] := AProcList[i].Address.Address;
|
||||
AProcList[i].ReleaseReference;
|
||||
end;
|
||||
|
||||
AddAddress(a);
|
||||
end;
|
||||
|
||||
constructor TFpInternalBreakpointAtSymbol.Create(const AProcess: TDbgProcess;
|
||||
const AFuncName: String; AnEnabled: Boolean; ASymInstance: TDbgInstance);
|
||||
var
|
||||
a: TDBGPtrArray;
|
||||
AProc: TFpSymbol;
|
||||
AProcList: TFpSymbolArray;
|
||||
i: Integer;
|
||||
begin
|
||||
FFuncName := AFuncName;
|
||||
FSymInstance := ASymInstance;
|
||||
|
||||
a := nil;
|
||||
AProc := AProcess.FindProcSymbol(AFuncName, ASymInstance);
|
||||
if AProc <> nil then begin
|
||||
SetLength(a, 1);
|
||||
a[0] := AProc.Address.Address;
|
||||
AProc.ReleaseReference;
|
||||
AProcess.FindProcSymbol(AFuncName, ASymInstance, AProcList);
|
||||
SetLength(a, Length(AProcList));
|
||||
for i := 0 to Length(AProcList) - 1 do begin
|
||||
a[i] := AProcList[i].Address.Address;
|
||||
AProcList[i].ReleaseReference;
|
||||
end;
|
||||
|
||||
inherited Create(AProcess, a, AnEnabled);
|
||||
@ -3654,6 +3877,32 @@ end;
|
||||
|
||||
{ TFpInternalBreakpointAtFileLine }
|
||||
|
||||
procedure TFpInternalBreakpointAtFileLine.UpdateState;
|
||||
begin
|
||||
if Length(FLocation) > 0 then
|
||||
SetState(bksOk)
|
||||
else
|
||||
if FFoundFileWithoutLine then
|
||||
SetState(bksFailed)
|
||||
else
|
||||
SetState(bksPending);
|
||||
end;
|
||||
|
||||
procedure TFpInternalBreakpointAtFileLine.UpdateForLibraryLoaded(
|
||||
ALib: TDbgLibrary);
|
||||
var
|
||||
addr: TDBGPtrArray;
|
||||
begin
|
||||
if FSymInstance <> nil then // Can not be the newly created ...
|
||||
exit;
|
||||
|
||||
addr := nil;
|
||||
FProcess.GetLineAddresses(FFileName, FLine, addr, ALib);
|
||||
if FProcess.FLastLineAddressesFoundFile and (Length(addr) = 0) then
|
||||
FFoundFileWithoutLine := True;
|
||||
AddAddress(addr);
|
||||
end;
|
||||
|
||||
constructor TFpInternalBreakpointAtFileLine.Create(const AProcess: TDbgProcess;
|
||||
const AFileName: String; ALine: Cardinal; AnEnabled: Boolean;
|
||||
ASymInstance: TDbgInstance);
|
||||
@ -3662,9 +3911,11 @@ var
|
||||
begin
|
||||
FFileName := AFileName;
|
||||
FLine := ALine;
|
||||
FSymInstance := ASymInstance;
|
||||
|
||||
addr := nil;
|
||||
AProcess.GetLineAddresses(AFileName, ALine, addr, ASymInstance);
|
||||
FFoundFileWithoutLine := AProcess.FLastLineAddressesFoundFile and (Length(addr) = 0);
|
||||
inherited Create(AProcess, addr, AnEnabled);
|
||||
end;
|
||||
|
||||
@ -3750,12 +4001,6 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFpInternalWatchpoint.BelongsToInstance(const AnInstance: TDbgInstance
|
||||
): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TFpInternalWatchpoint.SetBreak;
|
||||
var
|
||||
a: TDBGPtr;
|
||||
|
||||
@ -1750,7 +1750,7 @@ var
|
||||
EventProcess: TDbgProcess;
|
||||
DummyThread: TDbgThread;
|
||||
CurCmd: TDbgControllerCmd;
|
||||
|
||||
ALib: TDbgLibrary;
|
||||
begin
|
||||
AExit:=false;
|
||||
if FCurrentProcess = nil then begin
|
||||
@ -1886,6 +1886,15 @@ begin
|
||||
if MaybeDetach then
|
||||
break;
|
||||
|
||||
case FPDEvent of
|
||||
deLoadLibrary:
|
||||
for ALib in EventProcess.LastLibrariesLoaded do
|
||||
EventProcess.UpdateBreakpointsForLibraryLoaded(ALib);
|
||||
deUnloadLibrary:
|
||||
for ALib in EventProcess.LastLibrariesUnloaded do
|
||||
EventProcess.UpdateBreakpointsForLibraryUnloaded(ALib);
|
||||
end;
|
||||
|
||||
IsFinished:=false;
|
||||
if FPDEvent=deExitProcess then begin
|
||||
FreeAndNil(FCommand);
|
||||
@ -2061,10 +2070,6 @@ begin
|
||||
continue:=true;
|
||||
if assigned(OnLibraryUnloadedEvent) and (Length(FCurrentProcess.LastLibrariesUnloaded)>0) then
|
||||
OnLibraryUnloadedEvent(continue, FCurrentProcess.LastLibrariesUnloaded);
|
||||
// The library is unloaded by the OS, so all breakpoints are already gone.
|
||||
// This is more to update our administration and free some memory.
|
||||
for i := 0 to High(FCurrentProcess.LastLibrariesUnloaded) do
|
||||
FCurrentProcess.RemoveAllBreakPoints(FCurrentProcess.LastLibrariesUnloaded[i]);
|
||||
end;
|
||||
deInternalContinue:
|
||||
begin
|
||||
|
||||
@ -731,7 +731,7 @@ type
|
||||
function GetDefinition(AAbbrevPtr: Pointer; out ADefinition: TDwarfAbbrev): Boolean; inline;
|
||||
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
|
||||
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray;
|
||||
AFindSibling: TGetLineAddrFindSibling = fsNone; AFoundLine: PInteger = nil): boolean;
|
||||
AFindSibling: TGetLineAddrFindSibling = fsNone; AFoundLine: PInteger = nil; AFoundFilename: PBoolean = nil): boolean;
|
||||
procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean);
|
||||
// On Darwin it could be that the debug-information is not included into the executable by the linker.
|
||||
// This function is to map object-file addresses into the corresponding addresses in the executable.
|
||||
@ -808,7 +808,7 @@ type
|
||||
|
||||
//function FindSymbol(const AName: String): TDbgSymbol; override; overload;
|
||||
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray;
|
||||
AFindSibling: TGetLineAddrFindSibling = fsNone; AFoundLine: PInteger = nil): Boolean; override;
|
||||
AFindSibling: TGetLineAddrFindSibling = fsNone; AFoundLine: PInteger = nil; AFoundFilename: PBoolean = nil): Boolean; override;
|
||||
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
|
||||
procedure LoadCallFrameInstructions;
|
||||
function LoadCompilationUnits: Integer;
|
||||
@ -3891,7 +3891,8 @@ end;
|
||||
|
||||
function TFpDwarfInfo.GetLineAddresses(const AFileName: String;
|
||||
ALine: Cardinal; var AResultList: TDBGPtrArray;
|
||||
AFindSibling: TGetLineAddrFindSibling; AFoundLine: PInteger): Boolean;
|
||||
AFindSibling: TGetLineAddrFindSibling; AFoundLine: PInteger;
|
||||
AFoundFilename: PBoolean): Boolean;
|
||||
var
|
||||
n: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
@ -3901,7 +3902,7 @@ begin
|
||||
begin
|
||||
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
|
||||
CU.WaitForScopeScan;
|
||||
Result := CU.GetLineAddresses(AFileName, ALine, AResultList, AFindSibling, AFoundLine) or Result;
|
||||
Result := CU.GetLineAddresses(AFileName, ALine, AResultList, AFindSibling, AFoundLine, AFoundFilename) or Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -5140,13 +5141,18 @@ end;
|
||||
|
||||
function TDwarfCompilationUnit.GetLineAddresses(const AFileName: String;
|
||||
ALine: Cardinal; var AResultList: TDBGPtrArray;
|
||||
AFindSibling: TGetLineAddrFindSibling; AFoundLine: PInteger): boolean;
|
||||
AFindSibling: TGetLineAddrFindSibling; AFoundLine: PInteger;
|
||||
AFoundFilename: PBoolean): boolean;
|
||||
var
|
||||
Map: PDWarfLineMap;
|
||||
begin
|
||||
Result := False;
|
||||
Map := GetLineAddressMap(AFileName);
|
||||
if Map = nil then exit;
|
||||
if Map = nil then
|
||||
exit;
|
||||
|
||||
if AFoundFilename <> nil then
|
||||
AFoundFilename^ := True;
|
||||
Result := Map^.GetAddressesForLine(ALine, AResultList, False, AFindSibling, AFoundLine);
|
||||
end;
|
||||
|
||||
|
||||
@ -495,6 +495,8 @@ type
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope; virtual;
|
||||
end;
|
||||
|
||||
TFpSymbolArray = array of TFpSymbol;
|
||||
|
||||
{ TFpSymbolForwarder }
|
||||
|
||||
TFpSymbolForwarder = class(TFpSymbol)
|
||||
@ -648,7 +650,7 @@ type
|
||||
|
||||
property HasInfo: Boolean read FHasInfo;
|
||||
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray;
|
||||
AFindSibling: TGetLineAddrFindSibling = fsNone; AFoundLine: PInteger = nil): Boolean; virtual;
|
||||
AFindSibling: TGetLineAddrFindSibling = fsNone; AFoundLine: PInteger = nil; AFoundFilename: PBoolean = nil): Boolean; virtual;
|
||||
//property MemManager: TFpDbgMemReaderBase read GetMemManager write SetMemManager;
|
||||
property TargetInfo: TTargetDescriptor read FTargetInfo write FTargetInfo;
|
||||
property MemManager: TFpDbgMemManager read FMemManager;
|
||||
@ -1969,7 +1971,7 @@ end;
|
||||
|
||||
function TDbgInfo.GetLineAddresses(const AFileName: String; ALine: Cardinal;
|
||||
var AResultList: TDBGPtrArray; AFindSibling: TGetLineAddrFindSibling;
|
||||
AFoundLine: PInteger): Boolean;
|
||||
AFoundLine: PInteger; AFoundFilename: PBoolean): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
@ -1127,13 +1127,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TDbgLinuxProcess.AddLib(const ALibrary: tDbgLinuxLibrary);
|
||||
var
|
||||
ID: TDbgPtr;
|
||||
begin
|
||||
ID := ALibrary.FLoadedTargetImageAddr;
|
||||
FLibMap.Add(ID, ALibrary);
|
||||
if (ALibrary.DbgInfo.HasInfo) or (ALibrary.SymbolTableInfo.HasInfo) then
|
||||
FSymInstances.Add(ALibrary);
|
||||
AddLibrary(ALibrary, ALibrary.FLoadedTargetImageAddr);
|
||||
end;
|
||||
|
||||
constructor TDbgLinuxProcess.Create(const AFileName: string;
|
||||
|
||||
@ -1474,14 +1474,9 @@ begin
|
||||
end;
|
||||
|
||||
function TDbgWinProcess.AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;
|
||||
var
|
||||
ID: TDbgPtr;
|
||||
begin
|
||||
Result := TDbgWinLibrary.Create(Self, HexValue(AInfo.lpBaseOfDll, SizeOf(Pointer), [hvfIncludeHexchar]), AInfo.hFile, AInfo);
|
||||
ID := TDbgPtr(AInfo.lpBaseOfDll);
|
||||
FLibMap.Add(ID, Result);
|
||||
if (Result.DbgInfo.HasInfo) or (Result.SymbolTableInfo.HasInfo)
|
||||
then FSymInstances.Add(Result);
|
||||
AddLibrary(Result, TDbgPtr(AInfo.lpBaseOfDll));
|
||||
end;
|
||||
|
||||
procedure TDbgWinProcess.RemoveLib(const AInfo: TUnloadDLLDebugInfo);
|
||||
|
||||
@ -315,6 +315,12 @@ type
|
||||
// procedure ClearState;
|
||||
end;
|
||||
|
||||
TBreakPointUpdateInfo = record
|
||||
InternalBreak: TFpDbgBreakpoint;
|
||||
NewState: TFpDbgBreakpointState;
|
||||
end;
|
||||
TBreakPointUpdateList = specialize TLazThreadedQueue<TBreakPointUpdateInfo>;
|
||||
|
||||
TThreadIdList = specialize TFPGList<Integer>;
|
||||
|
||||
{ TFpDebugDebugger }
|
||||
@ -346,6 +352,7 @@ type
|
||||
FCachePointer: pointer;
|
||||
FCacheThreadId, FCacheStackFrame: Integer;
|
||||
FCacheContext: TFpDbgSymbolScope;
|
||||
FBreakUpdateList: TBreakPointUpdateList;
|
||||
FFpDebugOutputQueue: TFpDebugStringQueue;
|
||||
FFpDebugOutputAsync: integer;
|
||||
//
|
||||
@ -360,6 +367,9 @@ type
|
||||
// HandleRunError: Software called RuntimeError
|
||||
procedure HandleRunError(var continue: boolean);
|
||||
procedure FreeDebugThread;
|
||||
procedure Do_Thread_BreakStateChanged(Sender: TFpDbgBreakpoint; ANewState: TFpDbgBreakpointState);
|
||||
procedure DoBreakStateChanged(Data: PtrInt);
|
||||
|
||||
procedure FDbgControllerHitBreakpointEvent(var continue: boolean;
|
||||
const Breakpoint: TFpDbgBreakpoint; AnEventType: TFPDEvent; AMoreHitEventsPending: Boolean);
|
||||
procedure EnterPause(ALocationAddr: TDBGLocationRec; AnInternalPause: Boolean = False);
|
||||
@ -1131,8 +1141,15 @@ begin
|
||||
FDbgBreakPoint.FInternalBreakpoint := InternalBreakpoint;
|
||||
if not assigned(InternalBreakpoint) then
|
||||
FDbgBreakPoint.Validity := vsInvalid // pending?
|
||||
else
|
||||
FDbgBreakPoint.Validity := vsValid;
|
||||
else begin
|
||||
case InternalBreakpoint.State of
|
||||
bksUnknown: FDbgBreakPoint.Validity := vsUnknown;
|
||||
bksOk: FDbgBreakPoint.Validity := vsValid;
|
||||
bksFailed: FDbgBreakPoint.Validity := vsInvalid;
|
||||
bksPending: FDbgBreakPoint.Validity := vsPending;
|
||||
end;
|
||||
InternalBreakpoint.On_Thread_StateChange := @TFpDebugDebugger(FDebugger).Do_Thread_BreakStateChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
UnQueue_DecRef;
|
||||
@ -1920,6 +1937,7 @@ begin
|
||||
// freed. And so are the corresponding InternalBreakpoint's.
|
||||
if assigned(Debugger) and assigned(FInternalBreakpoint) then
|
||||
begin
|
||||
FInternalBreakpoint.On_Thread_StateChange := nil;
|
||||
debuglnEnter(DBG_BREAKPOINTS, ['>> TFPBreakpoint.ResetBreak REMOVE ',FSource,':',FLine,'/',dbghex(Address),' ' ]);
|
||||
WorkItem := TFpThreadWorkerBreakPointRemoveUpdate.Create(TFpDebugDebugger(Debugger), Self);
|
||||
TFpDebugDebugger(Debugger).FWorkQueue.PushItem(WorkItem);
|
||||
@ -2018,6 +2036,8 @@ end;
|
||||
|
||||
destructor TFPBreakpoint.Destroy;
|
||||
begin
|
||||
if FInternalBreakpoint <> nil then
|
||||
FInternalBreakpoint.On_Thread_StateChange := nil;
|
||||
(* No need to request a pause. This will run, as soon as the debugger gets to the next pause.
|
||||
If the next pause is a hit on this breakpoint, then it will be ignored
|
||||
*)
|
||||
@ -3680,6 +3700,33 @@ begin
|
||||
DoProcessMessages // run the AsyncMethods
|
||||
end;
|
||||
|
||||
procedure TFpDebugDebugger.Do_Thread_BreakStateChanged(
|
||||
Sender: TFpDbgBreakpoint; ANewState: TFpDbgBreakpointState);
|
||||
var
|
||||
Info: TBreakPointUpdateInfo;
|
||||
begin
|
||||
Info.InternalBreak := Sender;
|
||||
Info.NewState := ANewState;
|
||||
FBreakUpdateList.PushItem(Info);
|
||||
Application.QueueAsyncCall(@DoBreakStateChanged, 0);
|
||||
end;
|
||||
|
||||
procedure TFpDebugDebugger.DoBreakStateChanged(Data: PtrInt);
|
||||
var
|
||||
Info: TBreakPointUpdateInfo;
|
||||
ABreakPoint: TDBGBreakPoint;
|
||||
begin
|
||||
while FBreakUpdateList.PopItemTimeout(Info, 0) = wrSignaled do begin
|
||||
ABreakPoint := TFPBreakpoints(BreakPoints).Find(Info.InternalBreak);
|
||||
case Info.NewState of
|
||||
bksUnknown: TFPBreakpoint(ABreakPoint).Validity := vsUnknown;
|
||||
bksOk: TFPBreakpoint(ABreakPoint).Validity := vsValid;
|
||||
bksFailed: TFPBreakpoint(ABreakPoint).Validity := vsInvalid;
|
||||
bksPending: TFPBreakpoint(ABreakPoint).Validity := vsPending;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(
|
||||
var continue: boolean; const Breakpoint: TFpDbgBreakpoint;
|
||||
AnEventType: TFPDEvent; AMoreHitEventsPending: Boolean);
|
||||
@ -4453,6 +4500,7 @@ begin
|
||||
FWorkQueue := TFpThreadPriorityWorkerQueue.Create(100);
|
||||
FWorkQueue.OnQueueIdle := @CheckAndRunIdle;
|
||||
FFpDebugOutputQueue := TFpDebugStringQueue.create(100);
|
||||
FBreakUpdateList := TBreakPointUpdateList.create();
|
||||
FExceptionStepper := TFpDebugExceptionStepping.Create(Self);
|
||||
FPrettyPrinter := TFpPascalPrettyPrinter.Create(sizeof(pointer));
|
||||
FMemReader := TFpDbgMemReader.Create(self);
|
||||
@ -4495,6 +4543,7 @@ begin
|
||||
|
||||
Application.RemoveAsyncCalls(Self);
|
||||
FreeAndNil(FFpDebugOutputQueue);
|
||||
FreeAndNil(FBreakUpdateList);
|
||||
FreeAndNil(FDbgController);
|
||||
FreeAndNil(FPrettyPrinter);
|
||||
FreeAndNil(FMemManager);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user