lazarus/components/fpdebug/fpdbgavrclasses.pas
mattias 65e16d03fb fpdebug: less hints
git-svn-id: trunk@64686 -
2021-02-28 08:52:37 +00:00

959 lines
29 KiB
ObjectPascal

unit FpDbgAvrClasses;
// Connects to gdbserver instance and communicate over gdb's remote serial protocol (RSP)
// in principle possible to connect over any serial text capabile interface such as
// tcp/ip, RS-232, pipes etc.
// Support only tcp/ip connection for now.
{$mode objfpc}{$H+}
{$packrecords c}
{$modeswitch advancedrecords}
interface
uses
Classes,
SysUtils,
FpDbgClasses,
FpDbgLoader,
DbgIntfBaseTypes, DbgIntfDebuggerBase,
LazLoggerBase, Maps,
FpDbgRsp, FpDbgCommon, FpdMemoryTools,
FpErrorMessages;
const
// RSP commands
Rsp_Status = '?'; // Request break reason - returns either S or T
lastCPURegIndex = 31; // After this are SREG, SP and PC
SREGindex = 32;
SPindex = 33;
PCindex = 34;
RegArrayLength = 35;
// Byte level register indexes
SPLindex = 33;
SPHindex = 34;
PC0 = 35;
PC1 = 36;
PC2 = 37;
PC3 = 38;
RegArrayByteLength = 39;
type
{ TDbgAvrThread }
TDbgAvrThread = class(TDbgThread)
private
FRegs: TInitializedRegisters;
FRegsUpdated: boolean; // regs read from target
//FRegsChanged: boolean; // write regs to target
FExceptionSignal: integer;
FIsPaused, FInternalPauseRequested, FIsInInternalPause: boolean;
FIsSteppingBreakPoint: boolean;
FDidResetInstructionPointer: Boolean;
FHasThreadState: boolean;
function ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
function WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
// Cache registers if reported in event
// Only cache if all reqisters are reported
// if not, request registers from target
procedure FUpdateStatusFromEvent(event: TStatusEvent);
procedure InvalidateRegisters;
protected
function ReadThreadState: boolean;
function RequestInternalPause: Boolean;
function CheckSignalForPostponing(AWaitedStatus: integer): Boolean;
procedure ResetPauseStates;
public
constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); override;
function ResetInstructionPointerAfterBreakpoint: boolean; override;
procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); override;
function DetectHardwareWatchpoint: Pointer; override;
procedure BeforeContinue; override;
procedure LoadRegisterValues; override;
function GetInstructionPointerRegisterValue: TDbgPtr; override;
function GetStackBasePointerRegisterValue: TDbgPtr; override;
function GetStackPointerRegisterValue: TDbgPtr; override;
end;
{ TDbgAvrProcess }
TDbgAvrProcess = class(TDbgProcess)
private
FStatus: integer;
FProcessStarted: boolean;
FIsTerminating: boolean;
// RSP communication
FConnection: TRspConnection;
procedure OnForkEvent(Sender : TObject);
protected
procedure InitializeLoaders; override;
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateWatchPointData: TFpWatchPointData; override;
public
// TODO: Optional download to target as parameter DownloadExecutable=true
//class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
// AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
// Not supported, returns false
//class function AttachToInstance(AFileName: string; APid: Integer
// ): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function isSupported(target: TTargetDescriptor): boolean; override;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override;
destructor Destroy; override;
// FOR AVR target AAddress could be program or data (SRAM) memory (or EEPROM)
// Gnu tools masks data memory with $800000
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override;
procedure TerminateProcess; override;
function Pause: boolean; override;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
// Wait for -S or -T response from target, or if connection to target is lost
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
// Insert/Delete break points on target
// TODO: if target doesn't support break points or have limited break points
// then debugger needs to manage insertion/deletion of break points in target memory
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; override;
function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; override;
end;
// Lets stick with points 4 for now
{ TFpRspWatchPointData }
TRspBreakWatchPoint = record
Owner: Pointer;
Address: TDBGPtr;
Kind: TDBGWatchPointKind;
end;
TFpRspWatchPointData = class(TFpWatchPointData)
private
FData: array of TRspBreakWatchPoint;
function FBreakWatchPoint(AnIndex: Integer): TRspBreakWatchPoint;
function FCount: integer;
public
function AddOwnedWatchpoint(AnOwner: Pointer; AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean; override;
function RemoveOwnedWatchpoint(AnOwner: Pointer): boolean; override;
property Data[AnIndex: Integer]: TRspBreakWatchPoint read FBreakWatchPoint;
property Count: integer read FCount;
end;
var
// Difficult to see how this can be encapsulated except if
// added methods are introduced that needs to be called after .Create
HostName: string = 'localhost';
Port: integer = 12345;
implementation
uses
FpDbgDisasAvr;
var
DBG_VERBOSE, DBG_WARNINGS: PLazLoggerLogGroup;
{ TFpRspWatchPointData }
function TFpRspWatchPointData.FBreakWatchPoint(AnIndex: Integer
): TRspBreakWatchPoint;
begin
if AnIndex < length(FData) then
result := FData[AnIndex];
end;
function TFpRspWatchPointData.FCount: integer;
begin
result := length(FData);
end;
function TFpRspWatchPointData.AddOwnedWatchpoint(AnOwner: Pointer;
AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean;
var
idx: integer;
begin
Result := false;
idx := length(FData);
SetLength(FData, idx+1);
FData[idx].Address := AnAddr;
FData[idx].Kind := AReadWrite;
FData[idx].Owner := AnOwner;
Changed := true;
Result := true;
end;
function TFpRspWatchPointData.RemoveOwnedWatchpoint(AnOwner: Pointer): boolean;
var
i, j: integer;
begin
Result := False;
i := 0;
while (i < length(FData)) and (FData[i].Owner <> AnOwner) do
inc(i);
if i < length(FData) then begin
for j := i+1 to length(FData)-1 do begin
FData[j-1] := FData[j];
Changed := True;
Result := True;
end;
SetLength(FData, length(FData)-1);
Changed := True;
Result := True;
end;
end;
{ TDbgAvrThread }
procedure TDbgAvrProcess.OnForkEvent(Sender: TObject);
begin
end;
function TDbgAvrThread.ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
begin
if TDbgAvrProcess(Process).FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspThread.GetDebugReg called while FIsTerminating is set.');
Result := false;
end
else
begin
DebugLn(DBG_VERBOSE, ['TDbgRspThread.GetDebugReg requesting register: ',ind]);
if FRegs[ind].Initialized then
begin
AVal := FRegs[ind].Value;
result := true;
end
else
begin
result := TDbgAvrProcess(Process).FConnection.ReadDebugReg(ind, AVal);
FRegs[ind].Value := AVal;
FRegs[ind].Initialized := true;
end;
end;
end;
function TDbgAvrThread.WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
begin
if TDbgAvrProcess(Process).FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspThread.WriteDebugReg called while FIsTerminating is set.');
Result := false;
end
else
result := TDbgAvrProcess(Process).FConnection.WriteDebugReg(ind, AVal);
end;
procedure TDbgAvrThread.FUpdateStatusFromEvent(event: TStatusEvent);
var
i: integer;
begin
for i := 0 to high(FRegs) do
begin
FRegs[i].Initialized := event.registers[i].Initialized;
if event.registers[i].Initialized then
FRegs[i].Value := event.registers[i].Value;
end;
end;
procedure TDbgAvrThread.InvalidateRegisters;
var
i: integer;
begin
for i := 0 to high(FRegs) do
FRegs[i].Initialized := false;
end;
function TDbgAvrThread.ReadThreadState: boolean;
begin
assert(FIsPaused, 'TDbgRspThread.ReadThreadState: FIsPaused');
result := true;
if FHasThreadState then
exit;
FRegisterValueListValid := false;
end;
function TDbgAvrThread.RequestInternalPause: Boolean;
begin
if TDbgAvrProcess(Process).FIsTerminating then
DebugLn(DBG_WARNINGS, 'TDbgRspThread.RequestInternalPause called while FIsTerminating is set.');
Result := False;
if FInternalPauseRequested or FIsPaused or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
exit;
DebugLn(DBG_VERBOSE, 'TDbgRspThread.RequestInternalPause requesting Ctrl-C.');
FInternalPauseRequested := true;
// Send SIGSTOP/break
TDbgAvrProcess(Process).FConnection.Break();
end;
function TDbgAvrThread.CheckSignalForPostponing(AWaitedStatus: integer): Boolean;
begin
Assert(not FIsPaused, 'Got WaitStatus while already paused');
assert(FExceptionSignal = 0, 'TDbgLinuxThread.CheckSignalForPostponing: FExceptionSignal = 0');
Result := FIsPaused;
DebugLn(DBG_VERBOSE and (Result), ['Warning: Thread already paused', ID]);
DebugLn(DBG_VERBOSE, ['TDbgRspThread.CheckSignalForPostponing called with ', AWaitedStatus]);
if Result then
exit;
FIsPaused := True;
FIsInInternalPause := False;
end;
procedure TDbgAvrThread.ResetPauseStates;
begin
FIsInInternalPause := False;
FIsPaused := False;
FExceptionSignal := 0;
FHasThreadState := False;
FDidResetInstructionPointer := False;
end;
constructor TDbgAvrThread.Create(const AProcess: TDbgProcess;
const AID: Integer; const AHandle: THandle);
begin
inherited;
SetLength(FRegs, RegArrayLength);
end;
function TDbgAvrThread.ResetInstructionPointerAfterBreakpoint: boolean;
begin
if not ReadThreadState then
exit(False);
result := true;
if FDidResetInstructionPointer then
exit;
FDidResetInstructionPointer := True;
// This is not required for gdbserver
// since remote stub should ensure PC points to break address
//Dec(FRegs.cpuRegs[PCindex]);
//FRegsChanged:=true;
end;
procedure TDbgAvrThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
var
i: integer;
r: boolean;
addr: PtrUInt;
begin
// Skip this for now...
exit;
// TODO: Derive a custom class from TFpWatchPointData to manage
// break/watchpoints and communicate over rsp
r := True;
for i := 0 to TFpRspWatchPointData(AWatchPointData).Count-1 do begin // TODO: make size dynamic
addr := PtrUInt(TFpRspWatchPointData(AWatchPointData).Data[i].Address);
r := r and WriteDebugReg(i, addr);
end;
end;
function TDbgAvrThread.DetectHardwareWatchpoint: Pointer;
begin
result := nil;
end;
procedure TDbgAvrThread.BeforeContinue;
//var
// regs: TBytes;
begin
if not FIsPaused then
exit;
inherited;
InvalidateRegisters;
// TODO: currently nothing changes registers locally?
// Update registers if changed locally
//if FRegsChanged then
//begin
// SetLength(regs, RegArrayByteLength);
// for i := 0 to lastCPURegIndex do
// regs[i] :=
// FRegsChanged:=false;
//end;
end;
procedure TDbgAvrThread.LoadRegisterValues;
var
i: integer;
regs: TBytes;
begin
if TDbgAvrProcess(Process).FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspThread.LoadRegisterValues called while FIsTerminating is set.');
exit;
end;
if not ReadThreadState then
exit;
if not FRegsUpdated then
begin
SetLength(regs, RegArrayByteLength);
FRegsUpdated := TDbgAvrProcess(Process).FConnection.ReadRegisters(regs[0], length(regs));
// repack according to target endianness
FRegs[SPindex].Value := regs[SPLindex] + (regs[SPHindex] shl 8);
FRegs[SPHindex].Initialized := true;
FRegs[PCindex].Value := regs[PC0] + (regs[PC1] shl 8) + (regs[PC2] shl 16) + (regs[PC3] shl 24);
FRegs[PCindex].Initialized := true;
end;
if FRegsUpdated then
begin
for i := 0 to lastCPURegIndex do
FRegisterValueList.DbgRegisterAutoCreate['r'+IntToStr(i)].SetValue(FRegs[i].Value, IntToStr(FRegs[i].Value),1, i); // confirm dwarf index
FRegisterValueList.DbgRegisterAutoCreate['sreg'].SetValue(FRegs[SREGindex].Value, IntToStr(FRegs[SREGindex].Value),1,0);
FRegisterValueList.DbgRegisterAutoCreate['sp'].SetValue(FRegs[SPindex].Value, IntToStr(FRegs[SPindex].Value),2,0);
FRegisterValueList.DbgRegisterAutoCreate['pc'].SetValue(FRegs[PCindex].Value, IntToStr(FRegs[PCindex].Value),4,0);
FRegisterValueListValid := true;
end
else
DebugLn(DBG_WARNINGS, 'Warning: Could not update registers');
end;
function TDbgAvrThread.GetInstructionPointerRegisterValue: TDbgPtr;
begin
Result := 0;
if TDbgAvrProcess(Process).FIsTerminating then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspThread.GetInstructionPointerRegisterValue called while FIsTerminating is set.');
exit;
end;
if not ReadThreadState then
exit;
DebugLn(DBG_VERBOSE, 'TDbgRspThread.GetInstructionPointerRegisterValue requesting PC.');
ReadDebugReg(PCindex, result);
end;
function TDbgAvrThread.GetStackBasePointerRegisterValue: TDbgPtr;
var
lval, hval: QWord;
begin
Result := 0;
if TDbgAvrProcess(Process).FIsTerminating then
begin
DebugLn(DBG_WARNINGS, 'TDbgAvrThread.GetStackBasePointerRegisterValue called while FIsTerminating is set.');
exit;
end;
if not ReadThreadState then
exit;
DebugLn(DBG_VERBOSE, 'TDbgAvrThread.GetStackBasePointerRegisterValue requesting base registers.');
// Y-pointer (r28..r29)
ReadDebugReg(28, lval);
ReadDebugReg(29, hval);
result := byte(lval) + (byte(hval) shl 8);
end;
function TDbgAvrThread.GetStackPointerRegisterValue: TDbgPtr;
begin
Result := 0;
if TDbgAvrProcess(Process).FIsTerminating then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspThread.GetStackPointerRegisterValue called while FIsTerminating is set.');
exit;
end;
if not ReadThreadState then
exit;
DebugLn(DBG_VERBOSE, 'TDbgRspThread.GetStackPointerRegisterValue requesting stack registers.');
ReadDebugReg(SPindex, result);
end;
{ TDbgAvrProcess }
procedure TDbgAvrProcess.InitializeLoaders;
begin
TDbgImageLoader.Create(Name).AddToLoaderList(LoaderList);
end;
function TDbgAvrProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread;
begin
IsMainThread:=False;
if AthreadIdentifier<>feInvalidHandle then
begin
IsMainThread := AthreadIdentifier=ProcessID;
result := TDbgAvrThread.Create(Self, AthreadIdentifier, AthreadIdentifier)
end
else
result := nil;
end;
function TDbgAvrProcess.CreateWatchPointData: TFpWatchPointData;
begin
DebugLn(DBG_VERBOSE, 'TDbgRspProcess.CreateWatchPointData called.');
Result := TFpRspWatchPointData.Create;
end;
constructor TDbgAvrProcess.Create(const AFileName: string; const AProcessID,
AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager
);
begin
inherited Create(AFileName, AProcessID, AThreadID, AnOsClasses, AMemManager);
end;
destructor TDbgAvrProcess.Destroy;
begin
if Assigned(FConnection) then
FreeAndNil(FConnection);
inherited Destroy;
end;
class function TDbgAvrProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess;
var
AnExecutabeFilename: string;
dbg: TDbgAvrProcess;
begin
result := nil;
AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName);
if DirectoryExists(AnExecutabeFilename) then
begin
DebugLn(DBG_WARNINGS, 'Can not debug %s, because it''s a directory',[AnExecutabeFilename]);
Exit;
end;
if not FileExists(AFileName) then
begin
DebugLn(DBG_WARNINGS, 'Can not find %s.',[AnExecutabeFilename]);
Exit;
end;
dbg := TDbgAvrProcess.Create(AFileName, 0, 0, AnOsClasses, AMemManager);
try
dbg.FConnection := TRspConnection.Create(HostName, Port);
dbg.FConnection.RegisterCacheSize := RegArrayLength;
result := dbg;
dbg.FStatus := dbg.FConnection.Init;
dbg := nil;
except
on E: Exception do
begin
if Assigned(dbg) then
dbg.Free;
DebugLn(DBG_WARNINGS, Format('Failed to start remote connection. Errormessage: "%s".', [E.Message]));
end;
end;
end;
class function TDbgAvrProcess.AttachToInstance(AFileName: string;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): TDbgProcess;
begin
result := nil;
end;
class function TDbgAvrProcess.isSupported(target: TTargetDescriptor): boolean;
begin
result := (target.OS = osEmbedded) and
(target.machineType = mtAVR8);
end;
function TDbgAvrProcess.ReadData(const AAdress: TDbgPtr;
const ASize: Cardinal; out AData): Boolean;
begin
if FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspProcess.ReadData called while FIsTerminating is set.');
Result := false;
exit;
end;
result := FConnection.ReadData(AAdress, ASize, AData);
MaskBreakpointsInReadData(AAdress, ASize, AData);
end;
function TDbgAvrProcess.WriteData(const AAdress: TDbgPtr;
const ASize: Cardinal; const AData): Boolean;
begin
if FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspProcess.WriteData called while FIsTerminating is set.');
Result := false;
exit;
end;
result := FConnection.WriteData(AAdress,AAdress, AData);
end;
procedure TDbgAvrProcess.TerminateProcess;
begin
// Try to prevent access to the RSP socket after it has been closed
if not (FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP)) then
begin
DebugLn(DBG_VERBOSE, 'Removing all break points');
RemoveAllBreakPoints;
DebugLn(DBG_VERBOSE, 'Sending kill command from TDbgRspProcess.TerminateProcess');
FConnection.Kill();
FIsTerminating:=true;
end;
end;
function TDbgAvrProcess.Pause: boolean;
begin
if FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspProcess.Pause called while FIsTerminating is set.');
Result := false;
exit;
end;
// Target should automatically respond with T or S reply after processing the break
result := true;
if not PauseRequested then
begin
FConnection.Break();
PauseRequested := true;
DebugLn(DBG_VERBOSE, 'TDbgRspProcess.Pause called.');
end
else
begin
result := true;
DebugLn(DBG_WARNINGS, 'TDbgRspProcess.Pause called while PauseRequested is set.');
end;
end;
function TDbgAvrProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
begin
RemoveAllBreakPoints;
DebugLn(DBG_VERBOSE, 'Sending detach command from TDbgRspProcess.Detach');
Result := FConnection.Detach();
end;
function TDbgAvrProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;
var
ThreadToContinue: TDbgAvrThread;
PC: word;
s: string;
tempState: integer;
initRegs: TInitializedRegisters;
begin
// Terminating process and all threads
if FIsTerminating or (FStatus = SIGHUP) then
begin
AThread.BeforeContinue;
TDbgAvrThread(AThread).InvalidateRegisters;
DebugLn(DBG_VERBOSE, 'TDbgRspProcess.Continue called while terminating.');
// The kill command should have been issued earlier (if using fpd), calling SendKill again will lead to an exception since the connection should be terminated already.
// FConnection.Kill();
TDbgAvrThread(AThread).ResetPauseStates;
if not FThreadMap.HasId(AThread.ID) then
AThread.Free;
exit;
end;
if TDbgAvrThread(AThread).FIsPaused then // in case of deInternal, it may not be paused and can be ignored
AThread.NextIsSingleStep:=SingleStep;
// check other threads if they need a singlestep
for TDbgThread(ThreadToContinue) in FThreadMap do
if (ThreadToContinue <> AThread) and ThreadToContinue.FIsPaused then
begin
PC := ThreadToContinue.GetInstructionPointerRegisterValue;
if HasInsertedBreakInstructionAtLocation(PC) then
begin
TempRemoveBreakInstructionCode(PC);
ThreadToContinue.BeforeContinue;
while (ThreadToContinue.GetInstructionPointerRegisterValue = PC) do
begin
result := FConnection.SingleStep();
TDbgAvrThread(ThreadToContinue).ResetPauseStates; // So BeforeContinue will not run again
ThreadToContinue.FIsPaused := True;
if result then
begin
tempState := FConnection.WaitForSignal(s, initRegs); // TODO: Update registers cache for this thread
if (tempState = SIGTRAP) then
break; // if the command jumps back an itself....
end
else
begin
DebugLn(DBG_WARNINGS, ['Error single stepping other thread ', ThreadToContinue.ID]);
break;
end;
end;
end;
end;
if TDbgAvrThread(AThread).FIsPaused then // in case of deInternal, it may not be paused and can be ignored
if HasInsertedBreakInstructionAtLocation(AThread.GetInstructionPointerRegisterValue) then
begin
TempRemoveBreakInstructionCode(AThread.GetInstructionPointerRegisterValue);
TDbgAvrThread(AThread).FIsSteppingBreakPoint := True;
AThread.BeforeContinue;
result := FConnection.SingleStep(); // TODO: pass thread ID once it is supported in FConnection - also signals not yet passed through
TDbgAvrThread(AThread).ResetPauseStates;
FStatus := 0; // need to call WaitForSignal to read state after single step
exit;
end;
RestoreTempBreakInstructionCodes;
ThreadsBeforeContinue;
// start all other threads
for TDbgThread(ThreadToContinue) in FThreadMap do
begin
if (ThreadToContinue <> AThread) and (ThreadToContinue.FIsPaused) then
begin
FConnection.Continue();
ThreadToContinue.ResetPauseStates;
end;
end;
if TDbgAvrThread(AThread).FIsPaused then // in case of deInternal, it may not be paused and can be ignored
if not FIsTerminating then
begin
AThread.BeforeContinue;
if SingleStep then
result := FConnection.SingleStep()
else
result := FConnection.Continue();
TDbgAvrThread(AThread).ResetPauseStates;
FStatus := 0; // should update status by calling WaitForSignal
end;
if not FThreadMap.HasId(AThread.ID) then
AThread.Free;
end;
function TDbgAvrProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
var
s: string;
initRegs: TInitializedRegisters;
begin
debugln(DBG_VERBOSE, ['Entering WaitForDebugEvent, FStatus = ', FStatus]);
// Currently only single process/thread
// TODO: Query and handle process/thread states of target
ThreadIdentifier := self.ThreadID;
ProcessIdentifier := Self.ProcessID;
if FIsTerminating then
begin
DebugLn(DBG_VERBOSE, 'TDbgRspProcess.WaitForDebugEvent called while FIsTerminating is set.');
FStatus := SIGKILL;
end
else
// Wait for S or T response from target, or if connection to target is lost
if FStatus = 0 then
repeat
try
FStatus := FConnection.WaitForSignal(s, initRegs); // TODO: Update registers cache
except
FStatus := 0;
end;
until FStatus <> 0; // should probably wait at lower level...
if FStatus <> 0 then
begin
if FStatus in [SIGINT, SIGTRAP] then
begin
RestoreTempBreakInstructionCodes;
end;
end;
result := true;
end;
function TDbgAvrProcess.InsertBreakInstructionCode(const ALocation: TDBGPtr;
out OrigValue: Byte): Boolean;
begin
if FIsTerminating or (FStatus = SIGHUP) then
DebugLn(DBG_WARNINGS, 'TDbgRspProcess.InsertBreakInstruction called while FIsTerminating is set.');
result := ReadData(ALocation, SizeOf(OrigValue), OrigValue);
if result then
begin
// HW break...
result := FConnection.SetBreakWatchPoint(ALocation, wkpExec);
if not result then
DebugLn(DBG_WARNINGS, 'Failed to set break point.', []);
end
else
DebugLn(DBG_WARNINGS, 'Failed to read memory.', []);
end;
function TDbgAvrProcess.RemoveBreakInstructionCode(const ALocation: TDBGPtr;
const OrigValue: Byte): Boolean;
begin
if FIsTerminating or (FStatus = SIGHUP) then
begin
DebugLn(DBG_WARNINGS, 'TDbgRspProcess.RemoveBreakInstructionCode called while FIsTerminating is set');
result := false;
end
else
result := FConnection.DeleteBreakWatchPoint(ALocation, wkpExec);
end;
function TDbgAvrProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
var
ThreadToPause: TDbgAvrThread;
begin
debugln(DBG_VERBOSE, ['Entering TDbgRspProcess.AnalyseDebugEvent, FStatus = ', FStatus, ' PauseRequested = ', PauseRequested]);
if FIsTerminating then begin
result := deExitProcess;
exit;
end;
if AThread = nil then begin // should not happen... / just assume the most likely safe failbacks
result := deInternalContinue;
exit;
end;
TDbgAvrThread(AThread).FExceptionSignal:=0;
TDbgAvrThread(AThread).FIsPaused := True;
TDbgAvrThread(AThread).FUpdateStatusFromEvent(FConnection.lastStatusEvent);
if FStatus in [SIGHUP, SIGKILL] then // not sure which signals is relevant here
begin
if AThread.ID=ProcessID then
begin
// Main thread stop -> application exited
SetExitCode(FStatus);
result := deExitProcess
end
else
begin
// Thread stopped, just continue
RemoveThread(AThread.Id);
result := deInternalContinue;
end;
end
else if FStatus <> 0 then
begin
TDbgAvrThread(AThread).ReadThreadState;
if (not FProcessStarted) and (FStatus <> SIGTRAP) then
begin
// attached, should be SigStop, but may be out of order
debugln(DBG_VERBOSE, ['Attached ', FStatus]);
result := deCreateProcess;
FProcessStarted:=true;
end
else
case FStatus of
SIGTRAP:
begin
if not FProcessStarted then
begin
result := deCreateProcess;
FProcessStarted:=true;
DebugLn(DBG_VERBOSE, ['Creating process - SIGTRAP received for thread: ', AThread.ID]);
end
else if TDbgAvrThread(AThread).FInternalPauseRequested then
begin
DebugLn(DBG_VERBOSE, ['???Received late SigTrap for thread ', AThread.ID]);
result := deBreakpoint;//deInternalContinue; // left over signal
end
else
begin
DebugLn(DBG_VERBOSE, ['Received SigTrap for thread ', AThread.ID,
' PauseRequest=', PauseRequested]);
if PauseRequested then // Hack to work around Pause problem
result := deFinishedStep
else
result := deBreakpoint;
if not TDbgAvrThread(AThread).FIsSteppingBreakPoint then
AThread.CheckAndResetInstructionPointerAfterBreakpoint;
end;
end;
SIGINT:
begin
ExceptionClass:='SIGINT';
TDbgAvrThread(AThread).FExceptionSignal:=SIGINT;
result := deException;
end;
SIGKILL:
begin
if FIsTerminating then
result := deInternalContinue
else
begin
ExceptionClass:='SIGKILL';
TDbgAvrThread(AThread).FExceptionSignal:=SIGKILL;
result := deException;
end;
end;
SIGSTOP:
begin
// New thread (stopped within the new thread)
result := deInternalContinue;
end
else
begin
ExceptionClass:='Unknown exception code ' + inttostr(FStatus);
TDbgAvrThread(AThread).FExceptionSignal := FStatus;
result := deException;
end;
end; {case}
if result=deException then
ExceptionClass:='External: '+ExceptionClass;
end;
debugln(DBG_VERBOSE, ['Leaving AnalyseDebugEvent, result = ', result]);
TDbgAvrThread(AThread).FIsSteppingBreakPoint := False;
if Result in [deException, deBreakpoint, deFinishedStep] then // deFinishedStep will not be set here
begin
// Signal all other threads to pause
for TDbgThread(ThreadToPause) in FThreadMap do
begin
if (ThreadToPause <> AThread) then
begin
DebugLn(DBG_VERBOSE and (ThreadToPause.FInternalPauseRequested), ['Re-Request Internal pause for ', ThreadToPause.ID]);
ThreadToPause.FInternalPauseRequested:=false;
if not ThreadToPause.RequestInternalPause then // will fail, if already paused
break;
end;
end;
end;
end;
initialization
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
RegisterDbgOsClasses(TOSDbgClasses.Create(
TDbgAvrProcess,
TDbgAvrThread,
TAvrAsmDecoder));
end.