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

FpDebug: make TBreakLocationMap a generic with variable storage for the data replaced by a breakpoint

Browse Source
This commit is contained in:
Martin 2024-02-14 19:48:11 +01:00
parent 08b1ca8b65
commit 4b6fadabca
1 changed files with 53 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
components/fpdebug/fpdbgclasses.pp
View File

@ -34,7 +34,6 @@
unit FpDbgClasses; unit FpDbgClasses;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$TYPEDADDRESS on} {$TYPEDADDRESS on}
{$ModeSwitch typehelpers}
{$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF} {$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF}
{$IF FPC_Fullversion=30202}{$Optimization NOPEEPHOLE}{$ENDIF} {$IF FPC_Fullversion=30202}{$Optimization NOPEEPHOLE}{$ENDIF}
@ -445,6 +444,8 @@ type
strict private strict private
FProcess: TDbgProcess; FProcess: TDbgProcess;
private
class var DBG__VERBOSE, DBG__WARNINGS, DBG__BREAKPOINTS: PLazLoggerLogGroup;
strict protected strict protected
procedure NewMapEntry(out ALocData: PFpBreakPointMapEntry); virtual; abstract; procedure NewMapEntry(out ALocData: PFpBreakPointMapEntry); virtual; abstract;
procedure DisposeMapEntry(ALocData: PFpBreakPointMapEntry); virtual; abstract; procedure DisposeMapEntry(ALocData: PFpBreakPointMapEntry); virtual; abstract;
@ -476,36 +477,27 @@ type
procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData); virtual; abstract; procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData); virtual; abstract;
end; end;
{ TBreakLocationMap } { TGenericBreakLocationMap }
TBreakLocationMap = class(TFpBreakPointMap) generic TGenericBreakLocationMap<_BRK_STORE, _BREAK> = class(TFpBreakPointMap)
strict protected type strict protected type
{ TFpBreakPointMapLocDataPairHelper }
TFpBreakPointMapLocDataPairHelper = type helper for TFpBreakPointMapLocDataPair
function OrigValue: Byte;
function ErrorSetting: ByteBool;
end;
{ TInternalBreakLocationEntry } { TInternalBreakLocationEntry }
TInternalBreakLocationEntry = packed record TInternalBreakLocationEntry = packed record
BaseMapEntry: TFpBreakPointMapEntry; BaseMapEntry: TFpBreakPointMapEntry;
OrigValue: Byte; OrigValue: _BRK_STORE;
ErrorSetting: ByteBool; ErrorSetting: ByteBool;
end; end;
PInternalBreakLocationEntry = ^TInternalBreakLocationEntry; PInternalBreakLocationEntry = ^TInternalBreakLocationEntry;
private const
Int3: Byte = $CC;
private private
FTmpRemovedBreaks: array of TDBGPtr; FTmpRemovedBreaks: array of TDBGPtr;
class function OrigByteFromPointer(AData: Pointer): Byte; class function OrigByteFromPointer(AData: Pointer): _BRK_STORE;
class function ErrorSettingFromPointer(AData: Pointer): ByteBool; class function ErrorSettingFromPointer(AData: Pointer): ByteBool;
strict private strict private
function GetOrigValueAtLocation(const ALocation: TDBGPtr): Byte; // returns Int3, if there is no break at this location function GetOrigValueAtLocation(const ALocation: TDBGPtr): _BRK_STORE; // returns Int3, if there is no break at this location
procedure AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: Byte); procedure AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: _BRK_STORE);
strict protected strict protected
procedure NewMapEntry(out ALocData: PFpBreakPointMapEntry); override; procedure NewMapEntry(out ALocData: PFpBreakPointMapEntry); override;
procedure DisposeMapEntry(ALocData: PFpBreakPointMapEntry); override; procedure DisposeMapEntry(ALocData: PFpBreakPointMapEntry); override;
@ -527,6 +519,13 @@ type
procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData); override; procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData); override;
end; end;
TBreakInfoX86 = object
const
_CODE: Byte = $CC;
end;
TBreakLocationMap = specialize TGenericBreakLocationMap<Byte, TBreakInfoX86>;
{ TFpDbgBreakpoint } { TFpDbgBreakpoint }
TFpDbgBreakpoint = class; TFpDbgBreakpoint = class;
@ -1337,7 +1336,7 @@ procedure TFpBreakPointMap.Clear;
var var
LocDataPair: TFpBreakPointMapLocDataPair; LocDataPair: TFpBreakPointMapLocDataPair;
begin begin
debugln(DBG_VERBOSE or DBG_BREAKPOINTS, ['TBreakLocationMap.Clear ']); debugln(DBG_VERBOSE or DBG_BREAKPOINTS, ['TGenericBreakLocationMap.Clear ']);
for LocDataPair in Self do begin for LocDataPair in Self do begin
if LocDataPair.Data^.IsBreakList then if LocDataPair.Data^.IsBreakList then
TFpInternalBreakpointArray(LocDataPair.Data^.InternalBreakPoint) := nil; TFpInternalBreakpointArray(LocDataPair.Data^.InternalBreakPoint) := nil;
@ -1352,7 +1351,7 @@ var
Len, i: Integer; Len, i: Integer;
BList: TFpInternalBreakpointArray; BList: TFpInternalBreakpointArray;
begin begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.AddLocation');{$ENDIF} {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TGenericBreakLocationMap.AddLocation');{$ENDIF}
MapEntryPtr := GetDataPtr(ALocation); MapEntryPtr := GetDataPtr(ALocation);
if MapEntryPtr <> nil then begin if MapEntryPtr <> nil then begin
@ -1402,7 +1401,7 @@ var
MapEntryPtr: PFpBreakPointMapEntry; MapEntryPtr: PFpBreakPointMapEntry;
Len, i: Integer; Len, i: Integer;
begin begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.RemoveLocation');{$ENDIF} {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TGenericBreakLocationMap.RemoveLocation');{$ENDIF}
MapEntryPtr := GetDataPtr(ALocation); MapEntryPtr := GetDataPtr(ALocation);
if MapEntryPtr = nil then begin if MapEntryPtr = nil then begin
DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]); DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]);
@ -1461,41 +1460,29 @@ end;
function TFpBreakPointMap.GetEnumerator: TFpBreakPointMapEnumerator; function TFpBreakPointMap.GetEnumerator: TFpBreakPointMapEnumerator;
begin begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TBreakLocationMap.GetEnumerator');{$ENDIF} {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TGenericBreakLocationMap.GetEnumerator');{$ENDIF}
Result := TFpBreakPointMapEnumerator.Create(Self); Result := TFpBreakPointMapEnumerator.Create(Self);
end; end;
{ TBreakLocationMap.TFpBreakPointMapLocDataPairHelper } { TGenericBreakLocationMap }
function TBreakLocationMap.TFpBreakPointMapLocDataPairHelper.OrigValue: Byte; class function TGenericBreakLocationMap.OrigByteFromPointer(AData: Pointer): _BRK_STORE;
begin
Result := TBreakLocationMap.OrigByteFromPointer(Data);
end;
function TBreakLocationMap.TFpBreakPointMapLocDataPairHelper.ErrorSetting: ByteBool;
begin
Result := TBreakLocationMap.ErrorSettingFromPointer(Data);
end;
{ TBreakLocationMap }
class function TBreakLocationMap.OrigByteFromPointer(AData: Pointer): Byte;
begin begin
Result := PInternalBreakLocationEntry(AData)^.OrigValue; Result := PInternalBreakLocationEntry(AData)^.OrigValue;
end; end;
class function TBreakLocationMap.ErrorSettingFromPointer(AData: Pointer class function TGenericBreakLocationMap.ErrorSettingFromPointer(AData: Pointer
): ByteBool; ): ByteBool;
begin begin
Result := PInternalBreakLocationEntry(AData)^.ErrorSetting; Result := PInternalBreakLocationEntry(AData)^.ErrorSetting;
end; end;
constructor TBreakLocationMap.Create(AProcess: TDbgProcess); constructor TGenericBreakLocationMap.Create(AProcess: TDbgProcess);
begin begin
inherited Create(AProcess, SizeOf(TInternalBreakLocationEntry)); inherited Create(AProcess, SizeOf(TInternalBreakLocationEntry));
end; end;
procedure TBreakLocationMap.UpdateMapForNewTargetCode(const AAdress: TDbgPtr; procedure TGenericBreakLocationMap.UpdateMapForNewTargetCode(const AAdress: TDbgPtr;
const ASize: Cardinal; const AData); const ASize: Cardinal; const AData);
var var
i: Integer; i: Integer;
@ -1505,83 +1492,83 @@ begin
AdaptOriginalValueAtLocation(AAdress+i, PByte(@AData+i)^); AdaptOriginalValueAtLocation(AAdress+i, PByte(@AData+i)^);
end; end;
function TBreakLocationMap.GetOrigValueAtLocation(const ALocation: TDBGPtr function TGenericBreakLocationMap.GetOrigValueAtLocation(const ALocation: TDBGPtr
): Byte; ): _BRK_STORE;
var var
LocData: PInternalBreakLocationEntry; LocData: PInternalBreakLocationEntry;
begin begin
LocData := GetDataPtr(ALocation); LocData := GetDataPtr(ALocation);
if LocData = nil then begin if LocData = nil then begin
DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]); DebugLn(DBG__WARNINGS or DBG__BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]);
Result := Int3; Result := _BREAK._CODE;
exit; exit;
end; end;
Result := LocData^.OrigValue; Result := LocData^.OrigValue;
end; end;
function TBreakLocationMap.HasInsertedBreakInstructionAtLocation( function TGenericBreakLocationMap.HasInsertedBreakInstructionAtLocation(
const ALocation: TDBGPtr): Boolean; const ALocation: TDBGPtr): Boolean;
begin begin
Result := GetDataPtr(ALocation) <> nil; Result := GetDataPtr(ALocation) <> nil;
end; end;
function TBreakLocationMap.IsHardcodeBreakPoint(const ALocation: TDBGPtr function TGenericBreakLocationMap.IsHardcodeBreakPoint(const ALocation: TDBGPtr
): Boolean; ): Boolean;
begin begin
Result := GetOrigValueAtLocation(ALocation) = Int3; Result := GetOrigValueAtLocation(ALocation) = _BREAK._CODE;
end; end;
procedure TBreakLocationMap.TempRemoveBreakInstructionCode( procedure TGenericBreakLocationMap.TempRemoveBreakInstructionCode(
const ALocation: TDBGPtr); const ALocation: TDBGPtr);
var var
OVal: Byte; OVal: _BRK_STORE;
l, i: Integer; l, i: Integer;
begin begin
DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['>>> TempRemoveBreakInstructionCode']); DebugLn(DBG__VERBOSE or DBG__BREAKPOINTS, ['>>> TempRemoveBreakInstructionCode']);
l := length(FTmpRemovedBreaks); l := length(FTmpRemovedBreaks);
for i := 0 to l-1 do for i := 0 to l-1 do
if FTmpRemovedBreaks[i] = ALocation then if FTmpRemovedBreaks[i] = ALocation then
exit; exit;
OVal := GetOrigValueAtLocation(ALocation); OVal := GetOrigValueAtLocation(ALocation);
if OVal = Int3 then if OVal = _BREAK._CODE then
exit; exit;
SetLength(FTmpRemovedBreaks, l+1); SetLength(FTmpRemovedBreaks, l+1);
FTmpRemovedBreaks[l] := ALocation; FTmpRemovedBreaks[l] := ALocation;
Process.RemoveBreakInstructionCode(ALocation, OVal); // Do not update FBreakMap Process.RemoveBreakInstructionCode(ALocation, OVal); // Do not update FBreakMap
DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['<<< TempRemoveBreakInstructionCode']); DebugLn(DBG__VERBOSE or DBG__BREAKPOINTS, ['<<< TempRemoveBreakInstructionCode']);
end; end;
procedure TBreakLocationMap.RestoreTempBreakInstructionCodes; procedure TGenericBreakLocationMap.RestoreTempBreakInstructionCodes;
var var
OVal: Byte; OVal: _BRK_STORE;
t: array of TDBGPtr; t: array of TDBGPtr;
i: Integer; i: Integer;
begin begin
if Length(FTmpRemovedBreaks) = 0 then if Length(FTmpRemovedBreaks) = 0 then
exit; exit;
DebugLnEnter(DBG_VERBOSE or DBG_BREAKPOINTS, ['>>> RestoreTempBreakInstructionCodes']); DebugLnEnter(DBG__VERBOSE or DBG__BREAKPOINTS, ['>>> RestoreTempBreakInstructionCodes']);
t := FTmpRemovedBreaks; t := FTmpRemovedBreaks;
FTmpRemovedBreaks := nil; FTmpRemovedBreaks := nil;
for i := 0 to length(t) - 1 do for i := 0 to length(t) - 1 do
if HasId(t[i]) then // may have been removed if HasId(t[i]) then // may have been removed
Process.InsertBreakInstructionCode(t[i], OVal, False); Process.InsertBreakInstructionCode(t[i], OVal, False);
DebugLnExit(DBG_VERBOSE or DBG_BREAKPOINTS, ['<<< RestoreTempBreakInstructionCodes']); DebugLnExit(DBG__VERBOSE or DBG__BREAKPOINTS, ['<<< RestoreTempBreakInstructionCodes']);
end; end;
procedure TBreakLocationMap.MaskBreakpointsInReadData(const AAdress: TDbgPtr; procedure TGenericBreakLocationMap.MaskBreakpointsInReadData(const AAdress: TDbgPtr;
const ASize: Cardinal; var AData); const ASize: Cardinal; var AData);
var var
Brk: TFpBreakPointMapLocDataPair; Brk: TFpBreakPointMapLocDataPair;
begin begin
for Brk in Self do begin for Brk in Self do begin
if (not Brk.ErrorSetting) and (Brk.Location >= AAdress) and (Brk.Location < (AAdress+ASize)) then if not ErrorSettingFromPointer(Brk.Data) and (Brk.Location >= AAdress) and (Brk.Location < (AAdress+ASize)) then
PByte(@AData)[Brk.Location-AAdress] := Brk.OrigValue; PByte(@AData)[Brk.Location-AAdress] := OrigByteFromPointer(Brk.Data);
end; end;
end; end;
procedure TBreakLocationMap.AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: Byte); procedure TGenericBreakLocationMap.AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: _BRK_STORE);
var var
LocData: PInternalBreakLocationEntry; LocData: PInternalBreakLocationEntry;
begin begin
@ -1590,17 +1577,17 @@ begin
LocData^.OrigValue := NewOrigValue; LocData^.OrigValue := NewOrigValue;
end; end;
procedure TBreakLocationMap.NewMapEntry(out ALocData: PFpBreakPointMapEntry); procedure TGenericBreakLocationMap.NewMapEntry(out ALocData: PFpBreakPointMapEntry);
begin begin
New(PInternalBreakLocationEntry(ALocData)); New(PInternalBreakLocationEntry(ALocData));
end; end;
procedure TBreakLocationMap.DisposeMapEntry(ALocData: PFpBreakPointMapEntry); procedure TGenericBreakLocationMap.DisposeMapEntry(ALocData: PFpBreakPointMapEntry);
begin begin
Dispose(PInternalBreakLocationEntry(ALocData)); Dispose(PInternalBreakLocationEntry(ALocData));
end; end;
procedure TBreakLocationMap.DoAddedNewLocation(const ALocation: TDBGPtr; procedure TGenericBreakLocationMap.DoAddedNewLocation(const ALocation: TDBGPtr;
const AInternalBreak: TFpInternalBreakpoint; AnEntry: PFpBreakPointMapEntry); const AInternalBreak: TFpInternalBreakpoint; AnEntry: PFpBreakPointMapEntry);
var var
MapEntryPtr: PInternalBreakLocationEntry absolute AnEntry; MapEntryPtr: PInternalBreakLocationEntry absolute AnEntry;
@ -1617,7 +1604,7 @@ begin
MapEntryPtr^.ErrorSetting := not Process.InsertBreakInstructionCode(ALocation, MapEntryPtr^.OrigValue, IsTempRemoved); MapEntryPtr^.ErrorSetting := not Process.InsertBreakInstructionCode(ALocation, MapEntryPtr^.OrigValue, IsTempRemoved);
end; end;
procedure TBreakLocationMap.DoRemovingLocation(const ALocation: TDBGPtr; procedure TGenericBreakLocationMap.DoRemovingLocation(const ALocation: TDBGPtr;
const AInternalBreak: TFpInternalBreakpoint; AnEntry: PFpBreakPointMapEntry); const AInternalBreak: TFpInternalBreakpoint; AnEntry: PFpBreakPointMapEntry);
var var
MapEntryPtr: PInternalBreakLocationEntry absolute AnEntry; MapEntryPtr: PInternalBreakLocationEntry absolute AnEntry;
@ -2727,7 +2714,7 @@ end;
procedure TDbgProcess.ClearAddedAndRemovedLibraries; procedure TDbgProcess.ClearAddedAndRemovedLibraries;
begin begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.ClearAddedAndRemovedLibraries');{$ENDIF} {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('ClearAddedAndRemovedLibraries');{$ENDIF}
FLibMap.ClearAddedAndRemovedLibraries; FLibMap.ClearAddedAndRemovedLibraries;
end; end;
@ -4272,6 +4259,10 @@ initialization
DBG_BREAKPOINTS := DebugLogger.FindOrRegisterLogGroup('DBG_BREAKPOINTS' {$IFDEF DBG_BREAKPOINTS} , True {$ENDIF} ); DBG_BREAKPOINTS := DebugLogger.FindOrRegisterLogGroup('DBG_BREAKPOINTS' {$IFDEF DBG_BREAKPOINTS} , True {$ENDIF} );
FPDBG_COMMANDS := DebugLogger.FindOrRegisterLogGroup('FPDBG_COMMANDS' {$IFDEF FPDBG_COMMANDS} , True {$ENDIF} ); FPDBG_COMMANDS := DebugLogger.FindOrRegisterLogGroup('FPDBG_COMMANDS' {$IFDEF FPDBG_COMMANDS} , True {$ENDIF} );
TFpBreakPointMap.DBG__VERBOSE := DBG_VERBOSE;
TFpBreakPointMap.DBG__WARNINGS := DBG_WARNINGS;
TFpBreakPointMap.DBG__BREAKPOINTS := DBG_BREAKPOINTS;
finalization finalization
if assigned(RegisteredDbgProcessClasses) then if assigned(RegisteredDbgProcessClasses) then
FreeAndNil(RegisteredDbgProcessClasses); FreeAndNil(RegisteredDbgProcessClasses);