mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 02:58:05 +02:00
[fpdebug] Track initialization of the remote connection. Fix some issues with qemu and Bloom debug servers.
This commit is contained in:
ccrause
parent
d9728c785f
commit
28c86c583b
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user