From 28c86c583b075a9221fcae3ba5c04e360a96f021 Mon Sep 17 00:00:00 2001 From: ccrause Date: Mon, 8 Apr 2024 21:53:10 +0200 Subject: [PATCH] [fpdebug] Track initialization of the remote connection. Fix some issues with qemu and Bloom debug servers. --- components/fpdebug/fpdbgrsp.pas | 77 ++++++++++++++------------ components/fpdebug/fpdbgrspclasses.pas | 19 +++++-- 2 files changed, 55 insertions(+), 41 deletions(-) diff --git a/components/fpdebug/fpdbgrsp.pas b/components/fpdebug/fpdbgrsp.pas index 1b6d72e14d..3dcb108475 100644 --- a/components/fpdebug/fpdbgrsp.pas +++ b/components/fpdebug/fpdbgrsp.pas @@ -92,8 +92,11 @@ type // Catch exceptions and store as socket errors FSockErr: boolean; FConfig: TRemoteConfig; - function WaitForData(timeout_ms: integer): integer; overload; + FSocketHandler: TSocketHandler; + procedure CloseSocket; + + function WaitForData(timeout_ms: integer): integer; overload; // Wrappers to catch exceptions and set SockErr function SafeReadByte: byte; function SafeWrite(const buffer; count : Longint): Longint; @@ -212,6 +215,11 @@ begin end; end; +procedure TRspConnection.CloseSocket; +begin + FpClose(FSocketHandler.Socket.Handle); +end; + function TRspConnection.WaitForData(timeout_ms: integer): integer; {$if defined(unix) or defined(windows)} var @@ -299,21 +307,23 @@ begin result := false; if SockErr then exit; retryCount := 0; + c := '-'; - repeat - if SendCommand(cmd) then + while not result and (retryCount < 5) and not SockErr do + begin + if c = '-' then begin - // now check if target returned error, resend ('-') or ACK ('+') - // No support for ‘QStartNoAckMode’, i.e. always expect a -/+ - c := char(SafeReadByte); - result := c = '+'; - if not result then + if not SendCommand(cmd) then inc(retryCount); - end - else + end; + + // now check target return value, either ACK ('+'), resend ('-') or garbage + // No support for ‘QStartNoAckMode’, i.e. always expect a -/+ + c := char(SafeReadByte); + result := c = '+'; + if not result then inc(retryCount); - // Abort this command if no ACK after 5 attempts - until result or (retryCount > 5) or SockErr; + end; end; function TRspConnection.ReadReply(out retval: string): boolean; @@ -399,9 +409,8 @@ begin end; until not outputPacket; - // Do not acknowledge OK - if retval <> 'OK' then - SafeWriteByte(byte('+')); + // Acknowledge all replies + SafeWriteByte(byte('+')); result := not SockErr; DebugLn(DBG_RSP, ['RSP <- ', retval]); end; @@ -516,19 +525,12 @@ var begin EnterCriticalSection(fCS); try - result := SendCommand('k'); - // Swallow the last ack if send - if Result and not SockErr then - result := WaitForData(1000) > 0; + SendCommandAck('k'); + result := true; + CloseSocket; finally LeaveCriticalSection(fCS); end; - - if result then - begin - c := char(SafeReadByte); - Result := c = '+'; - end; end; function TRspConnection.Detach(): boolean; @@ -538,16 +540,15 @@ begin EnterCriticalSection(fCS); try result := SendCmdWaitForReply('D', reply); + result := true; + CloseSocket; finally LeaveCriticalSection(fCS); end; - result := not(SockErr) and (pos('OK', reply) = 1); end; constructor TRspConnection.Create(AFileName: string; AOwner: TDbgProcess; AConfig: TRemoteConfig); -var - FSocketHandler: TSocketHandler; begin // Just copy reference to AConfig FConfig := AConfig; @@ -732,16 +733,17 @@ var begin cmd := 'Z'; case BreakWatchKind of - wpkWrite: cmd := cmd + '2,' + IntToHex(addr, 4) + ',' + IntToHex(watchsize, 4); - wpkRead: cmd := cmd + '3,' + IntToHex(addr, 4) + ',' + IntToHex(watchsize, 4); - wpkReadWrite: cmd := cmd + '4,' + IntToHex(addr, 4) + ',' + IntToHex(watchsize, 4); + wpkWrite: cmd := cmd + '2,'; + wpkRead: cmd := cmd + '3,'; + wpkReadWrite: cmd := cmd + '4,'; // NOTE: Not sure whether hardware break is better than software break, depends on gdbserver implementation... wkpExec: if HWbreak then - cmd := cmd + '1,' + IntToHex(addr, 4) + ',00' + cmd := cmd + '1,'; else - cmd := cmd + '0,' + IntToHex(addr, 4) + ',00'; + cmd := cmd + '0,'; end; + cmd := cmd + IntToHex(addr, 2) + ',' + IntToStr(watchsize); EnterCriticalSection(fCS); try @@ -1004,10 +1006,11 @@ begin reply := ''; EnterCriticalSection(fCS); try - if not SendCmdWaitForReply('vMustReplyEmpty', reply) or (reply <> '') or SockErr then + if not SendCmdWaitForReply('vMustReplyEmpty', reply) or + ((reply <> '') and (reply <> #0)) or SockErr then begin DebugLn(DBG_WARNINGS, ['Warning: vMustReplyEmpty command returned unexpected result: ', reply]); - exit; + Exit(SIGHUP); end; // Fancy stuff - load exe & sections, run monitor cmds etc @@ -1086,7 +1089,9 @@ begin begin // Already wrapped in critical section result := WaitForSignal(reply); - end; + end + else + result := SIGHUP; end; initialization diff --git a/components/fpdebug/fpdbgrspclasses.pas b/components/fpdebug/fpdbgrspclasses.pas index 5d1168bdd6..d379361670 100644 --- a/components/fpdebug/fpdbgrspclasses.pas +++ b/components/fpdebug/fpdbgrspclasses.pas @@ -226,7 +226,7 @@ begin exit; // Insert HW break... - result := TDbgRspProcess(Process).RspConnection.SetBreakWatchPoint(ALocation, wkpExec); + result := TDbgRspProcess(Process).RspConnection.SetBreakWatchPoint(ALocation, wkpExec, SizeOf(_BRK_STORE), true); if not result then DebugLn(DBG__WARNINGS, 'Failed to set break point.', []); end; @@ -354,7 +354,7 @@ begin SetLength(tmpData, watchData.Size); if Process.ReadData(addr, watchData.Size, tmpData[0]) then begin - if not TDbgRspProcess(Process).RspConnection.SetBreakWatchPoint(addr, watchData.Kind) then + if not TDbgRspProcess(Process).RspConnection.SetBreakWatchPoint(addr, watchData.Kind, watchData.Size) then DebugLn(DBG_WARNINGS, 'Failed to set watch point.', []); end else @@ -482,7 +482,7 @@ begin FConnection.Connect; try FStatus := FConnection.Init; - Result := true; + Result := FStatus <> SIGHUP; except on E: Exception do begin @@ -526,15 +526,23 @@ begin end; procedure TDbgRspProcess.TerminateProcess; +var + s: string; begin // Try to prevent access to the RSP socket after it has been closed if not (FIsTerminating or (TDbgRspProcess(Process).FStatus = SIGHUP)) then begin + // Qemu only accepts a kill command in the paused state + if not (TDbgRspProcess(Process).FStatus in [SIGINT, SIGTRAP]) then + begin + TDbgRspThread(Process.MainThread).RequestInternalPause; + TDbgRspProcess(Process).FStatus := FConnection.WaitForSignal(s); + end; DebugLn(DBG_VERBOSE, 'Removing all break points'); RemoveAllBreakPoints; DebugLn(DBG_VERBOSE, 'Sending kill command from TDbgRspProcess.TerminateProcess'); RspConnection.Kill(); - FIsTerminating:=true; + FIsTerminating := true; end; end; @@ -684,7 +692,8 @@ begin if FIsTerminating then begin DebugLn(DBG_VERBOSE, 'TDbgRspProcess.WaitForDebugEvent called while FIsTerminating is set.'); - FStatus := SIGKILL; + FStatus := SIGHUP; + Exit(True); end else // Wait for S or T response from target, or if connection to target is lost