mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 00:58:04 +02:00
1101 lines
31 KiB
ObjectPascal
1101 lines
31 KiB
ObjectPascal
unit FpDbgRsp;
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, ssockets, DbgIntfDebuggerBase, DbgIntfBaseTypes,
|
||
FpDbgClasses;
|
||
|
||
const
|
||
// Possible signal numbers that can be expected over rsp
|
||
// for now only cater for posix like signals
|
||
SIGHUP = 1;
|
||
SIGINT = 2;
|
||
SIGQUIT = 3;
|
||
SIGILL = 4;
|
||
SIGTRAP = 5;
|
||
SIGABRT = 6;
|
||
SIGIOT = 6;
|
||
SIGBUS = 7;
|
||
SIGFPE = 8;
|
||
SIGKILL = 9;
|
||
SIGUSR1 = 10;
|
||
SIGSEGV = 11;
|
||
SIGUSR2 = 12;
|
||
SIGPIPE = 13;
|
||
SIGALRM = 14;
|
||
SIGTERM = 15;
|
||
SIGSTKFLT = 16;
|
||
SIGCHLD = 17;
|
||
SIGCONT = 18;
|
||
SIGSTOP = 19;
|
||
SIGTSTP = 20;
|
||
SIGTTIN = 21;
|
||
SIGTTOU = 22;
|
||
SIGURG = 23;
|
||
SIGXCPU = 24;
|
||
SIGXFSZ = 25;
|
||
SIGVTALRM = 26;
|
||
SIGPROF = 27;
|
||
SIGWINCH = 28;
|
||
SIGIO = 29;
|
||
SIGPOLL = SIGIO;
|
||
SIGPWR = 30;
|
||
SIGUNUSED = 31;
|
||
|
||
type
|
||
{ TRemoteConfig }
|
||
|
||
TRemoteConfig = class(TDbgProcessConfig)
|
||
private
|
||
FHost: string;
|
||
FPort: integer;
|
||
FUploadBinary: boolean;
|
||
FAfterConnectMonitorCmds: TStringList;
|
||
FSkipSectionsList: TStringList;
|
||
FAfterUploadBreakZero: boolean;
|
||
FAfterUploadMonitorCmds: TStringList;
|
||
public
|
||
constructor Create;
|
||
destructor Destroy; override;
|
||
procedure Assign(Source: TPersistent); override;
|
||
|
||
property Host: string read FHost write FHost;
|
||
property Port: integer read FPort write FPort;
|
||
property UploadBinary: boolean read FUploadBinary write FUploadBinary;
|
||
property AfterConnectMonitorCmds: TStringList read FAfterConnectMonitorCmds write FAfterConnectMonitorCmds;
|
||
property SkipSectionsList: TStringList read FSkipSectionsList write FSkipSectionsList;
|
||
property AfterUploadBreakZero: boolean read FAfterUploadBreakZero write FAfterUploadBreakZero;
|
||
property AfterUploadMonitorCmds: TStringList read FAfterUploadMonitorCmds write FAfterUploadMonitorCmds;
|
||
end;
|
||
|
||
TStopReason = (srNone, srSWBreakPoint, srHWBreakPoint, srWriteWatchPoint, srReadWatchPoint, srAnyWatchPoint);
|
||
|
||
TStatusEvent = record
|
||
signal: integer;
|
||
coreID: integer;
|
||
processID: integer;
|
||
threadID: integer;
|
||
stopReason: TStopReason;
|
||
watchPointAddress: qword; // contains address which triggered watch point
|
||
end;
|
||
|
||
{ TRspConnection }
|
||
|
||
TRspConnection = class(TInetSocket)
|
||
private
|
||
FState: integer;
|
||
FStatusEvent: TStatusEvent;
|
||
fCS: TRTLCriticalSection;
|
||
FFileName: string;
|
||
FOwner: TDbgProcess;
|
||
// Catch exceptions and store as socket errors
|
||
FSockErr: boolean;
|
||
FConfig: TRemoteConfig;
|
||
FSocketHandler: TSocketHandler;
|
||
|
||
function WaitForData(timeout_ms: integer): integer; overload;
|
||
// Wrappers to catch exceptions and set SockErr
|
||
function SafeReadByte: byte;
|
||
function SafeWrite(const buffer; count : Longint): Longint;
|
||
procedure SafeWriteByte(b: Byte);
|
||
|
||
function ReadReply(out retval: string): boolean;
|
||
function SendCommand(const cmd: string): boolean;
|
||
// Send command and wait for acknowledge
|
||
function SendCommandAck(const cmd: string): boolean;
|
||
// Return reply to cmd
|
||
function SendCmdWaitForReply(const cmd: string; out reply: string): boolean;
|
||
|
||
// Note that numbers are transmitted as hex characters in target endian sequence
|
||
// For little endian targets this creates an endian swap if the string is parsed by Val
|
||
// because a hex representation of a number is interpreted as big endian
|
||
function HexToIntLittleEndian(constref hextext: string; out value: qword): boolean;
|
||
function IntToHexLittleEndian(value: qword): string;
|
||
|
||
function HexEncodeStr(s: string): string;
|
||
function HexDecodeStr(hexcode: string): string;
|
||
public
|
||
constructor Create(AFileName: string; AOwner: TDbgProcess; AConfig: TRemoteConfig); Overload;
|
||
destructor Destroy; override;
|
||
// Wait for async signal - blocking
|
||
function WaitForSignal(out msg: string): integer;
|
||
procedure ResetStatusEvent;
|
||
|
||
procedure Break();
|
||
function Kill(): boolean;
|
||
function Detach(): boolean;
|
||
function MustReplyEmpty: boolean;
|
||
function SetBreakWatchPoint(addr: PtrUInt; BreakWatchKind: TDBGWatchPointKind; watchsize: integer = 1; HWbreak: boolean = true): boolean;
|
||
function DeleteBreakWatchPoint(addr: PtrUInt; BreakWatchKind: TDBGWatchPointKind; watchsize: integer = 1; HWBreak: boolean = true): boolean;
|
||
// TODO: no support for thread ID or different address
|
||
function Continue(): boolean;
|
||
function SingleStep(): boolean;
|
||
|
||
// Data exchange
|
||
function ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
|
||
function WriteDebugReg(ind: byte; AVal: TDbgPtr): boolean;
|
||
function ReadRegisters(out regs; const sz: integer): boolean; // size is not required by protocol, but is used to preallocate memory for the response
|
||
function WriteRegisters(constref regs; const sz: integer): boolean;
|
||
function ReadData(const AAddress: TDbgPtr; const ASize: cardinal; out AData
|
||
): boolean;
|
||
function WriteData(const AAdress: TDbgPtr;
|
||
const ASize: Cardinal; const AData): Boolean;
|
||
|
||
function SendMonitorCmd(const s: string): boolean;
|
||
// check state of target - ?
|
||
function Init: integer;
|
||
|
||
property State: integer read FState;
|
||
property lastStatusEvent: TStatusEvent read FStatusEvent;
|
||
property SockErr: boolean read FSockErr;
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, StrUtils,
|
||
FpImgReaderBase,
|
||
sockets,
|
||
{$IFNDEF WINDOWS}BaseUnix, termio;
|
||
{$ELSE}winsock2, windows;
|
||
{$ENDIF}
|
||
|
||
var
|
||
DBG_VERBOSE, DBG_WARNINGS, DBG_RSP: PLazLoggerLogGroup;
|
||
|
||
{ TRemoteConfig }
|
||
|
||
constructor TRemoteConfig.Create;
|
||
begin
|
||
FHost := 'localhost';
|
||
FPort := 1234; // default port for qemu
|
||
FUploadBinary := false;
|
||
FAfterConnectMonitorCmds := TStringList.Create;
|
||
FSkipSectionsList := TStringList.Create;
|
||
FAfterUploadBreakZero := false;
|
||
FAfterUploadMonitorCmds := TStringList.Create;
|
||
end;
|
||
|
||
destructor TRemoteConfig.Destroy;
|
||
begin
|
||
FreeAndNil(FAfterConnectMonitorCmds);
|
||
FreeAndNil(FSkipSectionsList);
|
||
FreeAndNil(FAfterUploadMonitorCmds);
|
||
end;
|
||
|
||
procedure TRemoteConfig.Assign(Source: TPersistent);
|
||
var
|
||
ASource: TRemoteConfig;
|
||
begin
|
||
if Assigned(Source) and (Source is TRemoteConfig) then
|
||
begin
|
||
ASource := TRemoteConfig(Source);
|
||
FHost := ASource.Host;
|
||
FPort := ASource.Port;
|
||
FUploadBinary := ASource.UploadBinary;
|
||
FAfterUploadBreakZero := ASource.AfterUploadBreakZero;
|
||
FAfterConnectMonitorCmds.Assign(ASource.AfterConnectMonitorCmds);
|
||
FSkipSectionsList.Assign(ASource.SkipSectionsList);
|
||
FAfterUploadMonitorCmds.Assign(ASource.AfterUploadMonitorCmds);
|
||
end;
|
||
end;
|
||
|
||
procedure TRspConnection.ResetStatusEvent;
|
||
begin
|
||
with FStatusEvent do
|
||
begin
|
||
signal := 0;
|
||
coreID := 0;
|
||
processID := 0;
|
||
threadID := 0;
|
||
stopReason := srNone;
|
||
watchPointAddress := 0;
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.WaitForData(timeout_ms: integer): integer;
|
||
{$if defined(unix) or defined(windows)}
|
||
var
|
||
FDS: TFDSet;
|
||
TimeV: TTimeVal;
|
||
{$endif}
|
||
begin
|
||
if SockErr then
|
||
begin
|
||
Result := -1;
|
||
exit;
|
||
end;
|
||
TimeV.tv_usec := timeout_ms * 1000; // 1 msec
|
||
TimeV.tv_sec := 0;
|
||
FDS := Default(TFDSet);
|
||
{$ifdef unix}
|
||
fpFD_Zero(FDS);
|
||
fpFD_Set(self.Handle, FDS);
|
||
Result := fpSelect(self.Handle + 1, @FDS, nil, nil, @TimeV);
|
||
{$else}
|
||
{$ifdef windows}
|
||
FD_Zero(FDS);
|
||
FD_Set(self.Handle, FDS);
|
||
Result := winsock2.Select(self.Handle + 1, @FDS, nil, nil, @TimeV);
|
||
{$endif}
|
||
{$endif}
|
||
end;
|
||
|
||
function TRspConnection.SafeReadByte: byte;
|
||
begin
|
||
try
|
||
Result := ReadByte;
|
||
except
|
||
FSockErr := true;
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.SafeWrite(const buffer; count: Longint): Longint;
|
||
begin
|
||
try
|
||
Result := Write(buffer, count);
|
||
except
|
||
FSockErr := true;
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
procedure TRspConnection.SafeWriteByte(b: Byte);
|
||
begin
|
||
try
|
||
WriteByte(b);
|
||
except
|
||
FSockErr := true;
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.SendCommand(const cmd: string): boolean;
|
||
var
|
||
checksum: byte;
|
||
i, totalSent: integer;
|
||
s: string;
|
||
begin
|
||
Result := false;
|
||
if SockErr then exit;
|
||
checksum := 0;
|
||
for i := 1 to length(cmd) do
|
||
checksum := byte(checksum + ord(cmd[i]));
|
||
|
||
s := '$'+cmd+'#'+IntToHex(checksum, 2);
|
||
totalSent := SafeWrite(s[1], length(s));
|
||
|
||
result := (totalSent = length(s));
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: TRspConnection.FSendRspCommand error.'])
|
||
else
|
||
DebugLn(DBG_RSP, ['RSP -> ', cmd]);
|
||
end;
|
||
|
||
function TRspConnection.SendCommandAck(const cmd: string): boolean;
|
||
var
|
||
c: char;
|
||
retryCount: integer;
|
||
begin
|
||
result := false;
|
||
if SockErr then exit;
|
||
retryCount := 0;
|
||
c := '-';
|
||
|
||
while not result and (retryCount < 5) and not SockErr do
|
||
begin
|
||
if c = '-' then
|
||
begin
|
||
if not SendCommand(cmd) then
|
||
inc(retryCount);
|
||
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);
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.ReadReply(out retval: string): boolean;
|
||
const failcountmax = 1000;
|
||
var
|
||
c: char;
|
||
i: integer;
|
||
cksum, calcSum: byte;
|
||
outputPacket: boolean;
|
||
begin
|
||
Result := false;
|
||
if SockErr then exit;
|
||
|
||
repeat // Outer loop runs until no more "O" packets received
|
||
i := 0;
|
||
retval := '';
|
||
repeat
|
||
c := chr(SafeReadByte);
|
||
inc(i);
|
||
retval := retval + c;
|
||
until (c = '$') or (i = failcountmax) or SockErr; // exit loop after start or count expired
|
||
|
||
if c <> '$' then
|
||
begin
|
||
DebugLn(DBG_WARNINGS, ['Warning: Timeout waiting for RSP reply']);
|
||
result := false;
|
||
retval := '';
|
||
exit;
|
||
end
|
||
else if i > 1 then
|
||
DebugLn(DBG_WARNINGS, ['Warning: Discarding unexpected data before start of new message', retval])
|
||
else if SockErr then
|
||
DebugLn(DBG_WARNINGS, ['Warning: socket error.']);
|
||
|
||
c := chr(SafeReadByte);
|
||
retval := '';
|
||
calcSum := 0;
|
||
while c <> '#' do
|
||
begin
|
||
calcSum := byte(calcSum+byte(c));
|
||
|
||
if c=#$7D then // escape marker, unescape data
|
||
begin
|
||
c := char(SafeReadByte);
|
||
|
||
// Something weird happened
|
||
if c = '#' then
|
||
begin
|
||
DebugLn(DBG_WARNINGS, ['Warning: Received end of packet marker in escaped sequence: ', c]);
|
||
break;
|
||
end;
|
||
|
||
calcSum := byte(calcSum + byte(c));
|
||
|
||
c := char(byte(c) xor $20);
|
||
end;
|
||
|
||
retval := retval + c;
|
||
c := char(SafeReadByte);
|
||
end;
|
||
|
||
cksum := StrToInt('$' + char(SafeReadByte) + char(SafeReadByte));
|
||
if not (calcSum = cksum) then
|
||
DebugLn(DBG_WARNINGS, ['Warning: Reply packet with invalid checksum: ', retval])
|
||
else
|
||
// Acknowledge all replies
|
||
SafeWriteByte(byte('+'));
|
||
|
||
if (length(retval) > 2) and (retval[1] = 'O') and (retval[2] <> 'K') then
|
||
begin
|
||
outputPacket := True;
|
||
// Output should be hex encoded, length should be odd
|
||
if Odd(length(retval)) then
|
||
begin
|
||
delete(retval, 1, 1);
|
||
DebugLn(DBG_RSP, ['RSP <- <Console output> ', HexDecodeStr(retval)]);
|
||
end
|
||
else
|
||
DebugLn(DBG_WARNINGS, ['RSP <- <Possible unencoded output>: ', retval]);
|
||
end
|
||
else
|
||
begin
|
||
outputPacket := False;
|
||
end;
|
||
until not outputPacket;
|
||
|
||
result := not SockErr;
|
||
// Ignore empty output packet unless both RSP and VERBOSE logging is enabled
|
||
// OpenOCD sends empty output packets while target is running
|
||
if (retval = 'O') then
|
||
DebugLn(DBG_RSP and DBG_VERBOSE, ['RSP <- ', retval])
|
||
else
|
||
DebugLn(DBG_RSP, ['RSP <- ', retval])
|
||
end;
|
||
|
||
function TRspConnection.SendCmdWaitForReply(const cmd: string; out reply: string
|
||
): boolean;
|
||
var
|
||
retryCount: integer;
|
||
begin
|
||
reply := '';
|
||
if SockErr then exit;
|
||
retryCount := 0;
|
||
|
||
if SendCommandAck(cmd) then
|
||
begin
|
||
// Read reply, with retry if no success
|
||
repeat
|
||
result := ReadReply(reply);
|
||
if not result then
|
||
begin
|
||
inc(retryCount);
|
||
SafeWriteByte(ord('-'));
|
||
end;
|
||
until result or (retryCount > 5) or SockErr;
|
||
end;
|
||
|
||
if retryCount > 5 then
|
||
DebugLn(DBG_WARNINGS, ['Warning: Retries exceeded in TRspConnection.FSendCmdWaitForReply for cmd: ', cmd]);
|
||
end;
|
||
|
||
function TRspConnection.HexToIntLittleEndian(constref
|
||
hextext: string; out value: qword): boolean;
|
||
var
|
||
err: integer;
|
||
begin
|
||
Val('$'+hextext, value, err);
|
||
if (err = 0) then
|
||
begin
|
||
result := true;
|
||
case length(hextext) of
|
||
1,2: ; // no conversion required
|
||
3,4: value := SwapEndian(word(value));
|
||
5..8: value := SwapEndian(dword(value));
|
||
9..16: value := SwapEndian(value);
|
||
else
|
||
begin
|
||
result := false;
|
||
DebugLn(DBG_WARNINGS, ['Warning: Unexpected hex length: ', IntToStr(length(hextext))]);
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
result := false;
|
||
end;
|
||
|
||
function TRspConnection.IntToHexLittleEndian(value: qword): string;
|
||
var
|
||
b, accumulator: byte;
|
||
begin
|
||
Result := '';
|
||
accumulator := 0;
|
||
while value > 0 do
|
||
begin
|
||
inc(accumulator, 2);
|
||
b := byte(value);
|
||
value := value shr 8;
|
||
Result := Result + IntToHex(b, 2);
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.HexEncodeStr(s: string): string;
|
||
var
|
||
i: integer;
|
||
tmp: string;
|
||
begin
|
||
setlength(Result, length(s)*2);
|
||
for i := 1 to length(s) do
|
||
begin
|
||
tmp := HexStr(ord(s[i]), 2);
|
||
Result[2*i - 1] := tmp[1];
|
||
Result[2*i] := tmp[2];
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.HexDecodeStr(hexcode: string): string;
|
||
var
|
||
i: integer;
|
||
s: string;
|
||
begin
|
||
SetLength(Result, length(hexCode) div 2);
|
||
for i := 1 to length(Result) do
|
||
begin
|
||
s := '$' + hexCode[2*i-1] + hexCode[2*i];
|
||
result[i] := char(StrToInt(s));
|
||
end;
|
||
end;
|
||
|
||
procedure TRspConnection.Break();
|
||
begin
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
SafeWriteByte(3); // Ctrl-C
|
||
DebugLn(DBG_RSP, ['RSP -> <Ctrl+C>']);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.Kill(): boolean;
|
||
begin
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
SendCommandAck('k');
|
||
result := true;
|
||
sockets.CloseSocket(FSocketHandler.Socket.Handle);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.Detach(): boolean;
|
||
var
|
||
reply: string;
|
||
begin
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply('D', reply);
|
||
result := true;
|
||
sockets.CloseSocket(FSocketHandler.Socket.Handle);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
end;
|
||
|
||
constructor TRspConnection.Create(AFileName: string; AOwner: TDbgProcess;
|
||
AConfig: TRemoteConfig);
|
||
begin
|
||
// Just copy reference to AConfig
|
||
FConfig := AConfig;
|
||
{ Create a socket handler, so that TInetSocket.Create call doesn't automatically connect.
|
||
This can raise an exception when connection fails.
|
||
The FSocketHandler instance will be managed by TInetSocket. }
|
||
FSocketHandler := TSocketHandler.Create;
|
||
inherited Create(FConfig.Host, FConfig.Port, FSocketHandler);
|
||
InitCriticalSection(fCS);
|
||
FFileName := AFileName;
|
||
FOwner := AOwner;
|
||
FSockErr := false;
|
||
end;
|
||
|
||
destructor TRspConnection.Destroy;
|
||
begin
|
||
inherited;
|
||
DoneCriticalSection(fCS);
|
||
end;
|
||
|
||
function TRspConnection.WaitForSignal(out msg: string): integer;
|
||
var
|
||
res: boolean;
|
||
startIndex, colonIndex, semicolonIndex, i: integer;
|
||
tmp: qword;
|
||
part1, part2, s: string;
|
||
begin
|
||
result := 0;
|
||
res := false;
|
||
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
// -1 if no data could be read, e.g. socket is closed
|
||
// 0 if timeout. Use timeout so that asynchronous events such as break can also be processed
|
||
i := WaitForData(500);
|
||
if i <= 0 then
|
||
begin
|
||
msg := '';
|
||
if i < 0 then
|
||
result := SIGHUP;
|
||
exit;
|
||
end;
|
||
|
||
try
|
||
res := ReadReply(msg);
|
||
except
|
||
on E: Exception do
|
||
DebugLn(DBG_WARNINGS, ['Warning: WaitForSignal exception: ', E.Message]);
|
||
end;
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
|
||
if res then
|
||
begin
|
||
if (length(msg) > 2) and (msg[1] in ['S', 'T']) then
|
||
begin
|
||
try
|
||
ResetStatusEvent;
|
||
result := StrToInt('$' + copy(msg, 2, 2));
|
||
FState := result;
|
||
FStatusEvent.signal := result;
|
||
if (msg[1] = 'T') and (length(msg) > 6) then // not much meaning can be returned in less than 2 bytes
|
||
begin
|
||
startIndex := 4; // first part of message TAA... is already parsed, rest should be nn:rr; pairs
|
||
repeat
|
||
colonIndex := posex(':', msg, startIndex);
|
||
semicolonIndex := posex(';', msg, startIndex);
|
||
// Check if there is a first part
|
||
if colonIndex > startIndex then
|
||
part1 := copy(msg, startIndex, colonIndex-startIndex)
|
||
else
|
||
part1 := '';
|
||
|
||
if (part1 <> '') and (semicolonIndex > colonIndex + 1) then
|
||
part2 := copy(msg, colonIndex+1, semicolonIndex - colonIndex - 1)
|
||
else
|
||
part2 := '';
|
||
|
||
// Check for stop reason
|
||
case part1 of
|
||
'watch','rwatch','awatch':
|
||
begin
|
||
case part1 of
|
||
'watch': FStatusEvent.stopReason := srWriteWatchPoint;
|
||
'rwatch': FStatusEvent.stopReason := srReadWatchPoint;
|
||
'awatch': FStatusEvent.stopReason := srAnyWatchPoint;
|
||
end;
|
||
Val('$'+part2, tmp, i);
|
||
if i = 0 then
|
||
FStatusEvent.watchPointAddress := tmp
|
||
else
|
||
DebugLn(DBG_WARNINGS, format('Invalid value received for %s: %s ', [part1, part2]));
|
||
end;
|
||
'swbreak':
|
||
begin
|
||
FStatusEvent.stopReason := srSWBreakPoint;
|
||
end;
|
||
'hwbreak':
|
||
begin
|
||
FStatusEvent.stopReason := srHWBreakPoint;
|
||
end;
|
||
'thread':
|
||
begin
|
||
if length(part2) > 0 then
|
||
begin
|
||
// ... optionally include both process and thread ID fields, as ‘ppid.tid’.
|
||
if (part2[1] = 'p') then
|
||
begin
|
||
i := pos('.', part2);
|
||
if i > 2 then
|
||
begin
|
||
s := copy(part2, 2, i-1);
|
||
if HexToIntLittleEndian(s, tmp) then
|
||
FStatusEvent.processID := tmp
|
||
else
|
||
begin
|
||
FStatusEvent.processID := 0;
|
||
DebugLn(DBG_WARNINGS, format('Invalid process ID prefix: [%s]', [s]));
|
||
end;
|
||
|
||
s := copy(part2, i+1, 255);
|
||
if HexToIntLittleEndian(s, tmp) then
|
||
FStatusEvent.threadID := tmp
|
||
else
|
||
begin
|
||
FStatusEvent.threadID := 0;
|
||
DebugLn(DBG_WARNINGS, format('Invalid thread ID postfix: [%s]', [s]));
|
||
end;
|
||
end
|
||
else
|
||
DebugLn(DBG_WARNINGS, format('Not enough text for a process ID: [%s]', [part2]));
|
||
end
|
||
else
|
||
// Expect only thread ID
|
||
begin
|
||
if HexToIntLittleEndian(part2, tmp) then
|
||
FStatusEvent.threadID := tmp
|
||
else
|
||
begin
|
||
FStatusEvent.threadID := 0;
|
||
DebugLn(DBG_WARNINGS, format('Invalid thread ID postfix: [%s]', [part2]));
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
DebugLn(DBG_WARNINGS, 'Stop reason "thread" with no thread data');
|
||
end;
|
||
end;
|
||
startIndex := semicolonIndex + 1;
|
||
until (semicolonIndex = 0) or (semicolonIndex = length(msg));
|
||
end;
|
||
except
|
||
DebugLn(DBG_WARNINGS, ['Error converting signal number from reply: ', msg]);
|
||
end;
|
||
end
|
||
else
|
||
if msg <> 'O' then // Ignore empty output messages from OpenOCD
|
||
DebugLn(DBG_WARNINGS, ['Unexpected WaitForSignal reply: ', msg]);
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.MustReplyEmpty: boolean;
|
||
var
|
||
reply: string;
|
||
begin
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
SendCmdWaitForReply('vMustReplyEmpty', reply);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
result := not(SockErr) and (reply = '');
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: vMustReplyEmpty command returned unexpected result: ', reply]);
|
||
end;
|
||
|
||
function TRspConnection.SetBreakWatchPoint(addr: PtrUInt;
|
||
BreakWatchKind: TDBGWatchPointKind; watchsize: integer; HWbreak: boolean
|
||
): boolean;
|
||
var
|
||
cmd, reply: string;
|
||
begin
|
||
cmd := 'Z';
|
||
case BreakWatchKind of
|
||
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,';
|
||
else
|
||
cmd := cmd + '0,';
|
||
end;
|
||
cmd := cmd + IntToHex(addr, 2) + ',' + IntToStr(watchsize);
|
||
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmd, reply) and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if result then
|
||
result := pos('OK', reply) > 0;
|
||
end;
|
||
|
||
function TRspConnection.DeleteBreakWatchPoint(addr: PtrUInt;
|
||
BreakWatchKind: TDBGWatchPointKind; watchsize: integer; HWBreak: boolean
|
||
): boolean;
|
||
var
|
||
cmd, reply: string;
|
||
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);
|
||
// 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'
|
||
else
|
||
cmd := cmd + '0,' + IntToHex(addr, 4) + ',00';
|
||
end;
|
||
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmd, reply) and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if result then
|
||
result := pos('OK', reply) > 0;
|
||
end;
|
||
|
||
function TRspConnection.Continue(): boolean;
|
||
begin
|
||
DebugLn(DBG_VERBOSE, ['TRspConnection.Continue() called']);
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCommandAck('c') and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: Continue command failure in TRspConnection.Continue()']);
|
||
end;
|
||
|
||
function TRspConnection.SingleStep(): boolean;
|
||
begin
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCommandAck('s') and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: SingleStep command failure in TRspConnection.SingleStep()']);
|
||
end;
|
||
|
||
function TRspConnection.ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
|
||
var
|
||
cmd, reply: string;
|
||
tmp: qword;
|
||
begin
|
||
cmd := 'p'+IntToHex(ind, 2);
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmd, reply) and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if result then
|
||
begin
|
||
result := HexToIntLittleEndian(reply, tmp);
|
||
AVal := PtrUInt(tmp);
|
||
end;
|
||
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: "p" command returned unexpected result: ', reply]);
|
||
end;
|
||
|
||
function TRspConnection.WriteDebugReg(ind: byte; AVal: TDbgPtr): boolean;
|
||
var
|
||
cmd, reply: string;
|
||
begin
|
||
cmd := 'P'+IntToHex(ind, 2)+'='+IntToHexLittleEndian(AVal);
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmd, reply) and (reply = 'OK');
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: "P" command returned unexpected result: ', reply]);
|
||
end;
|
||
|
||
function TRspConnection.ReadRegisters(out regs; const sz: integer): boolean;
|
||
var
|
||
reply: string;
|
||
b: array of byte;
|
||
i: integer;
|
||
begin
|
||
reply := '';
|
||
setlength(b, sz);
|
||
// Normal receive error, or an error response of the form Exx
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply('g', reply) and ((length(reply) > 4) and (reply[1] <> 'E'))
|
||
and (length(reply) >= 2*sz);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
Result := Result and not(SockErr);
|
||
if Result then
|
||
begin
|
||
for i := 0 to sz-1 do
|
||
b[i] := StrToInt('$'+reply[2*i+1]+reply[2*i+2]);
|
||
result := true;
|
||
end
|
||
else
|
||
begin
|
||
DebugLn(DBG_WARNINGS, ['Warning: "g" command returned unexpected result: ', reply]);
|
||
FillByte(b[0], sz, 0);
|
||
end;
|
||
Move(b[0], regs, sz);
|
||
end;
|
||
|
||
function TRspConnection.WriteRegisters(constref regs; const sz: integer
|
||
): boolean;
|
||
var
|
||
cmd, reply, s: string;
|
||
i, offset: integer;
|
||
pb: PByte;
|
||
begin
|
||
pb := @regs;
|
||
result := false;
|
||
reply := '';
|
||
cmd := format('G', []);
|
||
offset := length(cmd);
|
||
setlength(cmd, offset+sz*2);
|
||
for i := 0 to sz-1 do
|
||
begin
|
||
s := IntToHex(pb^, 2);
|
||
cmd[offset + 2*i + 1] := s[1];
|
||
cmd[offset + 2*i + 2] := s[2];
|
||
end;
|
||
|
||
// Normal receive error, or an error number of the form Exx
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmd, reply) and (reply = 'OK') and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: "G" command returned unexpected result: ', reply]);
|
||
end;
|
||
|
||
function TRspConnection.ReadData(const AAddress: TDbgPtr;
|
||
const ASize: cardinal; out AData): boolean;
|
||
var
|
||
buf: pbyte;
|
||
cmd, reply: string;
|
||
i: integer;
|
||
begin
|
||
result := false;
|
||
getmem(buf, ASize);
|
||
cmd := 'm'+IntToHex(AAddress, 2)+',' + IntToHex(ASize, 2);
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmd, reply) and (length(reply) = ASize*2) and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if result then
|
||
begin
|
||
for i := 0 to ASize-1 do
|
||
buf[i] := StrToInt('$'+reply[2*i + 1]+reply[2*i + 2])
|
||
end
|
||
else
|
||
begin
|
||
DebugLn(DBG_WARNINGS, ['Warning: "m" command returned unexpected result: ', reply]);
|
||
FillByte(buf[0], ASize, 0);
|
||
end;
|
||
|
||
System.Move(buf^, AData, ASize);
|
||
Freemem(buf);
|
||
end;
|
||
|
||
function TRspConnection.WriteData(const AAdress: TDbgPtr;
|
||
const ASize: Cardinal; const AData): Boolean;
|
||
var
|
||
cmd, reply, s: string;
|
||
i, offset: integer;
|
||
pb: PByte;
|
||
begin
|
||
result := false;
|
||
cmd := format('M%X,%X:', [AAdress, ASize]);
|
||
offset := length(cmd);
|
||
setlength(cmd, offset + 2*ASize);
|
||
pb := @AData;
|
||
for i := 0 to ASize-1 do
|
||
begin
|
||
s := IntToHex(pb^, 2);
|
||
cmd[offset + 2*i+1] := s[1];
|
||
cmd[offset + 2*i+2] := s[2];
|
||
inc(pb);
|
||
end;
|
||
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmd, reply) and (reply = 'OK') and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
if not result then
|
||
DebugLn(DBG_WARNINGS, ['Warning: "M" command returned unexpected result: ', reply]);
|
||
end;
|
||
|
||
function TRspConnection.SendMonitorCmd(const s: string): boolean;
|
||
var
|
||
cmdstr, reply: string;
|
||
begin
|
||
cmdstr := 'qRcmd,' + HexEncodeStr(s);
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
result := SendCmdWaitForReply(cmdstr, reply) and not(SockErr);
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
|
||
if reply = '' then
|
||
DebugLn(DBG_RSP, ['[Monitor '+s+'] : "qRcmd" not recognized by gdbserver.'])
|
||
else
|
||
begin
|
||
// Check if reply is not hex encoded, else decode reply
|
||
if Result and not((reply = 'OK') or ((length(reply) = 3) and (reply[1] = 'E'))) then
|
||
reply := HexDecodeStr(reply);
|
||
|
||
DebugLn(DBG_RSP, ['[Monitor '+s+'] reply: ', reply]);
|
||
end;
|
||
end;
|
||
|
||
function TRspConnection.Init: integer;
|
||
var
|
||
reply: string;
|
||
res: boolean;
|
||
pSection: PDbgImageSection;
|
||
dataStart: int64;
|
||
reloadData: boolean = false;
|
||
i: integer;
|
||
begin
|
||
result := 0;
|
||
reply := '';
|
||
EnterCriticalSection(fCS);
|
||
try
|
||
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(SIGHUP);
|
||
end;
|
||
|
||
// Fancy stuff - load exe & sections, run monitor cmds etc
|
||
if assigned(FConfig.AfterConnectMonitorCmds) and (FConfig.AfterConnectMonitorCmds.Count > 0) then
|
||
begin
|
||
for i := 0 to FConfig.AfterConnectMonitorCmds.Count-1 do
|
||
SendMonitorCmd(FConfig.AfterConnectMonitorCmds[i]);
|
||
end;
|
||
|
||
// Start with AVR logic
|
||
// If more targets are supported, move this to target specific debugger class
|
||
if FConfig.UploadBinary and (FFileName <> '') then
|
||
begin
|
||
// Ensure loader is initialized
|
||
if not Assigned(FOwner.DbgInfo) then
|
||
FOwner.LoadInfo;
|
||
datastart := -1;
|
||
i := -1;
|
||
repeat
|
||
inc(i);
|
||
pSection := FOwner.LoaderList[0].SectionByID[i];
|
||
if (pSection <> nil) and (pSection^.Size > 0) and (pSection^.IsLoadable) then
|
||
begin
|
||
if Assigned(FConfig.SkipSectionsList) and
|
||
(FConfig.SkipSectionsList.IndexOf(pSection^.Name) < 0) then
|
||
begin
|
||
// .data section should be programmed straight after .text for AVR
|
||
// Require tracking because sections are sorted alphabetically,
|
||
// so .data is encountered before .text
|
||
if (pSection^.Name = '.data') then
|
||
begin
|
||
// Data can only be loaded after text, since the end address of text+1 is the start of data in flash
|
||
if (dataStart < 0) then
|
||
begin
|
||
reloadData := true;
|
||
system.Continue;
|
||
end
|
||
else
|
||
WriteData(dataStart, pSection^.Size, pSection^.RawData^);
|
||
end
|
||
else
|
||
begin
|
||
WriteData(pSection^.VirtualAddress, pSection^.Size, pSection^.RawData^);
|
||
if pSection^.Name = '.text' then
|
||
dataStart := pSection^.Size;
|
||
end;
|
||
end;
|
||
end;
|
||
until (pSection = nil);
|
||
|
||
// reloadData will only be set if it is not in the skipped sections list
|
||
if reloadData and (dataStart >= 0) then
|
||
begin
|
||
pSection := FOwner.LoaderList[0].Section['.data'];
|
||
WriteData(dataStart, pSection^.Size, pSection^.RawData^);
|
||
end;
|
||
end;
|
||
|
||
// Hack to finish initializing atbackend agent
|
||
if FConfig.AfterUploadBreakZero then
|
||
SetBreakWatchPoint(0, wkpExec); // Todo: check if different address is required
|
||
|
||
if assigned(FConfig.AfterUploadMonitorCmds) and (FConfig.AfterUploadMonitorCmds.Count > 0) then
|
||
begin
|
||
for i := 0 to FConfig.AfterUploadMonitorCmds.Count-1 do
|
||
SendMonitorCmd(FConfig.AfterUploadMonitorCmds[i]);
|
||
end;
|
||
|
||
// Must be last init command, after init the debug loop waits for the response in WaitForSignal
|
||
res := SendCommandAck('?');
|
||
finally
|
||
LeaveCriticalSection(fCS);
|
||
end;
|
||
|
||
if res then
|
||
begin
|
||
// Already wrapped in critical section
|
||
result := WaitForSignal(reply);
|
||
end
|
||
else
|
||
result := SIGHUP;
|
||
end;
|
||
|
||
initialization
|
||
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
|
||
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
|
||
DBG_RSP := DebugLogger.FindOrRegisterLogGroup('DBG_RSP' {$IFDEF DBG_RSP} , True {$ENDIF} );
|
||
|
||
end.
|
||
|