paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-15 11:49:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: more asserts for correct thread usage

Browse Source 
(cherry picked from commit 6fc5c2fcdd)
This commit is contained in:
Martin 2021-10-13 19:34:55 +02:00
parent 1b9c784595
commit cff1d53e40
3 changed files with 51 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -284,7 +284,7 @@ var
aKernResult: kern_return_t;
old_StateCnt: mach_msg_Type_number_t;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.ResetBreak');{$ENDIF}
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgDarwinThread.ReadThreadState');{$ENDIF}
if ID<0 then
begin
// The ID is set to -1 when the debugger does not have sufficient rights.
@ -733,6 +733,7 @@ var
cnt: mach_msg_Type_number_t;
b: pointer;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgDarwinProcess.ReadData');{$ENDIF}
result := false;
aKernResult := mach_vm_read(FTaskPort, AAdress, ASize, PtrUInt(b), cnt);
@ -751,6 +752,7 @@ function TDbgDarwinProcess.WriteData(const AAdress: TDbgPtr;
var
aKernResult: kern_return_t;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgDarwinProcess.WriteData');{$ENDIF}
result := false;
aKernResult:=mach_vm_protect(FTaskPort, AAdress, ASize, boolean_t(false), 7 {VM_PROT_READ + VM_PROT_WRITE + VM_PROT_COPY});
if aKernResult <> KERN_SUCCESS then

20
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -462,8 +462,9 @@ function TDbgLinuxThread.ReadThreadState: boolean;
var
io: iovec;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.ResetBreak');{$ENDIF}
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxThread.ReadThreadState');{$ENDIF}
assert(FIsPaused, 'TDbgLinuxThread.ReadThreadState: FIsPaused');
result := true;
if FHasThreadState then
exit;
@ -559,6 +560,9 @@ end;
function TDbgLinuxThread.ResetInstructionPointerAfterBreakpoint: boolean;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxThread.ResetInstructionPointerAfterBreakpoint');{$ENDIF}
assert(FIsPaused, 'TDbgLinuxThread.ResetInstructionPointerAfterBreakpoint: FIsPaused');
if not ReadThreadState then
exit(False);
result := true;
@ -638,6 +642,9 @@ end;
procedure TDbgLinuxThread.LoadRegisterValues;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxThread.LoadRegisterValues');{$ENDIF}
assert(FIsPaused, 'TDbgLinuxThread.LoadRegisterValues: FIsPaused');
if not ReadThreadState then
exit;
if Process.Mode=dm32 then
@ -692,6 +699,9 @@ end;
function TDbgLinuxThread.GetInstructionPointerRegisterValue: TDbgPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxThread.GetInstructionPointerRegisterValue');{$ENDIF}
assert(FIsPaused, 'TDbgLinuxThread.GetInstructionPointerRegisterValue: FIsPaused');
Result := 0;
if not ReadThreadState then
exit;
@ -703,6 +713,9 @@ end;
function TDbgLinuxThread.GetStackBasePointerRegisterValue: TDbgPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxThread.GetStackBasePointerRegisterValue');{$ENDIF}
assert(FIsPaused, 'TDbgLinuxThread.GetStackBasePointerRegisterValue: FIsPaused');
Result := 0;
if not ReadThreadState then
exit;
@ -714,6 +727,9 @@ end;
function TDbgLinuxThread.GetStackPointerRegisterValue: TDbgPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxThread.GetStackPointerRegisterValue');{$ENDIF}
assert(FIsPaused, 'TDbgLinuxThread.GetStackPointerRegisterValue: FIsPaused');
Result := 0;
if not ReadThreadState then
exit;
@ -955,6 +971,7 @@ var
buf: pbyte;
AAdressAlign: TDBGPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxProcess.ReadData');{$ENDIF}
result := false;
fpseterrno(0);
BytesDone := 0;
@ -1009,6 +1026,7 @@ var
buf: PByte;
AAdressAlign: TDBGPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxProcess.WriteData');{$ENDIF}
result := false;
fpseterrno(0);
BytesDone := 0;

31
components/fpdebug/fpdbgwinclasses.pas
View File

@ -512,6 +512,8 @@ function TDbgWinProcess.ReadData(const AAdress: TDbgPtr; const ASize: Cardinal;
var
BytesRead: PtrUInt;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinProcess.ReadData');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinProcess.ReadData: MDebugEvent.dwProcessId <> 0');
Result := ReadProcessMemory(Handle, Pointer(PtrUInt(AAdress)), @AData, ASize, BytesRead) and (BytesRead = ASize);
if not Result then LogLastError;
@ -522,6 +524,8 @@ function TDbgWinProcess.WriteData(const AAdress: TDbgPtr; const ASize: Cardinal;
var
BytesWritten: PtrUInt;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinProcess.WriteData');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinProcess.WriteData: MDebugEvent.dwProcessId <> 0');
Result := WriteProcessMemory(Handle, Pointer(PtrUInt(AAdress)), @AData, ASize, BytesWritten) and (BytesWritten = ASize);
if not Result then LogLastError;
@ -532,6 +536,8 @@ var
BytesRead: PtrUInt;
buf: array of Char;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinProcess.ReadString');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinProcess.ReadString: MDebugEvent.dwProcessId <> 0');
AData := '';
SetLength(buf, AMaxSize + 1);
Result := ReadProcessMemory(Handle, Pointer(PtrUInt(AAdress)), @Buf[0], AMaxSize, BytesRead);
@ -547,6 +553,8 @@ var
BytesRead: PtrUInt;
buf: array of WChar;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinProcess.ReadWString');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinProcess.ReadWString: MDebugEvent.dwProcessId <> 0');
AData := '';
SetLength(buf, AMaxSize + 1);
Result := ReadProcessMemory(Handle, Pointer(PtrUInt(AAdress)), @Buf[0], SizeOf(WChar) * AMaxSize, BytesRead);
@ -1404,6 +1412,9 @@ end;
procedure TDbgWinThread.LoadRegisterValues;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.LoadRegisterValues');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinThread.LoadRegisterValues: MDebugEvent.dwProcessId <> 0');
if FCurrentContext = nil then
if not ReadThreadState then
exit;
@ -1708,9 +1719,12 @@ end;
function TDbgWinThread.ResetInstructionPointerAfterBreakpoint: boolean;
begin
Result := False;
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.ResetInstructionPointerAfterBreakpoint');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinThread.ResetInstructionPointerAfterBreakpoint: MDebugEvent.dwProcessId <> 0');
assert(MDebugEvent.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_SINGLE_STEP, 'dec(IP) EXCEPTION_SINGLE_STEP');
Result := False;
if not ReadThreadState then
exit;
@ -1731,8 +1745,9 @@ end;
function TDbgWinThread.ReadThreadState: boolean;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.ResetBreak');{$ENDIF}
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.ReadThreadState');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinThread.ReadThreadState: MDebugEvent.dwProcessId <> 0');
if Process.ProcessID <> MDebugEvent.dwProcessId then begin
DebugLn(DBG_WARNINGS, 'ERROR: attempt to read threadstate, for wrong process. Thread: %u Thread-Process: %u Event-Process %u', [Id, Process.ProcessID, MDebugEvent.dwProcessId]);
exit(False);
@ -1750,6 +1765,9 @@ end;
procedure TDbgWinThread.SetRegisterValue(AName: string; AValue: QWord);
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.SetRegisterValue');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinThread.SetRegisterValue: MDebugEvent.dwProcessId <> 0');
if not ReadThreadState then
exit;
@ -1803,6 +1821,9 @@ end;
function TDbgWinThread.GetInstructionPointerRegisterValue: TDbgPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.GetInstructionPointerRegisterValue');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinThread.GetInstructionPointerRegisterValue: MDebugEvent.dwProcessId <> 0');
Result := 0;
if FCurrentContext = nil then
if not ReadThreadState then
@ -1819,6 +1840,9 @@ end;
function TDbgWinThread.GetStackBasePointerRegisterValue: TDbgPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.GetStackBasePointerRegisterValue');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinThread.GetStackBasePointerRegisterValue: MDebugEvent.dwProcessId <> 0');
Result := 0;
if FCurrentContext = nil then
if not ReadThreadState then
@ -1835,6 +1859,9 @@ end;
function TDbgWinThread.GetStackPointerRegisterValue: TDbgPtr;
begin
{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.GetStackPointerRegisterValue');{$ENDIF}
assert(MDebugEvent.dwProcessId <> 0, 'TDbgWinThread.GetStackPointerRegisterValue: MDebugEvent.dwProcessId <> 0');
Result := 0;
if FCurrentContext = nil then
if not ReadThreadState then