unit FpDbgRspClasses;

{ Connects to gdbserver instance and communicate over gdb's remote serial protocol (RSP).
  Can in principle possible to connect over any serial text capabile interface
  such as tcp/ip, RS-232, pipes etc. Currently only tcp/ip connections are supported. }

{$mode objfpc}{$H+}
{$packrecords c}
{$modeswitch advancedrecords}

interface

uses
  Classes,
  SysUtils,
  FpDbgClasses,
  FpDbgLoader,
  DbgIntfBaseTypes, DbgIntfDebuggerBase,
  {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, Maps,
  FpDbgRsp, FpDbgCommon, FpdMemoryTools,
  FpErrorMessages;

type
  TInitializedRegisters = record
    Initialized: boolean;
    regs: array of qword; // sized to handle largest register, should truncate as required to smaller registers
  end;

  { TDbgRspThread }

  TDbgRspThread = class(TDbgThread)
  private
  protected
    FRegs: TInitializedRegisters;
    FRegsChanged: boolean;
    FStoredRegs: TInitializedRegisters;
    FExceptionSignal: integer;
    FIsPaused, FInternalPauseRequested, FIsInInternalPause: boolean;
    FIsSteppingBreakPoint: boolean;
    FDidResetInstructionPointer: Boolean;
    FHasThreadState: boolean;
    FUnwinder: TDbgStackUnwinder;

    procedure LoadRegisterCache; virtual;
    procedure SaveRegisterCache; virtual;
    procedure InvalidateRegisters;
    function ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
    function WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
    function ReadThreadState: boolean;
    function RequestInternalPause: 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 SetRegisterValue(AName: string; AValue: QWord); override;
    procedure StoreRegisters; override;
    procedure RestoreRegisters; override;

    // Read access to internal registers
    property InternalRegs: TInitializedRegisters read FRegs;
  end;

  { TDbgRspProcess }

  TDbgRspProcess = class(TDbgProcess)
  private
  protected
    FStatus: integer;
    FProcessStarted: boolean;
    FIsTerminating: boolean;
    FConnection: TRspConnection;
    FRemoteConfig: TRemoteConfig;
    // Initialize in target specific class
    FRegArrayLength: integer;

    function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
    function CreateWatchPointData: TFpWatchPointData; override;
    procedure InitializeLoaders; override;
  public
    constructor Create(const AFileName: string; AnOsClasses: TOSDbgClasses;
                  AMemManager: TFpDbgMemManager; AMemModel: TFpDbgMemModel;
                  AProcessConfig: TDbgProcessConfig = nil); override;
    destructor Destroy; override;

    function StartInstance(AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
                      AFlags: TStartInstanceFlags; out AnError: TFpError): boolean; override;
    function AttachToInstance(APid: Integer; out AnError: TFpError): boolean; override;

    procedure CreateRspConnection(AFileName: string);

    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;

    property RspConnection: TRspConnection read FConnection;
    // Target specific length of register array
    property RegArrayLength: integer read FRegArrayLength;
    property IsTerminating: boolean read FIsTerminating;
    property Status: integer read FStatus;
  end;

  { TFpRspWatchPointData }

  TRspBreakWatchPoint = record
    Owner: Pointer;
    Address: TDBGPtr;
    Size: Cardinal;
    Kind: TDBGWatchPointKind;
  end;

  TFpRspWatchPointData = class(TFpWatchPointData)
  private
    FData: array of TRspBreakWatchPoint;
    function BreakWatchPoint(AnIndex: Integer): TRspBreakWatchPoint;
    function DataCount: integer;
  public
    function AddOwnedWatchpoint(AnOwner: Pointer; AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean; override;
    function RemoveOwnedWatchpoint(AnOwner: Pointer): boolean; override;
    function FindOwner(AnAddr: TDBGPtr): Pointer;
    property Data[AnIndex: Integer]: TRspBreakWatchPoint read BreakWatchPoint;
    property Count: integer read DataCount;
  end;

  generic TRspBreakPointTargetHandler<_BRK_STORE, _BREAK> = class(specialize TGenericBreakPointTargetHandler<_BRK_STORE, _BREAK>)
    // Defer break handling to remote server.
    function DoInsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: _BRK_STORE; AMakeTempRemoved: Boolean): Boolean; override;
    function DoRemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: _BRK_STORE): Boolean; override;
 end;

implementation

uses
  FpDbgDwarfDataClasses;

var
  DBG_VERBOSE, DBG_WARNINGS: PLazLoggerLogGroup;

{ TFpRspWatchPointData }

function TFpRspWatchPointData.BreakWatchPoint(AnIndex: Integer
  ): TRspBreakWatchPoint;
begin
  if AnIndex < length(FData) then
    result := FData[AnIndex];
end;

function TFpRspWatchPointData.DataCount: integer;
begin
  result := length(FData);
end;

function TFpRspWatchPointData.FindOwner(AnAddr: TDBGPtr): Pointer;
var
  i: integer;
begin
  i := 0;
  while (i < Count) and not ((AnAddr >= Data[i].Address) and (AnAddr < Data[i].Address + Data[i].Size)) do
  begin
    inc(i);
  end;
  if i < Count then
    Result := Data[i].Owner
  else
    Result := nil;
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].Size := ASize;
  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;

{ TRspBreakPointTargetHandler }

function TRspBreakPointTargetHandler.DoInsertBreakInstructionCode(const
  ALocation: TDBGPtr; out OrigValue: _BRK_STORE;
  AMakeTempRemoved: Boolean): Boolean;
begin
  if TDbgRspProcess(Process).FIsTerminating or (TDbgRspProcess(Process).FStatus = SIGHUP) then
    DebugLn(DBG__WARNINGS, 'TDbgRspProcess.InsertBreakInstruction called while FIsTerminating is set.');

  result := process.ReadData(ALocation, SizeOf(_BRK_STORE), OrigValue);
  if AMakeTempRemoved then
    exit;

  // Insert HW break...
  result := TDbgRspProcess(Process).RspConnection.SetBreakWatchPoint(ALocation, wkpExec, SizeOf(_BRK_STORE), true);
  if not result then
    DebugLn(DBG__WARNINGS, 'Failed to set break point.', []);
end;

function TRspBreakPointTargetHandler.DoRemoveBreakInstructionCode(const
  ALocation: TDBGPtr; const OrigValue: _BRK_STORE): Boolean;
begin
  if TDbgRspProcess(Process).FIsTerminating or (TDbgRspProcess(Process).FStatus = SIGHUP) then
  begin
    DebugLn(DBG__WARNINGS, 'TDbgRspProcess.RemoveBreakInstructionCode called while FIsTerminating is set');
    result := false;
  end
  else
    result := TDbgRspProcess(Process).RspConnection.DeleteBreakWatchPoint(ALocation, wkpExec);
end;

{ TDbgRspThread }

function TDbgRspThread.ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
begin
  Result := false;
  if TDbgRspProcess(Process).FIsTerminating or (TDbgRspProcess(Process).FStatus = SIGHUP) then
    DebugLn(DBG_WARNINGS, 'TDbgRspThread.GetDebugReg called while FIsTerminating is set.')
  else
  begin
    DebugLn(DBG_VERBOSE, ['TDbgRspThread.GetDebugReg requesting register: ',ind]);
    LoadRegisterCache;
    if ind < length(FRegs.regs) then
    begin
      AVal := FRegs.regs[ind];
      Result := true;
    end;
  end;
end;

function TDbgRspThread.WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
begin
  if TDbgRspProcess(Process).FIsTerminating or (TDbgRspProcess(Process).FStatus = SIGHUP) then
  begin
    DebugLn(DBG_WARNINGS, 'TDbgRspThread.WriteDebugReg called while FIsTerminating is set.');
    Result := false;
  end
  else
    result := TDbgRspProcess(Process).RspConnection.WriteDebugReg(ind, AVal);
end;

procedure TDbgRspThread.InvalidateRegisters;
begin
  FRegs.Initialized := false;
end;

procedure TDbgRspThread.LoadRegisterCache;
begin
  // Target specific
end;

procedure TDbgRspThread.SaveRegisterCache;
begin
  // Target specific
end;

function TDbgRspThread.ReadThreadState: boolean;
begin
//  assert(FIsPaused, 'TDbgRspThread.ReadThreadState: FIsPaused');
  result := true;
  if FHasThreadState then
    exit;
  FRegisterValueListValid := false;
end;

function TDbgRspThread.RequestInternalPause: Boolean;
begin
  if TDbgRspProcess(Process).FIsTerminating then
    DebugLn(DBG_WARNINGS, 'TDbgRspThread.RequestInternalPause called while FIsTerminating is set.');

  Result := False;
  if FInternalPauseRequested or FIsPaused or (TDbgRspProcess(Process).FStatus = SIGHUP) then
    exit;

  DebugLn(DBG_VERBOSE, 'TDbgRspThread.RequestInternalPause requesting Ctrl-C.');

  FInternalPauseRequested := true;
  // Send SIGSTOP/break
  TDbgRspProcess(Process).RspConnection.Break();
end;

procedure TDbgRspThread.ResetPauseStates;
begin
  FIsInInternalPause := False;
  FIsPaused := False;
  FExceptionSignal := 0;
  FHasThreadState := False;
  FDidResetInstructionPointer := False;
end;

constructor TDbgRspThread.Create(const AProcess: TDbgProcess;
  const AID: Integer; const AHandle: THandle);
begin
  inherited;
  FRegs.Initialized := false;
  SetLength(FRegs.regs, TDbgRspProcess(AProcess).RegArrayLength);
end;

function TDbgRspThread.ResetInstructionPointerAfterBreakpoint: boolean;
begin
  if not ReadThreadState then
    exit(False);
  result := true;
  if FDidResetInstructionPointer then
    exit;
  FDidResetInstructionPointer := True;
end;

procedure TDbgRspThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
var
  i: integer;
  addr: PtrUInt;
  watchData: TRspBreakWatchPoint;
  tmpData: TBytes;
begin
  for i := 0 to TFpRspWatchPointData(AWatchPointData).Count-1 do
  begin
    watchData := TFpRspWatchPointData(AWatchPointData).Data[i];
    addr := watchData.Address;
    SetLength(tmpData, watchData.Size);
    if Process.ReadData(addr, watchData.Size, tmpData[0]) then
    begin
      if not TDbgRspProcess(Process).RspConnection.SetBreakWatchPoint(addr, watchData.Kind, watchData.Size) then
        DebugLn(DBG_WARNINGS, 'Failed to set watch point.', []);
    end
    else
      DebugLn(DBG_WARNINGS, 'Failed to read memory.', []);
  end;
end;

function TDbgRspThread.DetectHardwareWatchpoint: Pointer;
begin
  if TDbgRspProcess(Process).RspConnection.LastStatusEvent.stopReason in [srAnyWatchPoint, srReadWatchPoint, srWriteWatchPoint] then
  begin
    Result := TFpRspWatchPointData(TDbgRspProcess(Process).WatchPointData).FindOwner(TDbgRspProcess(Process).RspConnection.LastStatusEvent.watchPointAddress);
    TDbgRspProcess(Process).RspConnection.ResetStatusEvent;
  end
  else
    result := nil;
end;

procedure TDbgRspThread.BeforeContinue;
begin
  if not FIsPaused then
    exit;

  inherited;
  if FRegsChanged then
    SaveRegisterCache;
  InvalidateRegisters;
end;

procedure TDbgRspThread.SetRegisterValue(AName: string; AValue: QWord);
begin
  assert(true, 'TDbgRspThread.SetRegisterValue not implemented');
end;

procedure TDbgRspThread.StoreRegisters;
begin
  FStoredRegs.Initialized := FRegs.Initialized;
  FStoredRegs.regs := copy(FRegs.regs);
end;

procedure TDbgRspThread.RestoreRegisters;
begin
  FRegs.Initialized := FStoredRegs.Initialized;
  FRegs.regs := copy(FStoredRegs.regs);
  FRegsChanged := true;
end;

{ TDbgRspProcess }

procedure TDbgRspProcess.InitializeLoaders;
var
  Loader: TDbgImageLoader;
begin
  if LoaderList.Count = 0 then
  begin
    Loader := TDbgImageLoader.Create(Name);
    if Loader.IsValid then
      Loader.AddToLoaderList(LoaderList)
    else
      Loader.Free;
  end;
end;

procedure TDbgRspProcess.CreateRspConnection(AFileName: string);
begin
  self.FConnection := TRspConnection.Create(AFileName, self, FRemoteConfig);
end;

constructor TDbgRspProcess.Create(const AFileName: string;
  AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager;
  AMemModel: TFpDbgMemModel; AProcessConfig: TDbgProcessConfig);
begin
  if Assigned(AProcessConfig) and (AProcessConfig is TRemoteConfig) then
  begin
    FRemoteConfig := TRemoteConfig.Create;
    FRemoteConfig.Assign(AProcessConfig);
  end;

  inherited Create(AFileName, AnOsClasses, AMemManager, AMemModel);
end;

destructor TDbgRspProcess.Destroy;
begin
  if Assigned(FRemoteConfig) then
    FreeAndNil(FRemoteConfig);
  if Assigned(FConnection) then
    FreeAndNil(FConnection);
  inherited Destroy;
end;

function TDbgRspProcess.AttachToInstance(APid: Integer; out AnError: TFpError
  ): boolean;
begin
  result := false;
end;

function TDbgRspProcess.StartInstance(AParams, AnEnvironment: TStrings;
  AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; out
  AnError: TFpError): boolean;
var
  AnExecutabeFilename: string;
begin
  Result := false;
  AnExecutabeFilename:=ExcludeTrailingPathDelimiter(Name);
  if DirectoryExists(AnExecutabeFilename) then
  begin
    DebugLn(DBG_WARNINGS, 'Can not debug %s, because it''s a directory',[AnExecutabeFilename]);
    Exit;
  end;

  if not FileExists(Name) then
  begin
    DebugLn(DBG_WARNINGS, 'Can not find  %s.',[AnExecutabeFilename]);
    Exit;
  end;

  if not Assigned(FRemoteConfig) then
  begin
    DebugLn(DBG_WARNINGS, 'TDbgAvrProcess only supports remote debugging and requires a valid TRemoteConfig class');
    Exit;
  end;

  try
    FConnection := TRspConnection.Create(Name, self, self.FRemoteConfig);
    FConnection.Connect;
    try
      FStatus := FConnection.Init;
      Result := FStatus <> SIGHUP;
    except
      on E: Exception do
      begin
        DebugLn(DBG_WARNINGS, Format('Failed to init remote connection. Errormessage: "%s".', [E.Message]));
      end;
    end;
  except
    on E: Exception do
    begin
      DebugLn(DBG_WARNINGS, Format('Failed to start remote connection. Errormessage: "%s".', [E.Message]));
    end;
  end;
end;

function TDbgRspProcess.ReadData(const AAdress: TDbgPtr;
  const ASize: Cardinal; out AData): Boolean;
begin
  if FIsTerminating or (TDbgRspProcess(Process).FStatus = SIGHUP) then
  begin
    DebugLn(DBG_WARNINGS, 'TDbgRspProcess.ReadData called while FIsTerminating is set.');
    Result := false;
    exit;
  end;

  result := RspConnection.ReadData(AAdress, ASize, AData);
  if Result then
    MaskBreakpointsInReadData(AAdress, ASize, AData);
end;

function TDbgRspProcess.WriteData(const AAdress: TDbgPtr;
  const ASize: Cardinal; const AData): Boolean;
begin
  if FIsTerminating or (TDbgRspProcess(Process).FStatus = SIGHUP) then
  begin
    DebugLn(DBG_WARNINGS, 'TDbgRspProcess.WriteData called while FIsTerminating is set.');
    Result := false;
    exit;
  end;

  result := RspConnection.WriteData(AAdress, ASize, AData);
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;
  end;
end;

function TDbgRspProcess.Pause: boolean;
begin
  if FIsTerminating or (TDbgRspProcess(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
    RspConnection.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 TDbgRspProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
begin
  RemoveAllBreakPoints;
  DebugLn(DBG_VERBOSE, 'Sending detach command from TDbgRspProcess.Detach');
  Result := RspConnection.Detach();
end;

function TDbgRspProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;

  function DoLocalStep(TheThread: TDbgThread): Integer;
  var
    res: boolean;
    s: string;
  begin
    res := RspConnection.SingleStep();
    TDbgRspThread(TheThread).ResetPauseStates; // So BeforeContinue will not run again
    TDbgRspThread(TheThread).FIsPaused := True;
    if res then
      Result := RspConnection.WaitForSignal(s)
    else
    begin
      DebugLn(DBG_WARNINGS, ['Error local single stepping thread ', TheThread.ID]);
      Result := -1;
    end;
  end;

var
  ThreadToContinue: TDbgRspThread;
  PC: word;
begin
  // Terminating process and all threads
  if FIsTerminating or (FStatus = SIGHUP) then
  begin
    AThread.BeforeContinue;
    TDbgRspThread(AThread).InvalidateRegisters;
    DebugLn(DBG_VERBOSE, 'TDbgRspProcess.Continue called while terminating.');

    TDbgRspThread(AThread).ResetPauseStates;
    if not FThreadMap.HasId(AThread.ID) then
      AThread.Free;
    exit;
  end;

  if TDbgRspThread(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;

        if (ThreadToContinue.GetInstructionPointerRegisterValue = PC) then
          repeat
            FStatus := DoLocalStep(ThreadToContinue);
          until (FStatus = -1) or (FStatus = SIGTRAP);
      end;
    end;

  if TDbgRspThread(AThread).FIsPaused and SingleStep then  // in case of deInternal, it may not be paused and can be ignored
  if HasInsertedBreakInstructionAtLocation(AThread.GetInstructionPointerRegisterValue) then
  begin
    TempRemoveBreakInstructionCode(AThread.GetInstructionPointerRegisterValue);
    TDbgRspThread(AThread).FIsSteppingBreakPoint := True;
    AThread.BeforeContinue;
    result := RspConnection.SingleStep(); // TODO: pass thread ID once it is supported in RspConnection - also signals not yet passed through
    TDbgRspThread(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
      RspConnection.Continue();
      ThreadToContinue.ResetPauseStates;
    end;
  end;

  if TDbgRspThread(AThread).FIsPaused then  // in case of deInternal, it may not be paused and can be ignored
    if not FIsTerminating then
    begin
      AThread.BeforeContinue;

      // In qemu, needs to step over breakpoint for continue command to work
      FStatus := DoLocalStep(AThread);

      if not SingleStep then
      begin
        result := RspConnection.Continue();
        TDbgRspThread(AThread).ResetPauseStates;
        FStatus := 0;  // should update status by calling WaitForSignal
      end;
    end;

  if not FThreadMap.HasId(AThread.ID) then
    AThread.Free;
end;

function TDbgRspProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
var
  s: string;
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 := SIGHUP;
    Exit(True);
  end
  else
  // Wait for S or T response from target, or if connection to target is lost
  if FStatus = 0 then
    repeat
      try
        FStatus := RspConnection.WaitForSignal(s); // TODO: Update registers cache
        sleep(1);
      except
        FStatus := 0;
      end;
    until FStatus <> 0;

  if FStatus in [SIGINT, SIGTRAP] then
    RestoreTempBreakInstructionCodes;

  result := FStatus <> 0;
end;

function TDbgRspProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
var
  ThreadToPause: TDbgRspThread;
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;

  TDbgRspThread(AThread).FExceptionSignal:=0;
  TDbgRspThread(AThread).FIsPaused := True;

  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
    TDbgRspThread(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 TDbgRspThread(AThread).FInternalPauseRequested then
        begin
          DebugLn(DBG_VERBOSE, ['???Received late SigTrap for thread ', AThread.ID]);
          result := deBreakpoint;
        end
        else
        begin
          DebugLn(DBG_VERBOSE, ['Received SigTrap for thread ', AThread.ID,
             ' PauseRequest=', PauseRequested]);
          result := deBreakpoint;

          if not TDbgRspThread(AThread).FIsSteppingBreakPoint then
            AThread.CheckAndResetInstructionPointerAfterBreakpoint;
        end;
      end;
      SIGINT:
        begin
          if PauseRequested then
            result := deBreakpoint
          else
          begin
            ExceptionClass:='SIGINT';
            TDbgRspThread(AThread).FExceptionSignal:=SIGINT;
            result := deException;
          end;
        end;
      SIGKILL:
        begin
          if FIsTerminating then
            result := deInternalContinue
          else
            begin
            ExceptionClass:='SIGKILL';
            TDbgRspThread(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);
        TDbgRspThread(AThread).FExceptionSignal := FStatus;
        result := deException;
      end;
    end; {case}
    if result=deException then
      ExceptionClass:='External: '+ExceptionClass;
  end;

  debugln(DBG_VERBOSE, ['Leaving AnalyseDebugEvent, result = ', result]);

  TDbgRspThread(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;

function TDbgRspProcess.CreateWatchPointData: TFpWatchPointData;
begin
  Result := TFpRspWatchPointData.Create;
end;

initialization
  DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
  DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );

end.