mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-19 11:59:14 +02:00
IDE, fpDebug, Debuggers: Deal with source lines that have more than one address (e.g. generics). fpDebug: set breakpoints at all addresses of a line.
git-svn-id: trunk@57782 -
This commit is contained in:
martin
parent
cf72a4270c
commit
5562c074da
@ -16,6 +16,7 @@ type
|
||||
datatype pointing to data on the target
|
||||
*)
|
||||
TDBGPtr = type QWord;
|
||||
TDBGPtrArray = Array of TDBGPtr;
|
||||
|
||||
(* TDbgSymbolKind
|
||||
Enum of types that a value can have.
|
||||
|
||||
@ -859,8 +859,8 @@ type
|
||||
public
|
||||
constructor Create;
|
||||
function Count: Integer; virtual;
|
||||
function GetAddress(const {%H-}AIndex: Integer; const {%H-}ALine: Integer): TDbgPtr; virtual;
|
||||
function GetAddress(const ASource: String; const ALine: Integer): TDbgPtr;
|
||||
function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; virtual;
|
||||
function HasAddress(const ASource: String; const ALine: Integer): Boolean;
|
||||
function GetInfo({%H-}AAddress: TDbgPtr; out {%H-}ASource, {%H-}ALine, {%H-}AOffset: Integer): Boolean; virtual;
|
||||
function IndexOf(const {%H-}ASource: String): integer; virtual;
|
||||
procedure Request(const {%H-}ASource: String); virtual;
|
||||
@ -4254,19 +4254,15 @@ begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TBaseLineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TBaseLineInfo.GetAddress(const ASource: String; const ALine: Integer): TDbgPtr;
|
||||
function TBaseLineInfo.HasAddress(const ASource: String; const ALine: Integer
|
||||
): Boolean;
|
||||
var
|
||||
idx: Integer;
|
||||
begin
|
||||
idx := IndexOf(ASource);
|
||||
if idx = -1
|
||||
then Result := 0
|
||||
else Result := GetAddress(idx, ALine);
|
||||
then Result := False
|
||||
else Result := HasAddress(idx, ALine);
|
||||
end;
|
||||
|
||||
function TBaseLineInfo.GetInfo(AAddress: TDbgPtr; out ASource, ALine, AOffset: Integer): Boolean;
|
||||
@ -4288,6 +4284,12 @@ begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TBaseLineInfo.HasAddress(const AIndex: Integer; const ALine: Integer
|
||||
): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{ TDBGLineInfo }
|
||||
|
||||
procedure TDBGLineInfo.Changed(ASource: String);
|
||||
|
||||
@ -131,7 +131,7 @@ type
|
||||
end;
|
||||
|
||||
{ TDbgThread }
|
||||
TDbgBreakpoint = class;
|
||||
TFpInternalBreakpoint = class;
|
||||
|
||||
TDbgThread = class(TObject)
|
||||
private
|
||||
@ -172,23 +172,52 @@ type
|
||||
end;
|
||||
TDbgThreadClass = class of TDbgThread;
|
||||
|
||||
TDbgBreakpoint = class(TObject)
|
||||
{ TFpInternalBreakpointBase }
|
||||
|
||||
TFpInternalBreakpointBase = class(TObject)
|
||||
public
|
||||
function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; virtual; abstract;
|
||||
procedure SetBreak; virtual; abstract;
|
||||
procedure ResetBreak; virtual; abstract;
|
||||
end;
|
||||
|
||||
{ TFpInternalBreakpoint }
|
||||
|
||||
TFpInternalBreakpoint = class(TFpInternalBreakpointBase)
|
||||
private
|
||||
FProcess: TDbgProcess;
|
||||
FLocation: TDbgPtr;
|
||||
FLocation: TDBGPtrArray;
|
||||
FOrgValue: Array of Byte;
|
||||
const
|
||||
Int3: Byte = $CC;
|
||||
protected
|
||||
FOrgValue: Byte;
|
||||
property Process: TDbgProcess read FProcess;
|
||||
property Location: TDBGPtrArray read FLocation;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr); virtual;
|
||||
constructor Create(const AProcess: TDbgProcess; const ALocation: TDBGPtrArray); virtual;
|
||||
destructor Destroy; override;
|
||||
function Hit(const AThreadID: Integer): Boolean; virtual;
|
||||
property Location: TDbgPtr read FLocation;
|
||||
function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; override;
|
||||
function HasLocation(const ALocation: TDBGPtr): Boolean;
|
||||
procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
|
||||
|
||||
procedure SetBreak; virtual;
|
||||
procedure ResetBreak; virtual;
|
||||
procedure SetBreak; override;
|
||||
procedure ResetBreak; override;
|
||||
end;
|
||||
TDbgBreakpointClass = class of TDbgBreakpoint;
|
||||
TFpInternalBreakpointClass = class of TFpInternalBreakpoint;
|
||||
|
||||
// TFpInternalBreakpointList = class(TFpInternalBreakpointBase)
|
||||
// private
|
||||
// FList: TFPList;
|
||||
// public
|
||||
// destructor Destroy; override;
|
||||
// procedure Add(ABreakPoint: TFpInternalBreakpoint);
|
||||
// procedure Remove(ABreakPoint: TFpInternalBreakpoint);
|
||||
// function IsEmpty: Boolean;
|
||||
//
|
||||
//// function Hit(const AThreadID: Integer): Boolean; virtual;
|
||||
//// procedure SetBreak; virtual;
|
||||
//// procedure ResetBreak; virtual;
|
||||
// end;
|
||||
|
||||
{ TDbgInstance }
|
||||
|
||||
@ -209,10 +238,9 @@ type
|
||||
constructor Create(const AProcess: TDbgProcess); virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
function AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint; overload;
|
||||
function AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint; overload;
|
||||
function AddrOffset: Int64; virtual; // gives the offset between the loaded addresses and the compiled addresses
|
||||
function FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol;
|
||||
function RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean;
|
||||
procedure LoadInfo; virtual;
|
||||
|
||||
property Process: TDbgProcess read FProcess;
|
||||
@ -247,7 +275,7 @@ type
|
||||
|
||||
procedure ThreadDestroyed(const AThread: TDbgThread);
|
||||
protected
|
||||
FCurrentBreakpoint: TDbgBreakpoint; // set if we are executing the code at the break
|
||||
FCurrentBreakpoint: TFpInternalBreakpoint; // set if we are executing the code at the break
|
||||
// if the singlestep is done, set the break again
|
||||
FCurrentWatchpoint: integer;
|
||||
FReEnableBreakStep: Boolean; // Set when we are reenabling a breakpoint
|
||||
@ -273,13 +301,14 @@ type
|
||||
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess; virtual;
|
||||
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); virtual;
|
||||
destructor Destroy; override;
|
||||
function AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint; overload;
|
||||
function AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
|
||||
function AddBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload;
|
||||
function FindSymbol(const AName: String): TFpDbgSymbol;
|
||||
function FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol;
|
||||
function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
|
||||
function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
|
||||
function RemoveBreak(const ALocation: TDbgPtr): Boolean;
|
||||
function HasBreak(const ALocation: TDbgPtr): Boolean;
|
||||
function RemoveBreak(const ABreakPoint: TFpInternalBreakpoint): Boolean;
|
||||
function HasBreak(const ALocation: TDbgPtr): Boolean; // TODO: remove, once an address can have many breakpoints
|
||||
procedure RemoveThread(const AID: DWord);
|
||||
procedure Log(const AString: string; const ALogLevel: TFPDLogLevel = dllDebug);
|
||||
procedure Log(const AString: string; const Options: array of const; const ALogLevel: TFPDLogLevel = dllDebug);
|
||||
@ -316,7 +345,7 @@ type
|
||||
property ProcessID: integer read FProcessID;
|
||||
property ThreadID: integer read FThreadID;
|
||||
property ExitCode: DWord read FExitCode;
|
||||
property CurrentBreakpoint: TDbgBreakpoint read FCurrentBreakpoint;
|
||||
property CurrentBreakpoint: TFpInternalBreakpoint read FCurrentBreakpoint;
|
||||
property CurrentWatchpoint: integer read FCurrentWatchpoint;
|
||||
|
||||
// Properties valid when last event was an deException
|
||||
@ -332,7 +361,7 @@ type
|
||||
TOSDbgClasses = class
|
||||
public
|
||||
DbgThreadClass : TDbgThreadClass;
|
||||
DbgBreakpointClass : TDbgBreakpointClass;
|
||||
DbgBreakpointClass : TFpInternalBreakpointClass;
|
||||
DbgProcessClass : TDbgProcessClass;
|
||||
end;
|
||||
|
||||
@ -373,7 +402,7 @@ begin
|
||||
begin
|
||||
GOSDbgClasses := TOSDbgClasses.create;
|
||||
GOSDbgClasses.DbgThreadClass := TDbgThread;
|
||||
GOSDbgClasses.DbgBreakpointClass := TDbgBreakpoint;
|
||||
GOSDbgClasses.DbgBreakpointClass := TFpInternalBreakpoint;
|
||||
GOSDbgClasses.DbgProcessClass := TDbgProcess;
|
||||
{$ifdef windows}
|
||||
RegisterDbgClasses;
|
||||
@ -627,15 +656,20 @@ end;
|
||||
|
||||
{ TDbgInstance }
|
||||
|
||||
function TDbgInstance.AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint;
|
||||
function TDbgInstance.AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint;
|
||||
var
|
||||
addr: TDbgPtr;
|
||||
addr: TDBGPtrArray;
|
||||
o: Int64;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
if not FDbgInfo.HasInfo then Exit;
|
||||
addr := FDbgInfo.GetLineAddress(AFileName, ALine);
|
||||
if addr = 0 then Exit;
|
||||
Result := FProcess.AddBreak(addr - AddrOffset);
|
||||
if FDbgInfo.GetLineAddresses(AFileName, ALine, addr) then begin
|
||||
o := AddrOffset;
|
||||
for i := 0 to High(addr) do
|
||||
addr[i] := addr[i] - o;
|
||||
Result := FProcess.AddBreak(addr);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgInstance.AddrOffset: Int64;
|
||||
@ -678,17 +712,6 @@ begin
|
||||
FSymbolTableInfo := TFpSymbolInfo.Create(FLoaderList);
|
||||
end;
|
||||
|
||||
function TDbgInstance.RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean;
|
||||
var
|
||||
addr: TDbgPtr;
|
||||
begin
|
||||
Result := False;
|
||||
if not FDbgInfo.HasInfo then Exit;
|
||||
addr := FDbgInfo.GetLineAddress(AFileName, ALine);
|
||||
if addr = 0 then Exit;
|
||||
Result := FProcess.RemoveBreak(addr - AddrOffset);
|
||||
end;
|
||||
|
||||
procedure TDbgInstance.SetFileName(const AValue: String);
|
||||
begin
|
||||
FFileName := AValue;
|
||||
@ -711,20 +734,30 @@ end;
|
||||
|
||||
{ TDbgProcess }
|
||||
|
||||
function TDbgProcess.AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
|
||||
function TDbgProcess.AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint;
|
||||
var
|
||||
a: TDBGPtrArray;
|
||||
begin
|
||||
SetLength(a, 1);
|
||||
a[0] := ALocation;
|
||||
Result := AddBreak(a);
|
||||
end;
|
||||
|
||||
function TDbgProcess.AddBreak(const ALocation: TDBGPtrArray
|
||||
): TFpInternalBreakpoint;
|
||||
var
|
||||
a, ip: TDBGPtr;
|
||||
begin
|
||||
if FBreakMap.HasId(ALocation) then begin
|
||||
debugln(['TDbgProcess.AddBreak breakpoint already exists at ', dbgs(ALocation)]);
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
Result := OSDbgClasses.DbgBreakpointClass.Create(Self, ALocation);
|
||||
FBreakMap.Add(ALocation, Result);
|
||||
if (GetInstructionPointerRegisterValue=ALocation) and not assigned(FCurrentBreakpoint) then
|
||||
begin
|
||||
FCurrentBreakpoint := Result;
|
||||
Result.ResetBreak;
|
||||
end;
|
||||
// TODO: empty breakpoint (all address failed to set) = nil
|
||||
ip := GetInstructionPointerRegisterValue;
|
||||
if not assigned(FCurrentBreakpoint) then
|
||||
for a in ALocation do
|
||||
if ip=a then begin
|
||||
FCurrentBreakpoint := Result;
|
||||
Result.ResetBreak;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDbgProcess.Create(const AFileName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog);
|
||||
@ -741,7 +774,7 @@ begin
|
||||
|
||||
FThreadMap := TMap.Create(itu4, SizeOf(TDbgThread));
|
||||
FLibMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgLibrary));
|
||||
FBreakMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgBreakpoint));
|
||||
FBreakMap := TMap.Create(MAP_ID_SIZE, SizeOf(TFpInternalBreakpoint));
|
||||
FCurrentBreakpoint := nil;
|
||||
FCurrentWatchpoint := -1;
|
||||
|
||||
@ -776,7 +809,8 @@ destructor TDbgProcess.Destroy;
|
||||
begin
|
||||
FProcessID:=0;
|
||||
|
||||
FreeItemsInMap(FBreakMap);
|
||||
Assert(FBreakMap.Count=0, 'No breakpoints left');
|
||||
//FreeItemsInMap(FBreakMap);
|
||||
FreeItemsInMap(FThreadMap);
|
||||
FreeItemsInMap(FLibMap);
|
||||
|
||||
@ -959,20 +993,11 @@ begin
|
||||
Log('Unknown thread ID %u for process %u', [AThreadIdentifier, ProcessID]);
|
||||
end;
|
||||
|
||||
function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): Boolean;
|
||||
var
|
||||
ABreakPoint: TDbgBreakpoint;
|
||||
function TDbgProcess.RemoveBreak(const ABreakPoint: TFpInternalBreakpoint
|
||||
): Boolean;
|
||||
begin
|
||||
if FBreakMap = nil
|
||||
then Result := False
|
||||
else begin
|
||||
result := FBreakMap.GetData(ALocation, ABreakPoint);
|
||||
if result then begin
|
||||
if ABreakPoint=FCurrentBreakpoint then
|
||||
FCurrentBreakpoint := nil;
|
||||
Result := FBreakMap.Delete(ALocation);
|
||||
end;
|
||||
end;
|
||||
if ABreakPoint=FCurrentBreakpoint then
|
||||
FCurrentBreakpoint := nil;
|
||||
end;
|
||||
|
||||
function TDbgProcess.HasBreak(const ALocation: TDbgPtr): Boolean;
|
||||
@ -1061,14 +1086,14 @@ begin
|
||||
if FCurrentBreakpoint = nil then Exit;
|
||||
|
||||
Result := True;
|
||||
if not FCurrentBreakpoint.Hit(AThreadId)
|
||||
if not FCurrentBreakpoint.Hit(AThreadId, BreakpointAddress)
|
||||
then FCurrentBreakpoint := nil; // no need for a singlestep if we continue
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
|
||||
var
|
||||
BreakLocation: TDBGPtr;
|
||||
Bp: TDbgBreakpoint;
|
||||
Bp: TFpInternalBreakpoint;
|
||||
Iterator: TMapIterator;
|
||||
begin
|
||||
iterator := TMapIterator.Create(FBreakMap);
|
||||
@ -1077,9 +1102,7 @@ begin
|
||||
while not Iterator.EOM do
|
||||
begin
|
||||
Iterator.GetData(bp);
|
||||
BreakLocation := Bp.FLocation;
|
||||
if (BreakLocation >= AAdress) and (BreakLocation < (AAdress+ASize)) then
|
||||
TByteArray(AData)[BreakLocation-AAdress] := Bp.FOrgValue;
|
||||
Bp.MaskBreakpointsInReadData(AAdress, ASize, AData);
|
||||
iterator.Next;
|
||||
end;
|
||||
finally
|
||||
@ -1125,19 +1148,25 @@ end;
|
||||
|
||||
function TDbgThread.IsAtStartOfLine: boolean;
|
||||
var
|
||||
AnAddr: TDBGPtr;
|
||||
AnAddr, b: TDBGPtr;
|
||||
Sym: TFpDbgSymbol;
|
||||
CU: TDwarfCompilationUnit;
|
||||
a: TDBGPtrArray;
|
||||
begin
|
||||
result := true;
|
||||
AnAddr := FProcess.GetInstructionPointerRegisterValue;
|
||||
sym := FProcess.FindSymbol(AnAddr);
|
||||
if (sym is TDbgDwarfSymbolBase) then
|
||||
begin
|
||||
CU := TDbgDwarfSymbolBase(sym).CompilationUnit;
|
||||
if cu.GetLineAddress(sym.FileName, sym.Line)<>AnAddr then
|
||||
result := false;
|
||||
end;
|
||||
Result := False;
|
||||
CU.GetLineAddresses(sym.FileName, sym.Line, a);
|
||||
for b in a do begin
|
||||
Result := b = AnAddr;
|
||||
if Result then break;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := True;
|
||||
sym.ReleaseReference;
|
||||
end;
|
||||
|
||||
@ -1253,27 +1282,39 @@ end;
|
||||
|
||||
{ TDbgBreak }
|
||||
|
||||
constructor TDbgBreakpoint.Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr);
|
||||
constructor TFpInternalBreakpoint.Create(const AProcess: TDbgProcess;
|
||||
const ALocation: TDBGPtrArray);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FProcess := AProcess;
|
||||
FLocation := ALocation;
|
||||
SetLength(FOrgValue, Length(FLocation));
|
||||
for i := 0 to High(FLocation) do
|
||||
FOrgValue[i] := Int3; // Mark location as NOT applied
|
||||
inherited Create;
|
||||
SetBreak;
|
||||
end;
|
||||
|
||||
destructor TDbgBreakpoint.Destroy;
|
||||
destructor TFpInternalBreakpoint.Destroy;
|
||||
begin
|
||||
ResetBreak;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TDbgBreakpoint.Hit(const AThreadID: Integer): Boolean;
|
||||
function TFpInternalBreakpoint.Hit(const AThreadID: Integer;
|
||||
ABreakpointAddress: TDBGPtr): Boolean;
|
||||
var
|
||||
Thread: TDbgThread;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint
|
||||
// no need to jum back and restore instruction
|
||||
for i := 0 to High(FLocation) do begin
|
||||
if (FLocation[i] = ABreakpointAddress) and
|
||||
(FOrgValue[i] = Int3)
|
||||
then Exit; // breakpoint on a hardcoded breakpoint
|
||||
// no need to jum back and restore instruction
|
||||
end;
|
||||
ResetBreak;
|
||||
|
||||
if not Process.GetThread(AThreadId, Thread) then Exit;
|
||||
@ -1284,36 +1325,85 @@ begin
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
procedure TDbgBreakpoint.ResetBreak;
|
||||
function TFpInternalBreakpoint.HasLocation(const ALocation: TDBGPtr): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if FProcess.ProcessID=0 then
|
||||
// The process is already exited.
|
||||
Exit;
|
||||
Result := True;
|
||||
for i := 0 to High(FLocation) do begin
|
||||
if FOrgValue[i] = Int3 then Continue;
|
||||
if FLocation[i] = ALocation then exit;
|
||||
end;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint
|
||||
|
||||
if not FProcess.WriteData(FLocation, 1, FOrgValue)
|
||||
then begin
|
||||
Log('Unable to reset breakpoint at %s', [FormatAddress(FLocation)]);
|
||||
procedure TFpInternalBreakpoint.MaskBreakpointsInReadData(
|
||||
const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to High(FLocation) do begin
|
||||
if FOrgValue[i] = Int3 then Continue;
|
||||
if (FLocation[i] >= AAdress) and (FLocation[i] < (AAdress+ASize)) then
|
||||
TByteArray(AData)[FLocation[i]-AAdress] := FOrgValue[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgBreakpoint.SetBreak;
|
||||
const
|
||||
Int3: Byte = $CC;
|
||||
procedure TFpInternalBreakpoint.ResetBreak;
|
||||
var
|
||||
i: Integer;
|
||||
tmp: TFpInternalBreakpoint;
|
||||
t: Boolean;
|
||||
begin
|
||||
if not FProcess.ReadData(FLocation, 1, FOrgValue)
|
||||
then begin
|
||||
Log('Unable to read breakpoint at '+FormatAddress(FLocation));
|
||||
Exit;
|
||||
t := FProcess.ProcessID=0; // The process has already exited.
|
||||
|
||||
for i := 0 to High(FLocation) do begin
|
||||
if FOrgValue[i] = Int3 then Continue; // breakpoint on a hardcoded breakpoint
|
||||
|
||||
if (not FProcess.FBreakMap.GetData(FLocation[i], tmp)) or (tmp <> self) then begin
|
||||
Log('Internal error resetting breakpoint at %s (Address %d out of %d)', [FormatAddress(FLocation[i]), i, Length(FLocation)]);
|
||||
FOrgValue[i] := Int3; // Mark location as NOT applied
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if (not t) then begin
|
||||
if (not FProcess.WriteData(FLocation[i], 1, FOrgValue[i])) then begin
|
||||
Log('Unable to reset breakpoint at %s (Address %d out of %d)', [FormatAddress(FLocation[i]), i, Length(FLocation)]);
|
||||
end;
|
||||
end;
|
||||
FProcess.FBreakMap.Delete(FLocation[i]);
|
||||
|
||||
FOrgValue[i] := Int3; // Mark location as NOT applied
|
||||
end;
|
||||
end;
|
||||
|
||||
if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint
|
||||
procedure TFpInternalBreakpoint.SetBreak;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to High(FLocation) do begin
|
||||
FOrgValue[i] := Int3; // Mark location as NOT applied
|
||||
|
||||
if not FProcess.WriteData(FLocation, 1, Int3)
|
||||
then begin
|
||||
Log('Unable to set breakpoint at '+FormatAddress(FLocation));
|
||||
Exit;
|
||||
if FProcess.FBreakMap.HasId(FLocation[i]) then begin
|
||||
Log('TFpInternalBreakpoint.SetBreak breakpoint already exists at ' + dbgs(FLocation[i]));
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if not FProcess.ReadData(FLocation[i], 1, FOrgValue[i])
|
||||
then begin
|
||||
Log('Unable to read breakpoint at '+FormatAddress(FLocation[i])+' (Address #'+IntToStr(i)+' out of '+IntToStr(Length(FLocation))+')');
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if FOrgValue[i] = Int3 then Continue; // breakpoint on a hardcoded breakpoint
|
||||
|
||||
if not FProcess.WriteData(FLocation[i], 1, Int3)
|
||||
then begin
|
||||
Log('Unable to set breakpoint at '+FormatAddress(FLocation[i])+' (Address #'+IntToStr(i)+' out of '+IntToStr(Length(FLocation))+')');
|
||||
Continue;
|
||||
end;
|
||||
|
||||
FProcess.FBreakMap.Add(FLocation[i], Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -16,7 +16,7 @@ uses
|
||||
type
|
||||
|
||||
TOnCreateProcessEvent = procedure(var continue: boolean) of object;
|
||||
TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TDbgBreakpoint) of object;
|
||||
TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TFpInternalBreakpoint) of object;
|
||||
TOnExceptionEvent = procedure(var continue: boolean; const ExceptionClass, ExceptionMessage: string) of object;
|
||||
TOnProcessExitEvent = procedure(ExitCode: DWord) of object;
|
||||
|
||||
@ -53,7 +53,7 @@ type
|
||||
|
||||
TDbgControllerStepOverInstructionCmd = class(TDbgControllerCmd)
|
||||
private
|
||||
FHiddenBreakpoint: TDbgBreakpoint;
|
||||
FHiddenBreakpoint: TFpInternalBreakpoint;
|
||||
FIsSet: boolean;
|
||||
public
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
||||
@ -84,7 +84,7 @@ type
|
||||
FLastStackPointerValue: TDBGPtr;
|
||||
FLastStackBaseValue: TDBGPtr;
|
||||
FAssumedProcStartStackPointer: TDBGPtr;
|
||||
FHiddenBreakpoint: TDbgBreakpoint;
|
||||
FHiddenBreakpoint: TFpInternalBreakpoint;
|
||||
FInstCount: integer;
|
||||
public
|
||||
constructor Create(AController: TDbgController); override;
|
||||
@ -97,11 +97,11 @@ type
|
||||
|
||||
TDbgControllerRunToCmd = class(TDbgControllerCmd)
|
||||
private
|
||||
FHiddenBreakpoint: TDbgBreakpoint;
|
||||
FLocation: TDBGPtr;
|
||||
FHiddenBreakpoint: TFpInternalBreakpoint;
|
||||
FLocation: TDBGPtrArray;
|
||||
FProcess: TDbgProcess;
|
||||
public
|
||||
constructor Create(AController: TDbgController; ALocation: TDBGPtr);
|
||||
constructor Create(AController: TDbgController; ALocation: TDBGPtrArray);
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
||||
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
|
||||
end;
|
||||
@ -182,7 +182,7 @@ implementation
|
||||
|
||||
{ TDbgControllerRunToCmd }
|
||||
|
||||
constructor TDbgControllerRunToCmd.Create(AController: TDbgController; ALocation: TDBGPtr);
|
||||
constructor TDbgControllerRunToCmd.Create(AController: TDbgController; ALocation: TDBGPtrArray);
|
||||
begin
|
||||
inherited create(AController);
|
||||
FLocation:=ALocation;
|
||||
@ -191,8 +191,10 @@ end;
|
||||
procedure TDbgControllerRunToCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
|
||||
begin
|
||||
FProcess := AProcess;
|
||||
if not assigned(FHiddenBreakpoint) and not AProcess.HasBreak(FLocation) then
|
||||
FHiddenBreakpoint := AProcess.AddBreak(FLocation);
|
||||
if not assigned(FHiddenBreakpoint) then // and not AProcess.HasBreak(FLocation)
|
||||
FHiddenBreakpoint := AProcess.AddBreak(FLocation)
|
||||
else
|
||||
FProcess.Log('TDbgControllerRunToCmd.DoContinue: Breakpoint already used');
|
||||
|
||||
AProcess.Continue(AProcess, AThread, False);
|
||||
end;
|
||||
@ -204,7 +206,7 @@ begin
|
||||
Finished := (AnEvent<>deInternalContinue);
|
||||
if Finished and assigned(FHiddenBreakpoint) then
|
||||
begin
|
||||
FProcess.RemoveBreak(FLocation);
|
||||
FProcess.RemoveBreak(FHiddenBreakpoint);
|
||||
FHiddenBreakpoint.Free;
|
||||
end;
|
||||
end;
|
||||
@ -223,7 +225,7 @@ destructor TDbgControllerStepIntoLineCmd.Destroy;
|
||||
begin
|
||||
if assigned(FHiddenBreakpoint) then
|
||||
begin
|
||||
FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint.Location);
|
||||
FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint);
|
||||
FreeAndNil(FHiddenBreakpoint);
|
||||
end;
|
||||
inherited Destroy;
|
||||
@ -318,7 +320,7 @@ begin
|
||||
begin
|
||||
FInto:=false;
|
||||
FInstCount:=0;
|
||||
FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint.Location);
|
||||
FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint);
|
||||
FreeAndNil(FHiddenBreakpoint);
|
||||
end
|
||||
else
|
||||
@ -433,7 +435,7 @@ begin
|
||||
begin
|
||||
if assigned(FHiddenBreakpoint) then
|
||||
begin
|
||||
FController.FCurrentProcess.RemoveBreak(FHiddenBreakpoint.Location);
|
||||
FController.FCurrentProcess.RemoveBreak(FHiddenBreakpoint);
|
||||
FHiddenBreakpoint.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -90,7 +90,7 @@ type
|
||||
property ThreadId: Integer read FThreadId write FThreadId;
|
||||
property StackFrame: Integer read FStackFrame write FStackFrame;
|
||||
|
||||
function ApplyContext(AVal: TFpDbgValue): TFpDbgValue; inline;
|
||||
procedure ApplyContext(AVal: TFpDbgValue); inline;
|
||||
function SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue; inline;
|
||||
procedure AddRefToVal(AVal: TFpDbgValue); inline;
|
||||
function GetSelfParameter: TFpDbgValue; virtual;
|
||||
@ -990,7 +990,7 @@ begin
|
||||
Result := FDwarf.MemManager;
|
||||
end;
|
||||
|
||||
function TFpDwarfInfoAddressContext.ApplyContext(AVal: TFpDbgValue): TFpDbgValue;
|
||||
procedure TFpDwarfInfoAddressContext.ApplyContext(AVal: TFpDbgValue);
|
||||
begin
|
||||
if (AVal <> nil) and (TFpDwarfValueBase(AVal).FContext = nil) then
|
||||
TFpDwarfValueBase(AVal).FContext := Self;
|
||||
@ -1877,7 +1877,7 @@ end;
|
||||
function TFpDwarfValueChar.GetAsWideString: WideString;
|
||||
begin
|
||||
if FSize > 2 then
|
||||
Result := inherited GetAsString
|
||||
Result := inherited GetAsWideString
|
||||
else
|
||||
Result := WideChar(Word(GetAsCardinal));
|
||||
end;
|
||||
|
||||
@ -395,13 +395,17 @@ type
|
||||
|
||||
TDWarfLineMap = object
|
||||
private
|
||||
NextAFterHighestLine: Cardinal;
|
||||
AddressList: array of QWord;
|
||||
//Count: Integer;
|
||||
// FLineIndexList[ line div 256 ]
|
||||
FLineIndexList: Array of record
|
||||
LineOffsets: Array of Byte;
|
||||
Addresses: Array of TDBGPtr;
|
||||
end;
|
||||
public
|
||||
procedure Init;
|
||||
procedure SetAddressForLine(ALine: Cardinal; AnAddress: QWord); inline;
|
||||
function GetAddressForLine(ALine: Cardinal): QWord; inline;
|
||||
procedure SetAddressForLine(ALine: Cardinal; AnAddress: TDBGPtr); inline;
|
||||
function GetAddressesForLine(ALine: Cardinal; var AResultList: TDBGPtrArray;
|
||||
NoData: Boolean = False): Boolean; inline;
|
||||
// NoData: only return True/False, but nothing in AResultList
|
||||
procedure Compress;
|
||||
end;
|
||||
PDWarfLineMap = ^TDWarfLineMap;
|
||||
@ -496,6 +500,7 @@ type
|
||||
|
||||
FAbbrevList: TDwarfAbbrevList;
|
||||
|
||||
{$IFDEF DwarfTestAccess} public {$ENDIF}
|
||||
FLineInfo: record
|
||||
Header: Pointer;
|
||||
DataStart: Pointer;
|
||||
@ -514,10 +519,11 @@ type
|
||||
StateMachine: TDwarfLineInfoStateMachine;
|
||||
StateMachines: TFPObjectList; // list of state machines to be freed
|
||||
end;
|
||||
|
||||
{$IFDEF DwarfTestAccess} private {$ENDIF}
|
||||
|
||||
FLineNumberMap: TStringList;
|
||||
|
||||
FAddressMap: TMap;
|
||||
FAddressMap: TMap; // Holds a key for each DW_TAG_subprogram, stores TDwarfAddressInfo
|
||||
FAddressMapBuild: Boolean;
|
||||
|
||||
FMinPC: QWord; // the min and max PC value found in this unit.
|
||||
@ -554,7 +560,7 @@ type
|
||||
procedure ScanAllEntries; inline;
|
||||
function GetDefinition(AAbbrevPtr: Pointer; out ADefinition: TDwarfAbbrev): Boolean; inline;
|
||||
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
|
||||
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): boolean;
|
||||
procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean);
|
||||
function FullFileName(const AFileName:string): String;
|
||||
// On Darwin it could be that the debug-information is not included into the executable by the linker.
|
||||
@ -605,7 +611,7 @@ type
|
||||
function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override;
|
||||
function FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; override;
|
||||
//function FindSymbol(const AName: String): TDbgSymbol; override;
|
||||
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override;
|
||||
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; override;
|
||||
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
|
||||
function LoadCompilationUnits: Integer;
|
||||
function PointerFromRVA(ARVA: QWord): Pointer;
|
||||
@ -1056,8 +1062,8 @@ var
|
||||
else
|
||||
begin // append to existing
|
||||
GapAvail := FTableListGaps[ATableListIndex].EndTable;
|
||||
assert(AEntry^.EndIndex + AEntry^.LeadHigh - AEntry^.LeadLow + 1 + GapAvail <= FEndTableNextFreeIndex);
|
||||
AtEnd := AEntry^.EndIndex + AEntry^.EndHigh - AEntry^.EndLow + 1 + GapAvail = FEndTableNextFreeIndex;
|
||||
assert(Int64(AEntry^.EndIndex) + Int64(AEntry^.LeadHigh) - Int64(AEntry^.LeadLow) + 1 + GapAvail <= FEndTableNextFreeIndex);
|
||||
AtEnd := Int64(AEntry^.EndIndex) + Int64(AEntry^.EndHigh) - Int64(AEntry^.EndLow) + 1 + GapAvail = FEndTableNextFreeIndex;
|
||||
ANeeded := ALeadByte - AEntry^.EndHigh;
|
||||
|
||||
if ANeeded <= GapAvail then begin
|
||||
@ -2780,37 +2786,138 @@ end;
|
||||
|
||||
procedure TDWarfLineMap.Init;
|
||||
begin
|
||||
NextAFterHighestLine := 0;
|
||||
//Count := 0;
|
||||
end;
|
||||
|
||||
procedure TDWarfLineMap.SetAddressForLine(ALine: Cardinal; AnAddress: QWord);
|
||||
procedure TDWarfLineMap.SetAddressForLine(ALine: Cardinal; AnAddress: TDBGPtr);
|
||||
var
|
||||
i: Integer;
|
||||
SectLen, SectCnt, i, j, o, o2: Integer;
|
||||
idx, offset: TDBGPtr;
|
||||
LineOffsets: Array of Byte;
|
||||
Addresses: Array of TDBGPtr;
|
||||
begin
|
||||
i := Length(AddressList);
|
||||
if i <= ALine then
|
||||
SetLength(AddressList, ALine + 2000);
|
||||
idx := ALine div 256;
|
||||
offset := ALine mod 256;
|
||||
i := Length(FLineIndexList);
|
||||
if idx >= i then
|
||||
SetLength(FLineIndexList, idx+4);
|
||||
|
||||
if AddressList[ALine] = 0 then begin
|
||||
AddressList[ALine] := AnAddress;
|
||||
//inc(Count);
|
||||
LineOffsets := FLineIndexList[idx].LineOffsets;
|
||||
Addresses := FLineIndexList[idx].Addresses;
|
||||
|
||||
if Addresses = nil then begin
|
||||
SectLen := 192;
|
||||
SectCnt := 0;
|
||||
SetLength(FLineIndexList[idx].Addresses, 193);
|
||||
SetLength(FLineIndexList[idx].LineOffsets, 192);
|
||||
LineOffsets := FLineIndexList[idx].LineOffsets;
|
||||
Addresses := FLineIndexList[idx].Addresses;
|
||||
end
|
||||
else begin
|
||||
SectLen := Length(LineOffsets);
|
||||
SectCnt := Integer(Addresses[SectLen]);
|
||||
if SectCnt >= SectLen then begin
|
||||
SectLen := SectCnt + 64;
|
||||
SetLength(FLineIndexList[idx].Addresses, SectLen+1);
|
||||
SetLength(FLineIndexList[idx].LineOffsets, SectLen);
|
||||
LineOffsets := FLineIndexList[idx].LineOffsets;
|
||||
Addresses := FLineIndexList[idx].Addresses;
|
||||
end;
|
||||
end;
|
||||
if ALine > NextAFterHighestLine then
|
||||
NextAFterHighestLine := ALine+1;
|
||||
|
||||
|
||||
i := 0;
|
||||
o := 0;
|
||||
while (i < SectCnt) do begin
|
||||
o2 := o + LineOffsets[i];
|
||||
if o2 > offset then break;
|
||||
o := o2;
|
||||
inc(i);
|
||||
end;
|
||||
|
||||
j := SectCnt;
|
||||
while j > i do begin
|
||||
LineOffsets[j] := LineOffsets[j-1];
|
||||
Addresses[j] := Addresses[j-1];
|
||||
dec(j);
|
||||
end;
|
||||
|
||||
offset := offset - o;
|
||||
LineOffsets[i] := offset;
|
||||
Addresses[i] := AnAddress;
|
||||
|
||||
if i < SectCnt then begin
|
||||
assert(LineOffsets[i+1] >= offset, 'TDWarfLineMap.SetAddressForLine LineOffsets[i+1] > offset');
|
||||
LineOffsets[i+1] := LineOffsets[i+1] - offset;
|
||||
end;
|
||||
|
||||
Addresses[SectLen] := SectCnt + 1;
|
||||
end;
|
||||
|
||||
function TDWarfLineMap.GetAddressForLine(ALine: Cardinal): QWord;
|
||||
function TDWarfLineMap.GetAddressesForLine(ALine: Cardinal;
|
||||
var AResultList: TDBGPtrArray; NoData: Boolean): Boolean;
|
||||
var
|
||||
idx, offset: TDBGPtr;
|
||||
LineOffsets: Array of Byte;
|
||||
Addresses: Array of TDBGPtr;
|
||||
o: Byte;
|
||||
i, j, k, l: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
if ALine < Length(AddressList) then
|
||||
Result := AddressList[ALine];
|
||||
Result := False;
|
||||
idx := ALine div 256;
|
||||
offset := ALine mod 256;
|
||||
if idx >= Length(FLineIndexList) then
|
||||
exit;
|
||||
|
||||
LineOffsets := FLineIndexList[idx].LineOffsets;
|
||||
Addresses := FLineIndexList[idx].Addresses;
|
||||
if Addresses = nil then
|
||||
exit;
|
||||
|
||||
l := Length(LineOffsets);
|
||||
i := 0;
|
||||
while (i < l) do begin
|
||||
o := LineOffsets[i];
|
||||
if o > offset then exit;
|
||||
offset := offset - o;
|
||||
if offset = 0 then break;
|
||||
inc(i);
|
||||
end;
|
||||
|
||||
If (offset > 0) then
|
||||
exit;
|
||||
|
||||
if NoData then begin
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
j := i + 1;
|
||||
while (j < l) and (LineOffsets[j] = 0) do inc(j);
|
||||
|
||||
k := Length(AResultList);
|
||||
SetLength(AResultList, k + (j-i));
|
||||
while i < j do begin
|
||||
AResultList[k] := Addresses[i];
|
||||
inc(i);
|
||||
inc(k);
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TDWarfLineMap.Compress;
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
SetLength(AddressList, NextAFterHighestLine);
|
||||
//DebugLn(['#### ',NextAFterHighestLine, ' / ',Count]);
|
||||
for i := 0 to high(FLineIndexList) do begin
|
||||
j := Length(FLineIndexList[i].LineOffsets);
|
||||
if j <> 0 then begin
|
||||
j := FLineIndexList[i].Addresses[j];
|
||||
SetLength(FLineIndexList[i].Addresses, j+1);
|
||||
FLineIndexList[i].Addresses[j] := j;
|
||||
SetLength(FLineIndexList[i].LineOffsets, j);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFpDwarfInfo }
|
||||
@ -2968,18 +3075,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpDwarfInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
function TFpDwarfInfo.GetLineAddresses(const AFileName: String;
|
||||
ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean;
|
||||
var
|
||||
n: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
begin
|
||||
Result := False;
|
||||
for n := 0 to FCompilationUnits.Count - 1 do
|
||||
begin
|
||||
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
|
||||
Result := CU.GetLineAddress(AFileName, ALine);
|
||||
if Result <> 0 then Exit;
|
||||
Result := CU.GetLineAddresses(AFileName, ALine, AResultList) or Result;
|
||||
end;
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TFpDwarfInfo.GetLineAddressMap(const AFileName: String): PDWarfLineMap;
|
||||
@ -3346,7 +3453,10 @@ begin
|
||||
end;
|
||||
|
||||
addr := FLineInfo.StateMachine.Address;
|
||||
LineMap^.SetAddressForLine(Line, addr);
|
||||
if (not FLineInfo.StateMachine.EndSequence) and (FLineInfo.StateMachine.IsStmt)
|
||||
and (Line > 0)
|
||||
then
|
||||
LineMap^.SetAddressForLine(Line, addr);
|
||||
|
||||
if (Info = nil) or
|
||||
(addr < Info^.StartPC) or
|
||||
@ -3384,7 +3494,7 @@ begin
|
||||
Result := FAddressMap;
|
||||
end;
|
||||
|
||||
function TDwarfCompilationUnit.FullFileName(const AFileName: String): String;
|
||||
function TDwarfCompilationUnit.FullFileName(const AFileName: string): String;
|
||||
begin
|
||||
Result := AFileName;
|
||||
if FCompDir = '' then exit;
|
||||
@ -3733,14 +3843,15 @@ begin
|
||||
Result := PDWarfLineMap(FLineNumberMap.Objects[idx]);
|
||||
end;
|
||||
|
||||
function TDwarfCompilationUnit.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
function TDwarfCompilationUnit.GetLineAddresses(const AFileName: String;
|
||||
ALine: Cardinal; var AResultList: TDBGPtrArray): boolean;
|
||||
var
|
||||
Map: PDWarfLineMap;
|
||||
begin
|
||||
Result := 0;
|
||||
Result := False;
|
||||
Map := GetLineAddressMap(AFileName);
|
||||
if Map = nil then exit;
|
||||
Result := Map^.GetAddressForLine(ALine);
|
||||
Result := Map^.GetAddressesForLine(ALine, AResultList);
|
||||
end;
|
||||
|
||||
function TDwarfCompilationUnit.InitLocateAttributeList(AEntry: Pointer;
|
||||
|
||||
@ -486,7 +486,7 @@ type
|
||||
function FindSymbol(const {%H-}AName: String): TFpDbgSymbol; virtual; deprecated;
|
||||
function FindSymbol({%H-}AAddress: TDbgPtr): TFpDbgSymbol; virtual; deprecated;
|
||||
property HasInfo: Boolean read FHasInfo;
|
||||
function GetLineAddress(const {%H-}AFileName: String; {%H-}ALine: Cardinal): TDbgPtr; virtual;
|
||||
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; virtual;
|
||||
//property MemManager: TFpDbgMemReaderBase read GetMemManager write SetMemManager;
|
||||
end;
|
||||
|
||||
@ -1379,9 +1379,10 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
function TDbgInfo.GetLineAddresses(const AFileName: String; ALine: Cardinal;
|
||||
var AResultList: TDBGPtrArray): Boolean;
|
||||
begin
|
||||
Result := 0;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TDbgInfo.SetHasInfo;
|
||||
|
||||
@ -48,7 +48,6 @@ type
|
||||
function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override;
|
||||
function FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; override;
|
||||
function FindSymbol(const AName: String): TFpDbgSymbol; override;
|
||||
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override;
|
||||
property Image64Bit: boolean read FImage64Bit;
|
||||
end;
|
||||
|
||||
@ -147,10 +146,5 @@ begin
|
||||
//Result:=FContext.FindSymbol(AName);
|
||||
end;
|
||||
|
||||
function TFpSymbolInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
begin
|
||||
Result:=inherited GetLineAddress(AFileName, ALine);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -71,8 +71,8 @@ type
|
||||
|
||||
{ TDbgWinBreakpoint }
|
||||
|
||||
TDbgWinBreakpointEvent = procedure(const ASender: TDbgBreakpoint; const AContext: TContext) of object;
|
||||
TDbgWinBreakpoint = class(TDbgBreakpoint)
|
||||
TDbgWinBreakpointEvent = procedure(const ASender: TFpInternalBreakpoint; const AContext: TContext) of object;
|
||||
TDbgWinBreakpoint = class(TFpInternalBreakpoint)
|
||||
public
|
||||
procedure SetBreak; override;
|
||||
procedure ResetBreak; override;
|
||||
@ -997,15 +997,21 @@ end;
|
||||
{ TDbgWinBreakpoint }
|
||||
|
||||
procedure TDbgWinBreakpoint.SetBreak;
|
||||
var
|
||||
a: TDBGPtr;
|
||||
begin
|
||||
inherited;
|
||||
FlushInstructionCache(Process.Handle, Pointer(PtrUInt(Location)), 1);
|
||||
for a in Location do
|
||||
FlushInstructionCache(Process.Handle, Pointer(PtrUInt(a)), 1);
|
||||
end;
|
||||
|
||||
procedure TDbgWinBreakpoint.ResetBreak;
|
||||
var
|
||||
a: TDBGPtr;
|
||||
begin
|
||||
inherited;
|
||||
FlushInstructionCache(Process.Handle, Pointer(PtrUInt(Location)), 1);
|
||||
for a in Location do
|
||||
FlushInstructionCache(Process.Handle, Pointer(PtrUInt(a)), 1);
|
||||
end;
|
||||
|
||||
{ TDbgWinThread }
|
||||
|
||||
@ -1070,7 +1070,8 @@ type
|
||||
constructor Create(const ADebugger: TDebuggerIntf);
|
||||
destructor Destroy; override;
|
||||
function Count: Integer; override;
|
||||
function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override;
|
||||
function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; override;
|
||||
function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr;
|
||||
function GetInfo({%H-}AAdress: TDbgPtr; out {%H-}ASource, {%H-}ALine, {%H-}AOffset: Integer): Boolean; override;
|
||||
function IndexOf(const ASource: String): integer; override;
|
||||
procedure Request(const ASource: String); override;
|
||||
@ -7077,6 +7078,12 @@ begin
|
||||
Result := FSourceIndex.Count;
|
||||
end;
|
||||
|
||||
function TGDBMILineInfo.HasAddress(const AIndex: Integer; const ALine: Integer
|
||||
): Boolean;
|
||||
begin
|
||||
Result := GetAddress(AIndex, ALine) <> 0;
|
||||
end;
|
||||
|
||||
function TGDBMILineInfo.GetSource(const AIndex: integer): String;
|
||||
begin
|
||||
if AIndex < Low(FSourceMaps) then Exit('');
|
||||
|
||||
@ -83,7 +83,7 @@ type
|
||||
FDbgController: TDbgController;
|
||||
FFpDebugThread: TFpDebugThread;
|
||||
FQuickPause: boolean;
|
||||
FRaiseExceptionBreakpoint: FpDbgClasses.TDBGBreakPoint;
|
||||
FRaiseExceptionBreakpoint: TFpInternalBreakpoint;
|
||||
FDbgLogMessageList: TFPObjectList;
|
||||
FLogCritSection: TRTLCriticalSection;
|
||||
FMemConverter: TFpDbgMemConvertorLittleEndian;
|
||||
@ -105,7 +105,7 @@ type
|
||||
function SetSoftwareExceptionBreakpoint: boolean;
|
||||
procedure HandleSoftwareException(out AnExceptionLocation: TDBGLocationRec; var continue: boolean);
|
||||
procedure FreeDebugThread;
|
||||
procedure FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint);
|
||||
procedure FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TFpInternalBreakpoint);
|
||||
procedure FDbgControllerCreateProcessEvent(var {%H-}continue: boolean);
|
||||
procedure FDbgControllerProcessExitEvent(AExitCode: DWord);
|
||||
procedure FDbgControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string);
|
||||
@ -152,9 +152,9 @@ type
|
||||
procedure DoPrepareCallStackEntryList;
|
||||
procedure DoFreeBreakpoint;
|
||||
{$endif linux}
|
||||
function AddBreak(const ALocation: TDbgPtr): FpDbgClasses.TDbgBreakpoint; overload;
|
||||
function AddBreak(const AFileName: String; ALine: Cardinal): FpDbgClasses.TDbgBreakpoint; overload;
|
||||
procedure FreeBreakpoint(const ABreakpoint: FpDbgClasses.TDbgBreakpoint);
|
||||
function AddBreak(const ALocation: TDbgPtr): TFpInternalBreakpoint; overload;
|
||||
function AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint; overload;
|
||||
procedure FreeBreakpoint(const ABreakpoint: TFpInternalBreakpoint);
|
||||
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean;
|
||||
function ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean;
|
||||
procedure PrepareCallStackEntryList;
|
||||
@ -186,7 +186,7 @@ type
|
||||
constructor Create(const ADebugger: TDebuggerIntf);
|
||||
destructor Destroy; override;
|
||||
function Count: Integer; override;
|
||||
function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override;
|
||||
function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; override;
|
||||
function GetInfo({%H-}AAddress: TDbgPtr; out {%H-}ASource, {%H-}ALine, {%H-}AOffset: Integer): Boolean; override;
|
||||
function IndexOf(const ASource: String): integer; override;
|
||||
procedure Request(const ASource: String); override;
|
||||
@ -253,7 +253,7 @@ type
|
||||
private
|
||||
FSetBreakFlag: boolean;
|
||||
FResetBreakFlag: boolean;
|
||||
FInternalBreakpoint: FpDbgClasses.TDbgBreakpoint;
|
||||
FInternalBreakpoint: FpDbgClasses.TFpInternalBreakpoint;
|
||||
FIsSet: boolean;
|
||||
procedure SetBreak;
|
||||
procedure ResetBreak;
|
||||
@ -272,11 +272,11 @@ type
|
||||
FDelayedRemoveBreakpointList: TObjectList;
|
||||
protected
|
||||
procedure DoStateChange(const AOldState: TDBGState); override;
|
||||
procedure AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TDBGBreakPoint);
|
||||
procedure AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TFpInternalBreakpoint);
|
||||
public
|
||||
constructor Create(const ADebugger: TDebuggerIntf; const ABreakPointClass: TDBGBreakPointClass);
|
||||
destructor Destroy; override;
|
||||
function Find(AIntBReakpoint: FpDbgClasses.TDbgBreakpoint): TDBGBreakPoint;
|
||||
function Find(AIntBReakpoint: FpDbgClasses.TFpInternalBreakpoint): TDBGBreakPoint;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
@ -670,7 +670,7 @@ end;
|
||||
|
||||
procedure TFPBreakpoints.DoStateChange(const AOldState: TDBGState);
|
||||
var
|
||||
ABrkPoint: FpDbgClasses.TDbgBreakpoint;
|
||||
ABrkPoint: FpDbgClasses.TFpInternalBreakpoint;
|
||||
i: Integer;
|
||||
begin
|
||||
inherited DoStateChange(AOldState);
|
||||
@ -679,8 +679,8 @@ begin
|
||||
if FDelayedRemoveBreakpointList.Count>0 then
|
||||
for i := FDelayedRemoveBreakpointList.Count-1 downto 0 do
|
||||
begin
|
||||
ABrkPoint := FpDbgClasses.TDbgBreakpoint(FDelayedRemoveBreakpointList[i]);
|
||||
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(ABrkPoint.Location);
|
||||
ABrkPoint := FpDbgClasses.TFpInternalBreakpoint(FDelayedRemoveBreakpointList[i]);
|
||||
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(ABrkPoint);
|
||||
TFpDebugDebugger(Debugger).FreeBreakpoint(ABrkPoint);
|
||||
ABrkPoint := nil;
|
||||
FDelayedRemoveBreakpointList.Delete(i);
|
||||
@ -688,7 +688,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPBreakpoints.AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TDBGBreakPoint);
|
||||
procedure TFPBreakpoints.AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TFpInternalBreakpoint);
|
||||
begin
|
||||
FDelayedRemoveBreakpointList.Add(ABreakpoint);
|
||||
end;
|
||||
@ -705,7 +705,7 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFPBreakpoints.Find(AIntBReakpoint: FpDbgClasses.TDbgBreakpoint): TDBGBreakPoint;
|
||||
function TFPBreakpoints.Find(AIntBReakpoint: FpDbgClasses.TFpInternalBreakpoint): TDBGBreakPoint;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
@ -718,8 +718,6 @@ begin
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
{ TFPBreakpoint }
|
||||
|
||||
procedure TFPBreakpoint.SetBreak;
|
||||
begin
|
||||
assert(FInternalBreakpoint=nil);
|
||||
@ -742,7 +740,7 @@ begin
|
||||
// freed. And so are the corresponding InternalBreakpoint's.
|
||||
if assigned(Debugger) and assigned(FInternalBreakpoint) then
|
||||
begin
|
||||
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint.Location);
|
||||
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint);
|
||||
TFpDebugDebugger(Debugger).FreeBreakpoint(FInternalBreakpoint);
|
||||
FInternalBreakpoint := nil;
|
||||
end;
|
||||
@ -779,6 +777,7 @@ begin
|
||||
end
|
||||
else if Debugger.State = dsStop then
|
||||
begin
|
||||
TFpDebugDebugger(Debugger).FreeBreakpoint(FInternalBreakpoint);
|
||||
FInternalBreakpoint := nil;
|
||||
FIsSet:=false;
|
||||
end;
|
||||
@ -988,16 +987,18 @@ begin
|
||||
Result := FRequestedSources.Count;
|
||||
end;
|
||||
|
||||
function TFpLineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr;
|
||||
function TFpLineInfo.HasAddress(const AIndex: Integer; const ALine: Integer
|
||||
): Boolean;
|
||||
var
|
||||
Map: PDWarfLineMap;
|
||||
dummy: TDBGPtrArray;
|
||||
begin
|
||||
Result := 0;
|
||||
Result := False;
|
||||
if not((FpDebugger.DebugInfo <> nil) and (FpDebugger.DebugInfo is TFpDwarfInfo)) then
|
||||
exit;
|
||||
Map := PDWarfLineMap(FRequestedSources.Objects[AIndex]);
|
||||
if Map <> nil then
|
||||
Result := Map^.GetAddressForLine(ALine);
|
||||
Result := Map^.GetAddressesForLine(ALine, dummy, True);
|
||||
end;
|
||||
|
||||
function TFpLineInfo.GetInfo(AAddress: TDbgPtr; out ASource, ALine,
|
||||
@ -1129,6 +1130,7 @@ begin
|
||||
IncReleaseLock;
|
||||
try
|
||||
SetState(dsStop);
|
||||
FreeAndNil(FRaiseExceptionBreakpoint);
|
||||
FreeDebugThread;
|
||||
finally
|
||||
DecReleaseLock;
|
||||
@ -1484,7 +1486,8 @@ begin
|
||||
FFpDebugThread := nil;
|
||||
end;
|
||||
|
||||
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint);
|
||||
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(
|
||||
var continue: boolean; const Breakpoint: TFpInternalBreakpoint);
|
||||
var
|
||||
ABreakPoint: TDBGBreakPoint;
|
||||
ALocationAddr: TDBGLocationRec;
|
||||
@ -1507,7 +1510,7 @@ begin
|
||||
end
|
||||
else if FQuickPause then
|
||||
begin
|
||||
SetState(dsPause);
|
||||
SetState(dsPause);//dsInternalPause;
|
||||
continue:=true;
|
||||
exit;
|
||||
end
|
||||
@ -1537,7 +1540,7 @@ function TFpDebugDebugger.RequestCommand(const ACommand: TDBGCommand;
|
||||
var
|
||||
EvalFlags: TDBGEvaluateFlags;
|
||||
AConsoleTty: string;
|
||||
addr: TDBGPtr;
|
||||
addr: TDBGPtrArray;
|
||||
begin
|
||||
result := False;
|
||||
if assigned(FDbgController) then
|
||||
@ -1612,9 +1615,8 @@ begin
|
||||
result := false;
|
||||
if FDbgController.CurrentProcess.DbgInfo.HasInfo then
|
||||
begin
|
||||
addr := FDbgController.CurrentProcess.DbgInfo.GetLineAddress(AnsiString(AParams[0].VAnsiString), AParams[1].VInteger);
|
||||
if addr <> 0 then
|
||||
begin
|
||||
if FDbgController.CurrentProcess.DbgInfo.GetLineAddresses(AnsiString(AParams[0].VAnsiString), AParams[1].VInteger, addr)
|
||||
then begin
|
||||
result := true;
|
||||
FDbgController.InitializeCommand(TDbgControllerRunToCmd.Create(FDbgController, addr));
|
||||
SetState(dsRun);
|
||||
@ -1712,7 +1714,7 @@ begin
|
||||
|
||||
FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)
|
||||
|
||||
FQuickPause:=false;
|
||||
FQuickPause:=false; // TODO: there may be other events: deInternalContinue, deLoadLibrary...
|
||||
|
||||
if Cont then
|
||||
begin
|
||||
@ -1782,7 +1784,8 @@ end;
|
||||
|
||||
{$endif linux}
|
||||
|
||||
function TFpDebugDebugger.AddBreak(const ALocation: TDbgPtr): FpDbgClasses.TDbgBreakpoint;
|
||||
function TFpDebugDebugger.AddBreak(const ALocation: TDbgPtr
|
||||
): TFpInternalBreakpoint;
|
||||
begin
|
||||
{$ifdef linux}
|
||||
FCacheLocation:=ALocation;
|
||||
@ -1793,7 +1796,8 @@ begin
|
||||
{$endif linux}
|
||||
end;
|
||||
|
||||
function TFpDebugDebugger.AddBreak(const AFileName: String; ALine: Cardinal): FpDbgClasses.TDbgBreakpoint;
|
||||
function TFpDebugDebugger.AddBreak(const AFileName: String; ALine: Cardinal
|
||||
): TFpInternalBreakpoint;
|
||||
begin
|
||||
{$ifdef linux}
|
||||
FCacheFileName:=AFileName;
|
||||
@ -1805,7 +1809,8 @@ begin
|
||||
{$endif linux}
|
||||
end;
|
||||
|
||||
procedure TFpDebugDebugger.FreeBreakpoint(const ABreakpoint: FpDbgClasses.TDbgBreakpoint);
|
||||
procedure TFpDebugDebugger.FreeBreakpoint(
|
||||
const ABreakpoint: TFpInternalBreakpoint);
|
||||
begin
|
||||
{$ifdef linux}
|
||||
FCacheBreakpoint:=ABreakpoint;
|
||||
|
||||
@ -197,7 +197,7 @@ type
|
||||
constructor Create(const ADebugger: TDebuggerIntf);
|
||||
destructor Destroy; override;
|
||||
function Count: Integer; override;
|
||||
function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override;
|
||||
function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; override;
|
||||
function GetInfo(AAdress: TDbgPtr; out ASource, ALine, AOffset: Integer): Boolean; override;
|
||||
function IndexOf(const ASource: String): integer; override;
|
||||
procedure Request(const ASource: String); override;
|
||||
@ -654,17 +654,19 @@ begin
|
||||
Result := FRequestedSources.Count;
|
||||
end;
|
||||
|
||||
function TFpGDBMILineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr;
|
||||
function TFpGDBMILineInfo.HasAddress(const AIndex: Integer; const ALine: Integer
|
||||
): Boolean;
|
||||
var
|
||||
Map: PDWarfLineMap;
|
||||
dummy: TDBGPtrArray;
|
||||
begin
|
||||
Result := 0;
|
||||
Result := False;
|
||||
if not FpDebugger.HasDwarf then
|
||||
exit;
|
||||
//Result := FpDebugger.FDwarfInfo.GetLineAddress(FRequestedSources[AIndex], ALine);
|
||||
Map := PDWarfLineMap(FRequestedSources.Objects[AIndex]);
|
||||
if Map <> nil then
|
||||
Result := Map^.GetAddressForLine(ALine);
|
||||
Result := Map^.GetAddressesForLine(ALine, dummy, True);
|
||||
end;
|
||||
|
||||
function TFpGDBMILineInfo.GetInfo(AAdress: TDbgPtr; out ASource, ALine,
|
||||
|
||||
@ -944,7 +944,7 @@ type
|
||||
procedure AddNotification(const ANotification: TIDELineInfoNotification);
|
||||
procedure RemoveNotification(const ANotification: TIDELineInfoNotification);
|
||||
function Count: Integer; override;
|
||||
function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override;
|
||||
function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; override;
|
||||
function GetInfo(AAdress: TDbgPtr; out ASource, ALine, AOffset: Integer): Boolean; override;
|
||||
function IndexOf(const ASource: String): integer; override;
|
||||
procedure Request(const ASource: String); override;
|
||||
@ -6862,11 +6862,12 @@ begin
|
||||
else Result := Master.Count;
|
||||
end;
|
||||
|
||||
function TIDELineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr;
|
||||
function TIDELineInfo.HasAddress(const AIndex: Integer; const ALine: Integer
|
||||
): Boolean;
|
||||
begin
|
||||
if Master = nil
|
||||
then Result := inherited GetAddress(AIndex, ALine)
|
||||
else Result := Master.GetAddress(AIndex, ALine);
|
||||
then Result := inherited HasAddress(AIndex, ALine)
|
||||
else Result := Master.HasAddress(AIndex, ALine);
|
||||
end;
|
||||
|
||||
function TIDELineInfo.GetInfo(AAdress: TDbgPtr; out ASource, ALine,
|
||||
|
||||
@ -5874,7 +5874,7 @@ procedure TSourceEditor.FillExecutionMarks;
|
||||
var
|
||||
ASource: String;
|
||||
i, idx: integer;
|
||||
Addr: TDBGPtr;
|
||||
HasAddr: Boolean;
|
||||
j: Integer;
|
||||
begin
|
||||
if EditorComponent.IDEGutterMarks.HasDebugMarks then Exit;
|
||||
@ -5899,15 +5899,15 @@ begin
|
||||
try
|
||||
for i := 1 to EditorComponent.Lines.Count do
|
||||
begin
|
||||
Addr := DebugBoss.LineInfo.GetAddress(idx, i);
|
||||
if (Addr <> 0) and (j < 0) then
|
||||
HasAddr := DebugBoss.LineInfo.HasAddress(idx, i);
|
||||
if (HasAddr) and (j < 0) then
|
||||
j := i;
|
||||
if (Addr = 0) and (j >= 0) then begin
|
||||
if (not HasAddr) and (j >= 0) then begin
|
||||
EditorComponent.IDEGutterMarks.SetDebugMarks(j, i-1);
|
||||
j := -1;
|
||||
end;
|
||||
end;
|
||||
if (Addr <> 0) and (j >= 0) then
|
||||
if (HasAddr) and (j >= 0) then
|
||||
EditorComponent.IDEGutterMarks.SetDebugMarks(j, EditorComponent.Lines.Count);
|
||||
finally
|
||||
EditorComponent.IDEGutterMarks.EndSetDebugMarks;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user