paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 03:16:10 +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;
FID: Integer;
FHandle: THandle;
FNeedIPDecrement: boolean;
FIsAtBreakInstruction: Boolean;
function GetRegisterValueList: TDbgRegisterValueList;
protected
FCallStackEntryList: TDbgCallstackEntryList;
@ -153,9 +153,10 @@ type
FStoreStepFuncAddr: TDBGPtr;
procedure LoadRegisterValues; virtual;
property Process: TDbgProcess read FProcess;
function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract;
public
constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); virtual;
function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract;
function CheckAndResetInstructionPointerAfterBreakpoint: boolean;
procedure BeforeContinue; virtual;
function AddWatchpoint(AnAddr: TDBGPtr): integer; virtual;
function RemoveWatchpoint(AnId: integer): boolean; virtual;
@ -176,6 +177,7 @@ type
property NextIsSingleStep: boolean read FNextIsSingleStep write FNextIsSingleStep;
property RegisterValueList: TDbgRegisterValueList read GetRegisterValueList;
property CallStackEntryList: TDbgCallstackEntryList read FCallStackEntryList;
property IsAtBreakInstruction: boolean read FIsAtBreakInstruction; // Is stopped at Int3 code. Needs to exec orig instruction instead
end;
TDbgThreadClass = class of TDbgThread;
@ -240,7 +242,7 @@ type
procedure AddLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint; AnIgnoreIfExists: Boolean = True);
procedure RemoveLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint);
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;
end;
@ -259,8 +261,6 @@ type
private
FProcess: TDbgProcess;
FLocation: TDBGPtrArray;
const
Int3: Byte = $CC;
protected
property Process: TDbgProcess read FProcess;
property Location: TDBGPtrArray read FLocation;
@ -325,7 +325,7 @@ type
{ TDbgProcess }
TDbgProcess = class(TDbgInstance)
private const
protected const
Int3: Byte = $CC;
private
FExceptionClass: string;
@ -1247,16 +1247,6 @@ begin
// Determine the address where the execution has stopped
CurrentAddr:=AThread.GetInstructionPointerRegisterValue;
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;
AThread.NextIsSingleStep:=false;
@ -1676,6 +1666,15 @@ begin
inherited Create;
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;
begin
// Do nothing
@ -1791,14 +1790,11 @@ begin
exit; // breakpoint on a hardcoded breakpoint
// 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);
if not Process.GetThread(AThreadId, Thread) then Exit;
if Thread.FNeedIPDecrement then
Result := Thread.ResetInstructionPointerAfterBreakpoint
else
Result := true;
Result := true;
end;
//function TFpInternalBreakpoint.HasLocation(const ALocation: TDBGPtr): Boolean;

11
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -107,6 +107,7 @@ type
FDebugState64: x86_debug_state64_t;
FDebugStateRead: boolean;
FDebugStateChanged: boolean;
FIsSteppingBreakPoint: boolean;
protected
function ReadThreadState: boolean;
function ReadDebugState: boolean;
@ -867,8 +868,10 @@ begin
{$ifdef darwin}
AThread.NextIsSingleStep:=SingleStep;
AThread.BeforeContinue;
if SingleStep or assigned(FCurrentBreakpoint) then
if SingleStep or assigned(FCurrentBreakpoint) then begin
fpPTrace(PTRACE_SINGLESTEP, ProcessID, pointer(1), pointer(FExceptionSignal))
TDbgDarwinThread(AThread).FIsSteppingBreakPoint := True;
end
else if FIsTerminating then
fpPTrace(PTRACE_KILL, ProcessID, pointer(1), nil)
else
@ -940,7 +943,11 @@ begin
FProcessStarted:=true;
end
else
begin
result := deBreakpoint;
if not TDbgDarwinThread(AThread).FIsSteppingBreakPoint then
AThread.CheckAndResetInstructionPointerAfterBreakpoint;
end
end;
SIGBUS:
begin
@ -988,6 +995,8 @@ begin
end
else
raise exception.CreateFmt('Received unknown status %d from process with pid=%d',[FStatus, ProcessID]);
TDbgDarwinThread(AThread).FIsSteppingBreakPoint := False;
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.)
FExceptionSignal: cint;
FIsPaused, FInternalPauseRequested, FIsInInternalPause: boolean;
FIsSteppingBreakPoint: boolean;
function GetDebugRegOffset(ind: byte): pointer;
function ReadDebugReg(ind: byte; out AVal: PtrUInt): boolean;
function WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
@ -891,6 +892,7 @@ begin
if assigned(FCurrentBreakpoint) then begin
fpseterrno(0);
AThread.NextIsSingleStep:=SingleStep;
TDbgLinuxThread(AThread).FIsSteppingBreakPoint := True;
AThread.BeforeContinue;
fpPTrace(PTRACE_SINGLESTEP, AThread.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal)));
TDbgLinuxThread(AThread).FIsPaused := False;
@ -1047,7 +1049,11 @@ begin
result := deInternalContinue; // left over signal
end
else
begin
result := deBreakpoint; // or pause requested
if not TDbgLinuxThread(AThread).FIsSteppingBreakPoint then
AThread.CheckAndResetInstructionPointerAfterBreakpoint;
end;
end;
SIGBUS:
begin
@ -1101,6 +1107,8 @@ begin
else
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
// Signal all other threads to pause
PauseWaitCount := 0;
@ -1139,7 +1147,9 @@ begin
if ThreadToPause.FInternalPauseRequested then begin
dec(PauseWaitCount);
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.FIsInInternalPause := True;
ThreadToPause.FExceptionSignal := 0;

105
components/fpdebug/fpdbgwinclasses.pas
View File

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