paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-13 18:29:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug, LazDebuggerFp: Implemented OnLibrary(Un)LoadedEvent / Show in event log

Browse Source 
git-svn-id: trunk@62340 -
This commit is contained in:
martin 2019-12-08 00:18:10 +00:00
parent 9cd1e928d5
commit b34bc4a730
4 changed files with 89 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
components/fpdebug/fpdbgclasses.pp
View File

@ -46,7 +46,7 @@ uses
FpDbgDwarfDataClasses, FpDbgDisasX86;
type
TFPDEvent = (deExitProcess, deFinishedStep, deBreakpoint, deException, deCreateProcess, deLoadLibrary, deInternalContinue);
TFPDEvent = (deExitProcess, deFinishedStep, deBreakpoint, deException, deCreateProcess, deLoadLibrary, deUnloadLibrary, deInternalContinue);
TFPDMode = (dm32, dm64);
TFPDCompareStepInfo = (dcsiNewLine, dcsiSameLine, dcsiNoLineInfo, dcsiZeroLine);
@ -86,6 +86,7 @@ type
{ TDbgCallstackEntry }
TDbgThread = class;
TFPDThreadArray = array of TDbgThread;
TDbgLibrary = class;
TDbgCallstackEntry = class
private
@ -201,6 +202,16 @@ type
function GetEnumerator: TThreadMapEnumerator;
end;
{ TLibraryMap }
TLibraryMap = class(TMap)
private
FLastLibraryAdded: TDbgLibrary;
public
procedure Add(const AId, AData);
property LastLibraryAdded: TDbgLibrary read FLastLibraryAdded;
end;
TFpInternalBreakpointArray = array of TFpInternalBreakpoint;
{ TBreakLocationEntry }
@ -377,10 +388,12 @@ type
FExceptionMessage: string;
FExitCode: DWord;
FGotExitProcess: Boolean;
FLastLibraryUnloaded: TDbgLibrary;
FProcessID: Integer;
FThreadID: Integer;
FWatchPointData: TFpWatchPointData;
function GetLastLibraryLoaded: TDbgLibrary;
function GetPauseRequested: boolean;
procedure SetPauseRequested(AValue: boolean);
procedure ThreadDestroyed(const AThread: TDbgThread);
@ -395,7 +408,7 @@ type
FSymInstances: TList; // list of dbgInstances with debug info
FThreadMap: TThreadMap; // map ThreadID -> ThreadObject
FLibMap: TMap; // map LibAddr -> LibObject
FLibMap: TLibraryMap; // map LibAddr -> LibObject
FBreakMap: TBreakLocationMap; // map BreakAddr -> BreakObject
FTmpRemovedBreaks: array of TDBGPtr;
FPauseRequested: longint;
@ -406,6 +419,8 @@ type
procedure SetExitCode(AValue: DWord);
function GetLastEventProcessIdentifier: THandle; virtual;
function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
procedure SetLastLibraryUnloaded(ALib: TDbgLibrary);
procedure SetLastLibraryUnloadedNil(ALib: TDbgLibrary);
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; //virtual;
function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; //virtual;
@ -444,6 +459,8 @@ public
function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; deprecated 'use FindContext(thread,stack)';
function ContextFromProc(AThreadId, AStackFrame: Integer; AProcSym: TFpSymbol): TFpDbgInfoContext; inline;
function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
property LastLibraryLoaded: TDbgLibrary read GetLastLibraryLoaded;
property LastLibraryUnloaded: TDbgLibrary read FLastLibraryUnloaded write SetLastLibraryUnloadedNil;
function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
procedure RemoveBreak(const ABreakPoint: TFpDbgBreakpoint);
procedure DoBeforeBreakLocationMapChange;
@ -549,7 +566,7 @@ var
const
DBGPTRSIZE: array[TFPDMode] of Integer = (4, 8);
FPDEventNames: array[TFPDEvent] of string = ('deExitProcess', 'deFinishedStep', 'deBreakpoint', 'deException', 'deCreateProcess', 'deLoadLibrary', 'deInternalContinue');
FPDEventNames: array[TFPDEvent] of string = ('deExitProcess', 'deFinishedStep', 'deBreakpoint', 'deException', 'deCreateProcess', 'deLoadLibrary', 'deUnloadLibrary', 'deInternalContinue');
function OSDbgClasses: TOSDbgClasses;
@ -618,6 +635,14 @@ begin
Result := TThreadMapEnumerator.Create(Self);
end;
{ TLibraryMap }
procedure TLibraryMap.Add(const AId, AData);
begin
inherited Add(AId, AData);
FLastLibraryAdded := TDbgLibrary(AData);
end;
{ TBreakLocationEntry }
function TBreakLocationEntry.OrigValue: Byte;
@ -1216,7 +1241,7 @@ begin
FBreakpointList := TFpInternalBreakpointList.Create(False);
FWatchPointList := TFpInternalBreakpointList.Create(False);
FThreadMap := TThreadMap.Create(itu4, SizeOf(TDbgThread));
FLibMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgLibrary));
FLibMap := TLibraryMap.Create(MAP_ID_SIZE, SizeOf(TDbgLibrary));
FWatchPointData := CreateWatchPointData;
FBreakMap := TBreakLocationMap.Create(Self);
FCurrentBreakpoint := nil;
@ -1254,6 +1279,7 @@ var
i: Integer;
begin
FProcessID:=0;
SetLastLibraryUnloaded(nil);
for i := 0 to FBreakpointList.Count - 1 do
FBreakpointList[i].FProcess := nil;
@ -1658,6 +1684,11 @@ begin
Result := Boolean(InterLockedExchangeAdd(FPauseRequested, 0));
end;
function TDbgProcess.GetLastLibraryLoaded: TDbgLibrary;
begin
Result := FLibMap.LastLibraryAdded;
end;
function TDbgProcess.GetAndClearPauseRequested: Boolean;
begin
Result := Boolean(InterLockedExchange(FPauseRequested, ord(False)));
@ -1704,6 +1735,19 @@ begin
then FCurrentBreakpoint := nil; // no need for a singlestep if we continue
end;
procedure TDbgProcess.SetLastLibraryUnloaded(ALib: TDbgLibrary);
begin
if FLastLibraryUnloaded <> nil then
FLastLibraryUnloaded.Destroy;
FLastLibraryUnloaded := ALib;
end;
procedure TDbgProcess.SetLastLibraryUnloadedNil(ALib: TDbgLibrary);
begin
assert(ALib = nil, 'TDbgProcess.SetLastLibraryUnloadedNil: ALib = nil');
SetLastLibraryUnloaded(nil);
end;
function TDbgProcess.InsertBreakInstructionCode(const ALocation: TDBGPtr; out
OrigValue: Byte): Boolean;
var

15
components/fpdebug/fpdbgcontroller.pas
View File

@ -20,6 +20,8 @@ type
TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TFpDbgBreakpoint) of object;
TOnExceptionEvent = procedure(var continue: boolean; const ExceptionClass, ExceptionMessage: string) of object;
TOnProcessExitEvent = procedure(ExitCode: DWord) of object;
TOnLibraryLoadedEvent = procedure(var continue: boolean; ALib: TDbgLibrary) of object;
TOnLibraryUnloadedEvent = procedure(var continue: boolean; ALib: TDbgLibrary) of object;
TDbgController = class;
@ -168,6 +170,8 @@ type
TDbgController = class
private
FOnLibraryLoadedEvent: TOnLibraryLoadedEvent;
FOnLibraryUnloadedEvent: TOnLibraryUnloadedEvent;
FRunning, FPauseRequest: cardinal;
FAttachToPid: Integer;
FDetaching: cardinal;
@ -239,6 +243,8 @@ type
property OnProcessExitEvent: TOnProcessExitEvent read FOnProcessExitEvent write FOnProcessExitEvent;
property OnExceptionEvent: TOnExceptionEvent read FOnExceptionEvent write FOnExceptionEvent;
property OnDebugInfoLoaded: TNotifyEvent read FOnDebugInfoLoaded write FOnDebugInfoLoaded;
property OnLibraryLoadedEvent: TOnLibraryLoadedEvent read FOnLibraryLoadedEvent write FOnLibraryLoadedEvent;
property OnLibraryUnloadedEvent: TOnLibraryUnloadedEvent read FOnLibraryUnloadedEvent write FOnLibraryUnloadedEvent;
end;
implementation
@ -1259,6 +1265,15 @@ begin
deLoadLibrary:
begin
continue:=true;
if assigned(OnLibraryLoadedEvent) and Assigned(FCurrentProcess.LastLibraryLoaded) then
OnLibraryLoadedEvent(continue, FCurrentProcess.LastLibraryLoaded);
end;
deUnloadLibrary:
begin
continue:=true;
if assigned(OnLibraryUnloadedEvent) and Assigned(FCurrentProcess.LastLibraryUnloaded) then
OnLibraryUnloadedEvent(continue, FCurrentProcess.LastLibraryUnloaded);
FCurrentProcess.LastLibraryUnloaded := nil;
end;
deInternalContinue:
begin

4
components/fpdebug/fpdbgwinclasses.pas
View File

@ -1177,7 +1177,7 @@ begin
end;
UNLOAD_DLL_DEBUG_EVENT: begin
//DumpEvent('UNLOAD_DLL_DEBUG_EVENT');
result := deInternalContinue;
result := deUnloadLibrary;
end;
OUTPUT_DEBUG_STRING_EVENT: begin
//DumpEvent('OUTPUT_DEBUG_STRING_EVENT');
@ -1300,7 +1300,7 @@ begin
if not FLibMap.GetData(ID, Lib) then Exit;
FSymInstances.Remove(Lib);
FLibMap.Delete(ID);
Lib.Free;
SetLastLibraryUnloaded(Lib);
end;
{ TDbgWinThread }

24
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -110,6 +110,8 @@ type
procedure FDbgControllerProcessExitEvent(AExitCode: DWord);
procedure FDbgControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string);
procedure FDbgControllerDebugInfoLoaded(Sender: TObject);
procedure FDbgControllerLibraryLoaded(var continue: boolean; ALib: TDbgLibrary);
procedure FDbgControllerLibraryUnloaded(var continue: boolean; ALib: TDbgLibrary);
function GetDebugInfo: TDbgInfo;
procedure DoWatchFreed(Sender: TObject);
procedure ProcessASyncWatches({%H-}Data: PtrInt);
@ -1587,6 +1589,26 @@ begin
end;
end;
procedure TFpDebugDebugger.FDbgControllerLibraryLoaded(var continue: boolean;
ALib: TDbgLibrary);
var
n: String;
AProc: TFpSymbol;
AnAddr: TDBGPtr;
begin
n := ExtractFileName(ALib.Name);
DoDbgEvent(ecModule, etModuleLoad, 'Loaded: ' + n + ' (' + ALib.Name +')');
end;
procedure TFpDebugDebugger.FDbgControllerLibraryUnloaded(var continue: boolean;
ALib: TDbgLibrary);
var
n: String;
begin
n := ExtractFileName(ALib.Name);
DoDbgEvent(ecModule, etModuleUnload, 'Unloaded: ' + n + ' (' + ALib.Name +')');
end;
procedure TFpDebugDebugger.DoWatchFreed(Sender: TObject);
begin
FWatchEvalList.Remove(pointer(Sender));
@ -2332,6 +2354,8 @@ begin
FDbgController.OnProcessExitEvent:=@FDbgControllerProcessExitEvent;
FDbgController.OnExceptionEvent:=@FDbgControllerExceptionEvent;
FDbgController.OnDebugInfoLoaded := @FDbgControllerDebugInfoLoaded;
FDbgController.OnLibraryLoadedEvent := @FDbgControllerLibraryLoaded;
FDbgController.OnLibraryUnloadedEvent := @FDbgControllerLibraryUnloaded;
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
end;