FpDebug: Remove breakpoints bound to a specific library when this library gets unloaded

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];
+    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];
+    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;

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

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.
 

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

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} );