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

FpDebug: More refactor internal breakpoints. Move detection for ResetInstructionPointerAfterBreakpoint into OS classes.

Browse Source 
git-svn-id: trunk@60142 -
This commit is contained in:
martin 2019-01-22 02:11:44 +00:00
parent e1e84a2799
commit a48c9c1b69
4 changed files with 89 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
components/fpdebug/fpdbgclasses.pp
View File

@ -141,7 +141,7 @@ type
FProcess: TDbgProcess; FProcess: TDbgProcess;
FID: Integer; FID: Integer;
FHandle: THandle; FHandle: THandle;
FNeedIPDecrement: boolean; FIsAtBreakInstruction: Boolean;
function GetRegisterValueList: TDbgRegisterValueList; function GetRegisterValueList: TDbgRegisterValueList;
protected protected
FCallStackEntryList: TDbgCallstackEntryList; FCallStackEntryList: TDbgCallstackEntryList;
@ -153,9 +153,10 @@ type
FStoreStepFuncAddr: TDBGPtr; FStoreStepFuncAddr: TDBGPtr;
procedure LoadRegisterValues; virtual; procedure LoadRegisterValues; virtual;
property Process: TDbgProcess read FProcess; property Process: TDbgProcess read FProcess;
function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract;
public public
constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); virtual; constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); virtual;
function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract; function CheckAndResetInstructionPointerAfterBreakpoint: boolean;
procedure BeforeContinue; virtual; procedure BeforeContinue; virtual;
function AddWatchpoint(AnAddr: TDBGPtr): integer; virtual; function AddWatchpoint(AnAddr: TDBGPtr): integer; virtual;
function RemoveWatchpoint(AnId: integer): boolean; virtual; function RemoveWatchpoint(AnId: integer): boolean; virtual;
@ -176,6 +177,7 @@ type
property NextIsSingleStep: boolean read FNextIsSingleStep write FNextIsSingleStep; property NextIsSingleStep: boolean read FNextIsSingleStep write FNextIsSingleStep;
property RegisterValueList: TDbgRegisterValueList read GetRegisterValueList; property RegisterValueList: TDbgRegisterValueList read GetRegisterValueList;
property CallStackEntryList: TDbgCallstackEntryList read FCallStackEntryList; property CallStackEntryList: TDbgCallstackEntryList read FCallStackEntryList;
property IsAtBreakInstruction: boolean read FIsAtBreakInstruction; // Is stopped at Int3 code. Needs to exec orig instruction instead
end; end;
TDbgThreadClass = class of TDbgThread; TDbgThreadClass = class of TDbgThread;
@ -240,7 +242,7 @@ type
procedure AddLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint; AnIgnoreIfExists: Boolean = True); procedure AddLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint; AnIgnoreIfExists: Boolean = True);
procedure RemoveLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint); procedure RemoveLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint);
function GetInternalBreaksAtLocation(const ALocation: TDBGPtr): TFpInternalBreakpointArray; function GetInternalBreaksAtLocation(const ALocation: TDBGPtr): TFpInternalBreakpointArray;
function GetOrigValueAtLocation(const ALocation: TDBGPtr): Byte; function GetOrigValueAtLocation(const ALocation: TDBGPtr): Byte; // returns Int3, if there is no break at this location
function GetEnumerator: TBreakLocationMapEnumerator; function GetEnumerator: TBreakLocationMapEnumerator;
end; end;
@ -259,8 +261,6 @@ type
private private
FProcess: TDbgProcess; FProcess: TDbgProcess;
FLocation: TDBGPtrArray; FLocation: TDBGPtrArray;
const
Int3: Byte = $CC;
protected protected
property Process: TDbgProcess read FProcess; property Process: TDbgProcess read FProcess;
property Location: TDBGPtrArray read FLocation; property Location: TDBGPtrArray read FLocation;
@ -325,7 +325,7 @@ type
{ TDbgProcess } { TDbgProcess }
TDbgProcess = class(TDbgInstance) TDbgProcess = class(TDbgInstance)
private const protected const
Int3: Byte = $CC; Int3: Byte = $CC;
private private
FExceptionClass: string; FExceptionClass: string;
@ -1247,16 +1247,6 @@ begin
// Determine the address where the execution has stopped // Determine the address where the execution has stopped
CurrentAddr:=AThread.GetInstructionPointerRegisterValue; CurrentAddr:=AThread.GetInstructionPointerRegisterValue;
FCurrentWatchpoint:=AThread.DetectHardwareWatchpoint; FCurrentWatchpoint:=AThread.DetectHardwareWatchpoint;
if not (AThread.NextIsSingleStep or assigned(FCurrentBreakpoint) or (FCurrentWatchpoint>-1)) then
begin
// The debugger did not stop due to single-stepping or a watchpoint,
// so a breakpoint has been hit. But breakpoints stop *after* they
// have been hit. So decrement the CurrentAddr.
AThread.FNeedIPDecrement:=true;
dec(CurrentAddr);
end
else
AThread.FNeedIPDecrement:=false;
FCurrentBreakpoint:=nil; FCurrentBreakpoint:=nil;
AThread.NextIsSingleStep:=false; AThread.NextIsSingleStep:=false;
@ -1676,6 +1666,15 @@ begin
inherited Create; inherited Create;
end; end;
function TDbgThread.CheckAndResetInstructionPointerAfterBreakpoint: boolean;
begin
// todo: check that the breakpoint is NOT in the temp removed list
if FProcess.FBreakMap.GetOrigValueAtLocation(GetInstructionPointerRegisterValue - 1) = TDbgProcess.Int3 then
exit;
FIsAtBreakInstruction := True;
ResetInstructionPointerAfterBreakpoint;
end;
procedure TDbgThread.BeforeContinue; procedure TDbgThread.BeforeContinue;
begin begin
// Do nothing // Do nothing
@ -1791,14 +1790,11 @@ begin
exit; // breakpoint on a hardcoded breakpoint exit; // breakpoint on a hardcoded breakpoint
// no need to jump back and restore instruction // no need to jump back and restore instruction
// This is either the breakpoint that WAS just stepped over (ResetInstructionPointerAfterBreakpoint
// Or a breakpoint that is at the next command (step ended, before breakpoint)
FProcess.TempRemoveBreakInstructionCode(ABreakpointAddress); FProcess.TempRemoveBreakInstructionCode(ABreakpointAddress);
if not Process.GetThread(AThreadId, Thread) then Exit; Result := true;
if Thread.FNeedIPDecrement then
Result := Thread.ResetInstructionPointerAfterBreakpoint
else
Result := true;
end; end;
//function TFpInternalBreakpoint.HasLocation(const ALocation: TDBGPtr): Boolean; //function TFpInternalBreakpoint.HasLocation(const ALocation: TDBGPtr): Boolean;

11
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -107,6 +107,7 @@ type
FDebugState64: x86_debug_state64_t; FDebugState64: x86_debug_state64_t;
FDebugStateRead: boolean; FDebugStateRead: boolean;
FDebugStateChanged: boolean; FDebugStateChanged: boolean;
FIsSteppingBreakPoint: boolean;
protected protected
function ReadThreadState: boolean; function ReadThreadState: boolean;
function ReadDebugState: boolean; function ReadDebugState: boolean;
@ -867,8 +868,10 @@ begin
{$ifdef darwin} {$ifdef darwin}
AThread.NextIsSingleStep:=SingleStep; AThread.NextIsSingleStep:=SingleStep;
AThread.BeforeContinue; AThread.BeforeContinue;
if SingleStep or assigned(FCurrentBreakpoint) then if SingleStep or assigned(FCurrentBreakpoint) then begin
fpPTrace(PTRACE_SINGLESTEP, ProcessID, pointer(1), pointer(FExceptionSignal)) fpPTrace(PTRACE_SINGLESTEP, ProcessID, pointer(1), pointer(FExceptionSignal))
TDbgDarwinThread(AThread).FIsSteppingBreakPoint := True;
end
else if FIsTerminating then else if FIsTerminating then
fpPTrace(PTRACE_KILL, ProcessID, pointer(1), nil) fpPTrace(PTRACE_KILL, ProcessID, pointer(1), nil)
else else
@ -940,7 +943,11 @@ begin
FProcessStarted:=true; FProcessStarted:=true;
end end
else else
begin
result := deBreakpoint; result := deBreakpoint;
if not TDbgDarwinThread(AThread).FIsSteppingBreakPoint then
AThread.CheckAndResetInstructionPointerAfterBreakpoint;
end
end; end;
SIGBUS: SIGBUS:
begin begin
@ -988,6 +995,8 @@ begin
end end
else else
raise exception.CreateFmt('Received unknown status %d from process with pid=%d',[FStatus, ProcessID]); raise exception.CreateFmt('Received unknown status %d from process with pid=%d',[FStatus, ProcessID]);
TDbgDarwinThread(AThread).FIsSteppingBreakPoint := False;
end; end;
end. end.

12
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -232,6 +232,7 @@ type
// For other threads this is the full status (stored to execute event later.) // For other threads this is the full status (stored to execute event later.)
FExceptionSignal: cint; FExceptionSignal: cint;
FIsPaused, FInternalPauseRequested, FIsInInternalPause: boolean; FIsPaused, FInternalPauseRequested, FIsInInternalPause: boolean;
FIsSteppingBreakPoint: boolean;
function GetDebugRegOffset(ind: byte): pointer; function GetDebugRegOffset(ind: byte): pointer;
function ReadDebugReg(ind: byte; out AVal: PtrUInt): boolean; function ReadDebugReg(ind: byte; out AVal: PtrUInt): boolean;
function WriteDebugReg(ind: byte; AVal: PtrUInt): boolean; function WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
@ -891,6 +892,7 @@ begin
if assigned(FCurrentBreakpoint) then begin if assigned(FCurrentBreakpoint) then begin
fpseterrno(0); fpseterrno(0);
AThread.NextIsSingleStep:=SingleStep; AThread.NextIsSingleStep:=SingleStep;
TDbgLinuxThread(AThread).FIsSteppingBreakPoint := True;
AThread.BeforeContinue; AThread.BeforeContinue;
fpPTrace(PTRACE_SINGLESTEP, AThread.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal))); fpPTrace(PTRACE_SINGLESTEP, AThread.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal)));
TDbgLinuxThread(AThread).FIsPaused := False; TDbgLinuxThread(AThread).FIsPaused := False;
@ -1047,7 +1049,11 @@ begin
result := deInternalContinue; // left over signal result := deInternalContinue; // left over signal
end end
else else
begin
result := deBreakpoint; // or pause requested result := deBreakpoint; // or pause requested
if not TDbgLinuxThread(AThread).FIsSteppingBreakPoint then
AThread.CheckAndResetInstructionPointerAfterBreakpoint;
end;
end; end;
SIGBUS: SIGBUS:
begin begin
@ -1101,6 +1107,8 @@ begin
else else
raise exception.CreateFmt('Received unknown status %d from process with pid=%d',[FStatus, ProcessID]); raise exception.CreateFmt('Received unknown status %d from process with pid=%d',[FStatus, ProcessID]);
TDbgLinuxThread(AThread).FIsSteppingBreakPoint := False;
if Result in [deException, deBreakpoint, deFinishedStep] then begin // deFinishedStep will not be set here if Result in [deException, deBreakpoint, deFinishedStep] then begin // deFinishedStep will not be set here
// Signal all other threads to pause // Signal all other threads to pause
PauseWaitCount := 0; PauseWaitCount := 0;
@ -1139,7 +1147,9 @@ begin
if ThreadToPause.FInternalPauseRequested then begin if ThreadToPause.FInternalPauseRequested then begin
dec(PauseWaitCount); dec(PauseWaitCount);
if (wstopsig(WaitStatus) = SIGTRAP) then begin if (wstopsig(WaitStatus) = SIGTRAP) then begin
// TODO: check if the SigTrap was caused by a breakpoint // TODO: if breakpoint, mark that the internalpause request may still be received
ThreadToPause.CheckAndResetInstructionPointerAfterBreakpoint;
ThreadToPause.FInternalPauseRequested := False; ThreadToPause.FInternalPauseRequested := False;
ThreadToPause.FIsInInternalPause := True; ThreadToPause.FIsInInternalPause := True;
ThreadToPause.FExceptionSignal := 0; ThreadToPause.FExceptionSignal := 0;

105
components/fpdebug/fpdbgwinclasses.pas
View File

@ -401,50 +401,50 @@ end;
------------------------------------------------------------------ } ------------------------------------------------------------------ }
function TDbgWinProcess.HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean; function TDbgWinProcess.HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
function DoSingleStep: Boolean; //function DoSingleStep: Boolean;
var //var
_UC: record // _UC: record
C: TContext; // C: TContext;
D: array[1..16] of Byte; // D: array[1..16] of Byte;
end; // end;
Context: PContext; // Context: PContext;
begin //begin
Result := False; // Result := False;
// check if we are interupting // // check if we are interupting
Context := AlignPtr(@_UC, $10); // Context := AlignPtr(@_UC, $10);
Context^.ContextFlags := CONTEXT_DEBUG_REGISTERS; // Context^.ContextFlags := CONTEXT_DEBUG_REGISTERS;
if GetThreadContext(FInfo.hThread, Context^) // if GetThreadContext(FInfo.hThread, Context^)
then begin // then begin
if Context^.Dr6 and 1 <> 0 // if Context^.Dr6 and 1 <> 0
then begin // then begin
// interrupt ! // // interrupt !
// disable break. // // disable break.
Context^.Dr7 := Context^.Dr7 and not $1; // Context^.Dr7 := Context^.Dr7 and not $1;
Context^.Dr0 := 0; // Context^.Dr0 := 0;
if not SetThreadContext(FInfo.hThread, Context^) // if not SetThreadContext(FInfo.hThread, Context^)
then begin // then begin
// Heeellppp!! // // Heeellppp!!
Log('Thread %u: Unable to reset BR0', [ADebugEvent.dwThreadId]); // Log('Thread %u: Unable to reset BR0', [ADebugEvent.dwThreadId]);
end; // end;
// check if we are also singlestepping // // check if we are also singlestepping
// if not, then exit, else proceed to next check // // if not, then exit, else proceed to next check
if Context^.Dr6 and $40 = 0 // if Context^.Dr6 and $40 = 0
then Exit; // then Exit;
end; // end;
end // end
else begin // else begin
// if we can not get the context, we probable weren't able to set it either // // if we can not get the context, we probable weren't able to set it either
Log('Thread %u: Unable to get context', [ADebugEvent.dwThreadId]); // Log('Thread %u: Unable to get context', [ADebugEvent.dwThreadId]);
end; // end;
//
// check if we are single stepping ourself // // check if we are single stepping ourself
if FCurrentBreakpoint = nil then Exit; // if FCurrentBreakpoint = nil then Exit;
//
FCurrentBreakpoint.SetBreak; // FCurrentBreakpoint.SetBreak;
FCurrentBreakpoint := nil; // FCurrentBreakpoint := nil;
Result := FReEnableBreakStep; // Result := FReEnableBreakStep;
FReEnableBreakStep := False; // FReEnableBreakStep := False;
end; //end;
begin begin
Result := False; Result := False;
@ -800,7 +800,7 @@ var
InterceptAtFirst: Boolean; InterceptAtFirst: Boolean;
begin begin
if HandleDebugEvent(MDebugEvent) if HandleDebugEvent(MDebugEvent)
then result := deBreakpoint then result := deBreakpoint // unreachable
else begin else begin
if AThread <> nil if AThread <> nil
then begin then begin
@ -820,8 +820,10 @@ begin
FJustStarted:=false; FJustStarted:=false;
result := deInternalContinue; result := deInternalContinue;
end end
else else begin
result := deBreakpoint; result := deBreakpoint;
AThread.CheckAndResetInstructionPointerAfterBreakpoint;
end;
end; end;
EXCEPTION_SINGLE_STEP: begin EXCEPTION_SINGLE_STEP: begin
result := deBreakpoint; result := deBreakpoint;
@ -1164,17 +1166,9 @@ var
Context: PContext; Context: PContext;
begin begin
Result := False; Result := False;
assert(MDebugEvent.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_SINGLE_STEP, 'dec(IP) EXCEPTION_SINGLE_STEP');
// If the location of the breakpoint is reached by single-stepping, there is
// no need to decrement the instruction pointer.
if MDebugEvent.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_SINGLE_STEP
then begin
result := true;
Exit;
end;
Context := AlignPtr(@_UC, $10); Context := AlignPtr(@_UC, $10);
Context^.ContextFlags := CONTEXT_CONTROL; Context^.ContextFlags := CONTEXT_CONTROL;
if not GetThreadContext(Handle, Context^) if not GetThreadContext(Handle, Context^)
then begin then begin
@ -1199,6 +1193,7 @@ begin
Log('Unable to set context'); Log('Unable to set context');
Exit; Exit;
end; end;
// TODO: only changed FCurrentContext, and write back in BeforeContinue;
FThreadContextChanged:=false; FThreadContextChanged:=false;
Result := True; Result := True;
end; end;