From b34bc4a730a42c7905347d599e0cc0e36a3bc191 Mon Sep 17 00:00:00 2001 From: martin Date: Sun, 8 Dec 2019 00:18:10 +0000 Subject: [PATCH] FpDebug, LazDebuggerFp: Implemented OnLibrary(Un)LoadedEvent / Show in event log git-svn-id: trunk@62340 - --- components/fpdebug/fpdbgclasses.pp | 52 +++++++++++++++++-- components/fpdebug/fpdbgcontroller.pas | 15 ++++++ components/fpdebug/fpdbgwinclasses.pas | 4 +- .../lazdebuggerfp/fpdebugdebugger.pas | 24 +++++++++ 4 files changed, 89 insertions(+), 6 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 7a4de3e43f..c57688d611 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -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 diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index e87ab0a5bd..efe75b747c 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -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 diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index 042552c85f..fa6618a708 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/components/fpdebug/fpdbgwinclasses.pas @@ -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 } diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index cdf7bfbd33..8ad09fdcab 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -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;