lazarus/components/fpdebug/fpdbgrsp.pas

1101 lines
31 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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.