diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 4c65423ec9..3c0b37ed8b 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -88,6 +88,7 @@ type { TDbgCallstackEntry } TDbgThread = class; TFPDThreadArray = array of TDbgThread; + TDbgInstance = class; TDbgLibrary = class; TOSDbgClasses = class; TDbgAsmInstruction = class; @@ -366,6 +367,8 @@ type 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; @@ -404,6 +407,7 @@ type 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 RemoveAddress(const ALocation: TDBGPtr); override; @@ -481,6 +485,11 @@ type function FindProcSymbol(AAdress: TDbgPtr): TFpSymbol; overload; function FindProcStartEndPC(AAdress: TDbgPtr; out AStartPC, AEndPC: TDBGPtr): boolean; + // Check if a certain (range of) address(es) belongs to a specific Instance + // (for example a library) + function EnclosesAddress(AnAddress: TDBGPtr): Boolean; + function EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; + procedure LoadInfo; virtual; property Process: TDbgProcess read FProcess; @@ -599,7 +608,6 @@ type function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; virtual; function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; virtual; - procedure RemoveAllBreakPoints; procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer); virtual; procedure AfterChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer); virtual; @@ -671,6 +679,11 @@ type function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; virtual; abstract; function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; + // 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); + function CheckForConsoleOutput(ATimeOutMs: integer): integer; virtual; function GetConsoleOutput: string; virtual; procedure SendConsoleInput(AString: string); virtual; @@ -1676,6 +1689,16 @@ begin Result := FDbgInfo.FindProcStartEndPC(AAdress, AStartPC, AEndPC); end; +function TDbgInstance.EnclosesAddress(AnAddress: TDBGPtr): Boolean; +begin + EnclosesAddressRange(AnAddress, AnAddress); +end; + +function TDbgInstance.EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; +begin + Result := FLoaderList.EnclosesAddressRange(AStartAddress, AnEndAddress); +end; + procedure TDbgInstance.LoadInfo; begin InitializeLoaders; @@ -2410,7 +2433,7 @@ begin AfterChangingInstructionCode(ALocation, 1); end; -procedure TDbgProcess.RemoveAllBreakPoints; +procedure TDbgProcess.RemoveAllBreakPoints(const OnlyForLibrary: TDbgLibrary = nil); var i: LongInt; b: TFpInternalBreakBase; @@ -2418,20 +2441,24 @@ begin i := FBreakpointList.Count - 1; while i >= 0 do begin b := FBreakpointList[i]; - b.ResetBreak; - b.FProcess := nil; - FBreakpointList.Delete(i); + if not Assigned(OnlyForLibrary) or b.BelongsToInstance(OnlyForLibrary) then begin + b.ResetBreak; + b.FProcess := nil; + FBreakpointList.Delete(i); + end; dec(i); end; i := FWatchPointList.Count - 1; while i >= 0 do begin b := FWatchPointList[i]; - b.ResetBreak; - b.FProcess := nil; - FWatchPointList.Delete(i); + if not Assigned(OnlyForLibrary) or b.BelongsToInstance(OnlyForLibrary) then begin + b.ResetBreak; + b.FProcess := nil; + FWatchPointList.Delete(i); + end; dec(i); end; - assert(FBreakMap.Count = 0, 'TDbgProcess.RemoveAllBreakPoints: FBreakMap.Count = 0'); + assert(Assigned(OnlyForLibrary) or (FBreakMap.Count = 0), 'TDbgProcess.RemoveAllBreakPoints: FBreakMap.Count = 0'); end; procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer); @@ -3219,6 +3246,30 @@ 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; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 5e98b267b5..bbbc9f439d 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -1778,6 +1778,7 @@ procedure TDbgController.SendEvents(out continue: boolean); var HasPauseRequest: Boolean; CurWatch: TFpInternalWatchpoint; + i: Integer; begin // reset pause request. If Pause() is called after this, it will be seen in the next loop HasPauseRequest := InterLockedExchange(FPauseRequest, 0) = 1; @@ -1881,6 +1882,10 @@ 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 diff --git a/components/fpdebug/fpdbgloader.pp b/components/fpdebug/fpdbgloader.pp index 8cb3064a98..1976221005 100644 --- a/components/fpdebug/fpdbgloader.pp +++ b/components/fpdebug/fpdbgloader.pp @@ -84,6 +84,8 @@ type procedure CloseFileLoader; procedure AddToLoaderList(ALoaderList: TDbgImageLoaderList); function IsValid: Boolean; + function EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; + property FileName: String read FFileName; // Empty if using USE_WIN_FILE_MAPPING property ImageBase: QWord read GetImageBase; property RelocationOffset: TDBGPtrOffset read GetRelocationOffset; @@ -118,6 +120,8 @@ type function GetItem(Index: Integer): TDbgImageLoader; procedure SetItem(Index: Integer; AValue: TDbgImageLoader); public + function EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; + property Items[Index: Integer]: TDbgImageLoader read GetItem write SetItem; default; property ImageBase: QWord read GetImageBase; property RelocationOffset: TDBGPtrOffset read GetRelocationOffset; @@ -165,6 +169,16 @@ begin inherited SetItem(Index, AValue); end; +function TDbgImageLoaderList.EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; +var + i: Integer; +begin + for i := 0 to Count -1 do + if Items[0].EnclosesAddressRange(AStartAddress, AnEndAddress) then + Exit(True); + Result := False; +end; + { TDbgImageLoaderLibrary } procedure TDbgImageLoaderLibrary.ParseSymbolTable(AFpSymbolInfo: TfpSymbolList); @@ -305,5 +319,13 @@ begin Result := FImgReader <> nil; end; +function TDbgImageLoader.EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; +begin + Result := False; + if not IsValid then + Exit; + Result := FImgReader.EnclosesAddressRange(AStartAddress, AnEndAddress); +end; + end. diff --git a/components/fpdebug/fpimgreaderbase.pas b/components/fpdebug/fpimgreaderbase.pas index e51ea76092..9aec9dc60b 100644 --- a/components/fpdebug/fpimgreaderbase.pas +++ b/components/fpdebug/fpimgreaderbase.pas @@ -130,6 +130,7 @@ type // LoadedTargetImageAddr. constructor Create({%H-}ASource: TDbgFileLoader; {%H-}ADebugMap: TObject; ALoadedTargetImageAddr: TDbgPtr; OwnSource: Boolean); virtual; procedure AddSubFilesToLoaderList(ALoaderList: TObject; PrimaryLoader: TObject); virtual; + function EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; virtual; // The ImageBase is the address at which the linker assumed the binary will be // loaded at. So it is stored inside the binary itself and all addresses inside // the binary assume that once loaded into memory, it is loaded at this @@ -535,6 +536,10 @@ begin // end; +function TDbgImageReader.EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; +begin + Result := False; +end; procedure InitDebugInfoLists; begin diff --git a/components/fpdebug/fpimgreaderwinpe.pas b/components/fpdebug/fpimgreaderwinpe.pas index bc3e2fd3d5..2979a866c4 100644 --- a/components/fpdebug/fpimgreaderwinpe.pas +++ b/components/fpdebug/fpimgreaderwinpe.pas @@ -65,6 +65,7 @@ type public class function isValid(ASource: TDbgFileLoader): Boolean; override; class function UserName: AnsiString; override; + function EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; override; public constructor Create(ASource: TDbgFileLoader; ADebugMap: TObject; ALoadedTargetImageAddr: TDbgPtr; OwnSource: Boolean); override; destructor Destroy; override; @@ -527,6 +528,22 @@ begin Result:='PE file'; end; +function TPEFileSource.EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; +var + i: Integer; + ex: PDbgImageSectionEx; + s: PDbgImageSection; +begin + for i := 0 to FSections.Count - 1 do + begin + ex := PDbgImageSectionEx(FSections.Objects[i]); + s := @ex^.Sect; + if (s^.VirtualAddress+LoadedTargetImageAddr <= AStartAddress) and + (s^.VirtualAddress + s^.Size + LoadedTargetImageAddr >= AnEndAddress) then + Exit(True); + end; + Result := False; +end; initialization DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );