{ $Id$ }
{
 ---------------------------------------------------------------------------
 fpdbgclasses.pp  -  Native freepascal debugger
 ---------------------------------------------------------------------------

 This unit contains debugger classes for a native freepascal debugger

 ---------------------------------------------------------------------------

 @created(Mon Apr 10th WET 2006)
 @lastmod($Date$)
 @author(Marc Weustink <marc@@dommelstein.nl>)

 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************
}
unit FpDbgClasses;
{$mode objfpc}{$H+}
{$TYPEDADDRESS on}
{$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF}
{$IF FPC_Fullversion=30202}{$Optimization NOPEEPHOLE}{$ENDIF}

interface

uses
  Classes, SysUtils, Maps, FpDbgUtil, FpDbgLoader, FpDbgInfo,
  FpdMemoryTools, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazClasses, LazFileUtils, DbgIntfBaseTypes,
  fgl, DbgIntfDebuggerBase, fpDbgSymTableContext,
  FpDbgCommon, FpErrorMessages, LazDebuggerIntf;

type
  TFPDEvent = (
    deExitProcess, deCreateProcess,
    deLoadLibrary, deUnloadLibrary,
    deFinishedStep, deBreakpoint, deHardCodedBreakpoint,
    deException,
    deInternalContinue,
    deFailed);
  TFPDCompareStepInfo = (dcsiNewLine, dcsiSameLine, dcsiNoLineInfo, dcsiZeroLine);

  { TDbgRegisterValue }

  TDbgRegisterValue = class
  private
    FDwarfIdx: cardinal;
    FName: string;
    FNumValue: TDBGPtr;
    FSize: byte;
    FStrValue: string;
  public
    constructor Create(const AName: String);
    procedure Assign(ASource: TDbgRegisterValue);
    function HasEqualVal(AnOther: TDbgRegisterValue): Boolean;
    procedure SetValue(ANumValue: TDBGPtr; const AStrValue: string; ASize: byte; ADwarfIdx: cardinal);
    procedure Setx86EFlagsValue(ANumValue: TDBGPtr);
    property Name: string read FName;
    property NumValue: TDBGPtr read FNumValue;
    property StrValue: string read FStrValue;
    property Size: byte read FSize;
    property DwarfIdx: cardinal read FDwarfIdx;
  end;

  TGDbgRegisterValueList = specialize TFPGObjectList<TDbgRegisterValue>;

  { TDbgRegisterValueList }

  TDbgRegisterValueList = class(TGDbgRegisterValueList)
  private
    FPreviousRegisterValueList: TDbgRegisterValueList;

    function GetDbgRegister(AName: string): TDbgRegisterValue;
    function GetDbgRegisterAutoCreate(const AName: string): TDbgRegisterValue;
    function GetIsModified(AReg: TDbgRegisterValue): boolean;
  public
    procedure Assign(ASource: TDbgRegisterValueList);
    property DbgRegisterAutoCreate[AName: string]: TDbgRegisterValue read GetDbgRegisterAutoCreate;
    function FindRegisterByDwarfIndex(AnIdx: cardinal): TDbgRegisterValue;
    function FindRegisterByName(AnName: String): TDbgRegisterValue;
    property IsModified[AReg: TDbgRegisterValue]: boolean read GetIsModified;
  end;

  { TDbgCallstackEntry }
  TDbgThread = class;
  TFPDThreadArray = array of TDbgThread;
  TDbgInstance = class;
  TDbgLibrary = class;
  TOSDbgClasses = class;
  TDbgAsmInstruction = class;

  TDbgCallstackEntry = class
  private
    FAnAddress: TDBGPtr;
    FFrameAdress: TDBGPtr;
    FThread: TDbgThread;
    FIsSymbolResolved: boolean;
    FSymbol: TFpSymbol;
    FRegisterValueList: TDbgRegisterValueList;
    FIndex: integer;
    function GetFunctionName: string;
    function GetProcSymbol: TFpSymbol;
    function GetLine: integer;
    function GetSourceFile: string;
    function GetSrcClassName: string;
  public
    constructor create(AThread: TDbgThread; AnIndex: integer; AFrameAddress, AnAddress: TDBGPtr);
    destructor Destroy; override;
    property AnAddress: TDBGPtr read FAnAddress;
    property FrameAdress: TDBGPtr read FFrameAdress;
    property SourceFile: string read GetSourceFile;
    property FunctionName: string read GetFunctionName;
    property SrcClassName: string read GetSrcClassName;
    property Line: integer read GetLine;
    property RegisterValueList: TDbgRegisterValueList read FRegisterValueList;
    property ProcSymbol: TFpSymbol read GetProcSymbol;
    property Index: integer read FIndex;
  end;

  { TDbgCallstackEntryList }

  TDbgCallstackEntryList = class(specialize TFPGObjectList<TDbgCallstackEntry>)
  private
    FHasReadAllAvailableFrames: boolean;
  protected
  public
    procedure SetHasReadAllAvailableFrames;
    procedure Clear;
    property HasReadAllAvailableFrames: boolean read FHasReadAllAvailableFrames;
  end;

  TDbgProcess = class;
  TFpWatchPointData = class;

  { TDbgMemReader }

  TDbgMemReader = class(TFpDbgMemReaderBase)
  protected
    function GetDbgProcess: TDbgProcess; virtual; abstract;
    function GetDbgThread(AContext: TFpDbgLocationContext): TDbgThread; virtual;
  public
    function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override; overload;
    function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer; out ABytesRead: Cardinal): Boolean; override; overload;
    function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
    function WriteMemory(AnAddress: TDbgPtr; ASize: Cardinal; ASource: Pointer): Boolean; override; overload;
    function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override;
    function RegisterSize(ARegNum: Cardinal): Integer; override;
    function RegisterNumber(ARegName: String; out ARegNum: Cardinal): Boolean; override;

    function WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override;
  end;

  { TDbgStackFrameInfo
    This can be overridden by each OS dependen class. Or it could be gotten from the Disassemble, if it is CPU specific
    This default assumes an Intel like stack, with StackPointer and FrameBase.
    This default assumes the stack grows by decreasing addresses.
  }

  TDbgStackFrameInfo = class
  private
    FThread: TDbgThread;
    FStoredStackFrame, FStoredStackPointer: TDBGPtr;
    FHasSteppedOut: Boolean;
    FProcessAfterRun: Boolean;
    FLeaveState: (lsNone, lsWasAtLeave1, lsWasAtLeave2, lsLeaveDone);
    Procedure DoAfterRun;
  protected
    procedure DoCheckNextInstruction(ANextInstruction: TDbgAsmInstruction; NextIsSingleStep: Boolean); virtual;
    function  CalculateHasSteppedOut: Boolean;  virtual;
  public
    constructor Create(AThread: TDbgThread);
    procedure CheckNextInstruction(ANextInstruction: TDbgAsmInstruction; NextIsSingleStep: Boolean); inline;
    function  HasSteppedOut: Boolean; inline;
    procedure FlagAsSteppedOut; inline;

    // only for FpLldbDebugger
    property StoredStackFrame: TDBGPtr read FStoredStackFrame;
  end;

  { TDbgThread }
  TFpInternalBreakpoint = class;

  TDbgThread = class(TObject)
  private
    FNextIsSingleStep: boolean;
    FProcess: TDbgProcess;
    FID: Integer;
    FHandle: THandle;
    FPausedAtRemovedBreakPointState: (rbUnknown, rbNone, rbFound{, rbFoundAndDec});
    FPausedAtHardcodeBreakPoint: Boolean;
    FPausedAtRemovedBreakPointAddress: TDBGPtr;
    FSuspendCount: Integer;

    function GetRegisterValueList: TDbgRegisterValueList;
  protected
    FCallStackEntryList: TDbgCallstackEntryList;
    FRegisterValueListValid: boolean;
    FRegisterValueList,
    FPreviousRegisterValueList: TDbgRegisterValueList;
    FStoreStepSrcFilename, FStoreStepFuncName: string;
    FStoreStepStartAddr, FStoreStepEndAddr: TDBGPtr;
    FStoreStepSrcLineNo: integer;
    FStoreStepFuncAddr: TDBGPtr;
    FStackBeforeAlloc: TDBGPtr;
    procedure LoadRegisterValues; virtual;
    property Process: TDbgProcess read FProcess;
    function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract;
    procedure DoBeforeBreakLocationMapChange; // A new location added / or a location removed => memory will change
    procedure ValidateRemovedBreakPointInfo;
    function GetName: String; virtual;

  public
    constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); virtual;
    procedure DoBeforeProcessLoop;
    function HasInsertedBreakInstructionAtLocation(const ALocation: TDBGPtr): Boolean; // include removed breakpoints that (may have) already triggered
    (* CheckAndResetInstructionPointerAfterBreakpoint
       This will check if the last instruction was a breakpoint (int3).
       It must ONLY be called, if the signal indicated that it should have been.
       Since the previous IP is not known, this assumes the length of the
         previous asm statement to be the same as the length of int3.
       If a longer command would end in the signature of int3, then this would
         detect the int3 (false positive)
    *)
    procedure CheckAndResetInstructionPointerAfterBreakpoint;
    function CheckForHardcodeBreakPoint(AnAddr: TDBGPtr): boolean;
    procedure BeforeContinue; virtual;
    procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); virtual;
    function DetectHardwareWatchpoint: Pointer; virtual;
    // This function changes the value of a register in the debugee.
    procedure SetRegisterValue(AName: string; AValue: QWord); virtual; abstract;

    function GetInstructionPointerRegisterValue: TDbgPtr; virtual; abstract;
    function GetStackBasePointerRegisterValue: TDbgPtr; virtual; abstract;
    function GetStackPointerRegisterValue: TDbgPtr; virtual; abstract;
    procedure SetStackPointerRegisterValue(AValue: TDbgPtr); virtual; abstract;
    procedure SetInstructionPointerRegisterValue(AValue: TDbgPtr); virtual; abstract;
    function GetCurrentStackFrameInfo: TDbgStackFrameInfo;

    function AllocStackMem(ASize: Integer): TDbgPtr; virtual;
    procedure RestoreStackMem;

    procedure PrepareCallStackEntryList(AFrameRequired: Integer = -1); virtual;
    function  FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
    function  FindCallStackEntryByInstructionPointer(AInstructionPointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
    procedure ClearCallStack;
    // Use these functions to 'save' the value of all registers, and to reset
    // them to their original values. (Used to be able to restore the original
    // situation after calling functions inside the debugee)
    procedure StoreRegisters; virtual; abstract;
    procedure RestoreRegisters; virtual; abstract;
    // It could be that an signal led to an exception, and that this
    // signal is stored to be send to the debuggee again upon continuation.
    // Use ClearExceptionSignal to remove/eat this signal.
    procedure ClearExceptionSignal; virtual;

    procedure IncSuspendCount;
    procedure DecSuspendCount;
    property  SuspendCount: Integer read FSuspendCount;

    destructor Destroy; override;
    function CompareStepInfo(AnAddr: TDBGPtr = 0; ASubLine: Boolean = False): TFPDCompareStepInfo;
    function IsAtStartOfLine: boolean;
    procedure StoreStepInfo(AnAddr: TDBGPtr = 0);
    property ID: Integer read FID;
    property Handle: THandle read FHandle;
    property Name: String read GetName;
    property NextIsSingleStep: boolean read FNextIsSingleStep write FNextIsSingleStep;
    property RegisterValueList: TDbgRegisterValueList read GetRegisterValueList;
    property CallStackEntryList: TDbgCallstackEntryList read FCallStackEntryList;
    property StoreStepFuncName: String read FStoreStepFuncName;
    property PausedAtHardcodeBreakPoint: Boolean read FPausedAtHardcodeBreakPoint;
  end;
  TDbgThreadClass = class of TDbgThread;

  { TThreadMapUnLockedEnumerator }

  TThreadMapUnLockedEnumerator = class(TMapIterator)
  private
    FDoneFirst: Boolean;
    function GetCurrent: TDbgThread;
  public
    function MoveNext: Boolean;
    property Current: TDbgThread read GetCurrent;
  end;

    { TThreadMapEnumerator }

  TThreadMapEnumerator = class(TLockedMapIterator)
  private
    FDoneFirst: Boolean;
    function GetCurrent: TDbgThread;
  public
    function MoveNext: Boolean;
    property Current: TDbgThread read GetCurrent;
  end;

  { TThreadMap }

  TThreadMap = class(TMap)
  public
    function GetEnumerator: TThreadMapEnumerator;
  end;

  // Simple array to pass a list of multiple libraries in a parameter. Does
  // not own or do anything other with the libraries.
  TDbgLibraryArr = array of TDbgLibrary;

  { TLibraryMapEnumerator }

  TLibraryMapEnumerator = class(TMapIterator)
  private
    FDoneFirst: Boolean;
    function GetCurrent: TDbgLibrary;
  public
    function MoveNext: Boolean;
    property Current: TDbgLibrary read GetCurrent;
  end;

  { TLibraryMap }

  TLibraryMap = class(TMap)
  private
    FLibrariesAdded: TDbgLibraryArr;
    FLibrariesRemoved: TDbgLibraryArr;
  public
    function GetEnumerator: TLibraryMapEnumerator;
    procedure Add(const AId, AData);
    function Delete(const AId): Boolean;
    function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
    function GetLib(const AName: String; out ALib: TDbgLibrary; IsFullName: Boolean = True): Boolean;
    procedure ClearAddedAndRemovedLibraries;
    property LibrariesAdded: TDbgLibraryArr read FLibrariesAdded;
  end;

  TFpInternalBreakpointArray = array of TFpInternalBreakpoint;

  { TBreakLocationMap }

  TBreakLocationMap = class(TMap)
  strict private type
    { TBreakLocationEntry }
    TBreakLocationEntry = object
      Location: TDBGPtr;
      Data: Pointer;
      function OrigValue: Byte;
      function ErrorSetting: ByteBool;
    end;

    { TInternalBreakLocationEntry }
    TInternalBreakLocationEntry = record
      OrigValue: Byte;
      IsBreakList, ErrorSetting: ByteBool;
      InternalBreakPoint: Pointer;
    end;
    PInternalBreakLocationEntry = ^TInternalBreakLocationEntry;

  public type
    { TBreakLocationMapEnumerator }
    TBreakLocationMapEnumerator = class(TMapIterator)
    private
      FDoneFirst: Boolean;
      function GetCurrent: TBreakLocationEntry;
    public
      function MoveNext: Boolean;
      property Current: TBreakLocationEntry read GetCurrent;
    end;

  private const
    Int3: Byte = $CC;

  private
    FProcess: TDbgProcess;
    FTmpRemovedBreaks: array of TDBGPtr;

    class function OrigByteFromPointer(AData: Pointer): Byte;
    class function ErrorSettingFromPointer(AData: Pointer): ByteBool;

  strict private
    function GetOrigValueAtLocation(const ALocation: TDBGPtr): Byte; // returns Int3, if there is no break at this location
    procedure AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: Byte);
  public
    constructor Create(AProcess: TDbgProcess);
    destructor Destroy; override;
    procedure Clear; reintroduce;
    procedure AddLocation(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint; AnIgnoreIfExists: Boolean = True);
    procedure RemoveLocation(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint);

    // When the debugger modifies the debuggee's code, it might be that the
    // original value underneeth the breakpoint has to be changed. This function
    // makes this possible.
    procedure UpdateMapForNewTargetCode(const AAdress: TDbgPtr; const ASize: Cardinal; const AData);

    function GetInternalBreaksAtLocation(const ALocation: TDBGPtr): TFpInternalBreakpointArray;
    function HasInsertedBreakInstructionAtLocation(const ALocation: TDBGPtr): Boolean;
    function IsHardcodeBreakPoint(const ALocation: TDBGPtr): Boolean;
    function GetEnumerator: TBreakLocationMapEnumerator;

    procedure TempRemoveBreakInstructionCode(const ALocation: TDBGPtr);
    procedure RestoreTempBreakInstructionCodes;
    procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
  end;

  { TFpDbgBreakpoint }

  TFpDbgBreakpoint = class;

  TFpDbgBreakpointState = (bksUnknown, bksOk, bksFailed, bksPending);
  TFpDbgBreakpointStateChangeEvent = procedure(Sender: TFpDbgBreakpoint; ANewState: TFpDbgBreakpointState) of object;

  TFpDbgBreakpoint = class(TObject)
  private
    FFreeByDbgProcess: Boolean;
    FEnabled: boolean;
    FOn_Thread_StateChange: TFpDbgBreakpointStateChangeEvent;
  protected
    procedure SetEnabled(AValue: boolean);
    function GetState: TFpDbgBreakpointState; virtual;
  public
    function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; virtual; abstract;
    function HasLocation(const ALocation: TDBGPtr): Boolean; virtual; abstract;
    // A breakpoint could also be inside/part of a library.

    procedure AddAddress(const ALocation: TDBGPtr); virtual; abstract;
    procedure RemoveAddress(const ALocation: TDBGPtr); virtual; abstract;
    procedure RemoveAllAddresses; virtual; abstract;

    procedure SetBreak; virtual; abstract;
    procedure ResetBreak; virtual; abstract;

    // FreeByDbgProcess: The breakpoint will be freed by TDbgProcess.Destroy
    property FreeByDbgProcess: Boolean read FFreeByDbgProcess write FFreeByDbgProcess;
    property Enabled: boolean read FEnabled write SetEnabled;
    property State: TFpDbgBreakpointState read GetState;
    // Event runs in dbg-thread
    property On_Thread_StateChange: TFpDbgBreakpointStateChangeEvent read FOn_Thread_StateChange write FOn_Thread_StateChange;
  end;

  { TFpInternalBreakBase }

  TFpInternalBreakBase = class(TFpDbgBreakpoint)
  private
    FProcess: TDbgProcess;
  protected
    procedure UpdateForLibraryLoaded(ALib: TDbgLibrary); virtual;
    procedure UpdateForLibrareUnloaded(ALib: TDbgLibrary); virtual;
    property Process: TDbgProcess read FProcess;
  public
    constructor Create(const AProcess: TDbgProcess); virtual;
  end;

  TFpInternalBreakpointList = specialize TFPGObjectList<TFpInternalBreakBase>;

  { TFpInternalBreakpoint }

  TFpInternalBreakpoint = class(TFpInternalBreakBase)
  private
    FLocation: TDBGPtrArray;
    FInternal: Boolean;
    FState: TFpDbgBreakpointState;
  protected
    function GetState: TFpDbgBreakpointState; override;
    procedure SetState(AState: TFpDbgBreakpointState);
    procedure UpdateState; virtual;
    procedure UpdateForLibrareUnloaded(ALib: TDbgLibrary); override;
    property Location: TDBGPtrArray read FLocation;
  public
    constructor Create(const AProcess: TDbgProcess; const ALocation: TDBGPtrArray; AnEnabled: Boolean); virtual;
    destructor Destroy; override;
    function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; override;
    function HasLocation(const ALocation: TDBGPtr): Boolean; override;

    procedure AddAddress(const ALocation: TDBGPtr); override;
    procedure AddAddress(const ALocations: TDBGPtrArray);
    procedure RemoveAddress(const ALocation: TDBGPtr); override;
    procedure RemoveAllAddresses; override;

    procedure SetBreak; override;
    procedure ResetBreak; override;

  end;

  { TFpInternalBreakpointAtSymbol }

  TFpInternalBreakpointAtSymbol = class(TFpInternalBreakpoint)
  private
    FFuncName: String;
    FSymInstance: TDbgInstance;
  protected
    procedure UpdateState; override;
    procedure UpdateForLibraryLoaded(ALib: TDbgLibrary); override;
  public
    constructor Create(const AProcess: TDbgProcess; const AFuncName: String; AnEnabled: Boolean; ASymInstance: TDbgInstance = nil); virtual;
  end;

  { TFpInternalBreakpointAtFileLine }

  TFpInternalBreakpointAtFileLine = class(TFpInternalBreakpoint)
  private
    FFileName: String;
    FLine: Cardinal;
    FSymInstance: TDbgInstance;
    FFoundFileWithoutLine: Boolean;
  protected
    procedure UpdateState; override;
    procedure UpdateForLibraryLoaded(ALib: TDbgLibrary); override;
  public
    constructor Create(const AProcess: TDbgProcess; const AFileName: String; ALine: Cardinal; AnEnabled: Boolean; ASymInstance: TDbgInstance = nil); virtual;
  end;

  { TFpInternalWatchpoint }

  TFpInternalWatchpoint  = class(TFpInternalBreakBase)
  private
    FLocation: TDBGPtr;
    FSize: Cardinal;
    FReadWrite: TDBGWatchPointKind;
    FScope: TDBGWatchPointScope;

    FOtherWatchCount: Integer;
    FFirstWatchLocation: TDBGPtr;
    FFirstWatchSize,
    FOtherWatchesSize,
    FLastWatchSize: Integer;
  protected
    property Location: TDBGPtr read FLocation;
    property Size: Cardinal read FSize;
    property ReadWrite: TDBGWatchPointKind read FReadWrite;
    property Scope: TDBGWatchPointScope read FScope;
  public
    constructor Create(const AProcess: TDbgProcess; const ALocation: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind;
                      AScope: TDBGWatchPointScope); virtual;
    destructor Destroy; override;

    procedure SetBreak; override;
    procedure ResetBreak; override;
  end;

  // Container to hold target specific process info
  TDbgProcessConfig = class(TPersistent)
  end;

  { TDbgInstance }

  TDbgInstance = class(TObject)
  private
    FMemManager: TFpDbgMemManager;
    FMode: TFPDMode;
    FFileName: String;
    FProcess: TDbgProcess;
    FSymbolTableInfo: TFpSymbolInfo;
    FLoaderList: TDbgImageLoaderList;
    FLastLineAddressesFoundFile: Boolean;
    function GetOSDbgClasses: TOSDbgClasses;
    function GetPointerSize: Integer;

    function  GetLineAddresses(AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean;
    function FindProcSymbol(const AName: String): TFpSymbol; overload;
    function FindProcSymbol(AAdress: TDbgPtr): TFpSymbol; overload;
  protected
    FDbgInfo: TDbgInfo;
    procedure InitializeLoaders; virtual;
    procedure SetFileName(const AValue: String);
    procedure SetMode(AMode: TFPDMode); experimental; // for testcase
  public
    constructor Create(const AProcess: TDbgProcess); virtual;
    destructor Destroy; override;

    // Returns the addresses at the given source-filename and line-number.
    // Searches the program and all libraries. This can lead to multiple hits,
    // as the application and libraries can share sourcecode but have their own
    // binary code.

    function  FindProcStartEndPC(AAdress: TDbgPtr; out AStartPC, AEndPC: TDBGPtr): boolean;

    // Check if a certain (range of) address(es) belongs to a specific Instance
    // (for example a library)
    function EnclosesAddress(AnAddress: TDBGPtr): Boolean;
    function EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean;

    procedure LoadInfo; virtual;

    property Process: TDbgProcess read FProcess;
    property OSDbgClasses: TOSDbgClasses read GetOSDbgClasses;
    property DbgInfo: TDbgInfo read FDbgInfo;
    property SymbolTableInfo: TFpSymbolInfo read FSymbolTableInfo;
    property Mode: TFPDMode read FMode;
    property PointerSize: Integer read GetPointerSize;
    property MemManager: TFpDbgMemManager read FMemManager;
    property LoaderList: TDbgImageLoaderList read FLoaderList;
  end;

  { TDbgLibrary }

  TDbgLibrary = class(TDbgInstance)
  private
    FModuleHandle: THandle;
    FBreakUpdateDone: Boolean;
  public
    constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle);
    property Name: String read FFileName;
    property ModuleHandle: THandle read FModuleHandle;
  end;

  TStartInstanceFlag = (siRediretOutput, siForceNewConsole);
  TStartInstanceFlags = set of TStartInstanceFlag;

  { TDbgAsmInstruction }

  TDbgAsmInstruction = class(TRefCountedObject)
  public
    // returns byte len of call instruction at AAddress // 0 if not a call intruction
    function IsCallInstruction: boolean; virtual;
    function IsReturnInstruction: boolean; virtual;
    function IsLeaveStackFrame: boolean; virtual;
    //function ModifiesBasePointer: boolean; virtual;
    function ModifiesStackPointer: boolean; virtual;
    function IsJumpInstruction(IncludeConditional: Boolean = True; IncludeUncoditional: Boolean = True): boolean; virtual;
    function InstructionLength: Integer; virtual;
  end;

  TDbgInstInfo = record
    InstrType: (itAny, itJump);
    InstrTargetOffs: Int64; // offset from the START address of instruction
  end;

  { TDbgAsmDecoder }

  TDbgAsmDecoder = class
  protected
    function GetLastErrorWasMemReadErr: Boolean; virtual;
    function GetMaxInstrSize: integer; virtual; abstract;
    function GetMinInstrSize: integer; virtual; abstract;
    function GetCanReverseDisassemble: boolean; virtual;
  public
    constructor Create(AProcess: TDbgProcess); virtual; abstract;

    procedure Disassemble(var AAddress: Pointer; out ACodeBytes: String; out ACode: String; out AnInfo: TDbgInstInfo); virtual; overload;
    procedure Disassemble(var AAddress: Pointer; out ACodeBytes: String; out ACode: String); virtual; abstract; overload;
    procedure ReverseDisassemble(var AAddress: Pointer; out ACodeBytes: String; out ACode: String); virtual;

    function GetInstructionInfo(AnAddress: TDBGPtr): TDbgAsmInstruction; virtual; abstract;
    function GetFunctionFrameInfo(AnAddress: TDBGPtr; out AnIsOutsideFrame: Boolean): Boolean; virtual;
    function IsAfterCallInstruction(AnAddress: TDBGPtr): boolean; virtual;
    function UnwindFrame(var AnAddress, AStackPtr, AFramePtr: TDBGPtr; AQuick: boolean): boolean; virtual;

    property LastErrorWasMemReadErr: Boolean read GetLastErrorWasMemReadErr;
    property MaxInstructionSize: integer read GetMaxInstrSize;  // abstract
    property MinInstructionSize: integer read GetMinInstrSize;  // abstract
    property CanReverseDisassemble: boolean read GetCanReverseDisassemble;
  end;
  TDbgDisassemblerClass = class of TDbgAsmDecoder;

  TDebugOutputEvent = procedure(Sender: TObject; ProcessId, ThreadId: Integer; AMessage: String) of object;

  { TDbgProcess }

  TDbgProcess = class(TDbgInstance)
  protected const
    Int3: Byte = $CC deprecated 'Use FBreakMap.Int3';
  private
    FDisassembler: TDbgAsmDecoder;
    FExceptionClass: string;
    FExceptionMessage: string;
    FExitCode: DWord;
    FGotExitProcess: Boolean;
    FLastLibraryUnloaded: TDbgLibrary;
    FOnDebugOutputEvent: TDebugOutputEvent;
    FOSDbgClasses: TOSDbgClasses;
    FProcessID: Integer;
    FThreadID: Integer;
    FWatchPointData: TFpWatchPointData;
    FProcessConfig: TDbgProcessConfig;
    function GetDisassembler: TDbgAsmDecoder;
    function GetLastLibrariesLoaded: TDbgLibraryArr;
    function GetLastLibrariesUnloaded: TDbgLibraryArr;
    function GetPauseRequested: boolean;
    procedure SetPauseRequested(AValue: boolean);
    procedure ThreadDestroyed(const AThread: TDbgThread);
  protected
    FBreakpointList, FWatchPointList: TFpInternalBreakpointList;
    FCurrentBreakpoint: TFpInternalBreakpoint;  // set if we are executing the code at the break
                                         // if the singlestep is done, set the break again
    FCurrentWatchpoint: Pointer;         // Indicates the owner
    FReEnableBreakStep: Boolean;         // Set when we are reenabling a breakpoint
                                         // We need a single step, so the IP is after the break to set

    FSymInstances: TList;  // list of dbgInstances with debug info

    FThreadMap: TThreadMap; // map ThreadID -> ThreadObject
    FLibMap: TLibraryMap;    // map LibAddr -> LibObject
    FBreakMap: TBreakLocationMap;  // map BreakAddr -> BreakObject
    FPauseRequested: longint;

    FMainThread: TDbgThread;
    function GetHandle: THandle; virtual;
    procedure SetThreadId(AThreadId: Integer);
    procedure SetExitCode(AValue: DWord);
    function GetLastEventProcessIdentifier: THandle; virtual;
    function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
    procedure SetLastLibraryUnloaded(ALib: TDbgLibrary);
    procedure SetLastLibraryUnloadedNil(ALib: TDbgLibrary);
    procedure AddLibrary(ALib: TDbgLibrary; AnID: TDbgPtr);
    function GetRequiresExecutionInDebuggerThread: boolean; virtual;

    function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte; AMakeTempRemoved: Boolean): Boolean; virtual;
    function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; virtual;
    procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer); virtual;
    procedure AfterChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer); virtual;
    procedure AfterBreakpointAdded(ABreak: TFpDbgBreakpoint);

    procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
    // Should create a TDbgThread-instance for the given ThreadIdentifier.
    function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; virtual; abstract;
    // Should analyse why the debugger has stopped.
    function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;

    function CreateWatchPointData: TFpWatchPointData; virtual;
    procedure Init(const AProcessID, AThreadID: Integer);
    procedure InitializeLoaders; override;
  public
    class function isSupported(ATargetInfo: TTargetDescriptor): boolean; virtual;
    constructor Create(const AFileName: string; AnOsClasses: TOSDbgClasses;
                      AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig = nil); virtual;
    destructor Destroy; override;

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

    function  AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
    function  AddInternalBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload;
    (* ASymInstance: nil = anywhere / TDbgProcess or TDbgLibrary to limit *)
    function  AddBreak(const ALocation: TDBGPtr; AnEnabled: Boolean = True): TFpDbgBreakpoint; overload;
    function  AddBreak(const ALocation: TDBGPtrArray; AnEnabled: Boolean = True): TFpDbgBreakpoint; overload;
    function  AddBreak(const AFileName: String; ALine: Cardinal; AnEnabled: Boolean = True; ASymInstance: TDbgInstance = nil): TFpDbgBreakpoint; overload;
    function  AddBreak(const AFuncName: String; AnEnabled: Boolean = True; ASymInstance: TDbgInstance = nil): TFpDbgBreakpoint; overload;
    function  AddWatch(const ALocation: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind;
                      AScope: TDBGWatchPointScope): TFpInternalWatchpoint;
    property WatchPointData: TFpWatchPointData read FWatchPointData;
    (* FindProcSymbol(Address)
         Search the program and all libraries.
       FindProcSymbol(Name)
         Search ONLY the program.
       FindProcSymbol(Name, ASymInstance)
         Search ASymInstance (process or lib) / if nil, search all
         Names can be ambigious, as dll can have the same names.
    *)
    function  FindProcSymbol(const AName: String): TFpSymbol; overload; // deprecated 'backward compatible / use FindProcSymbol(AName, TheDbgProcess)';
    function  FindProcSymbol(const AName: String; ASymInstance: TDbgInstance): TFpSymbol; overload;
    procedure FindProcSymbol(const AName: String; ASymInstance: TDbgInstance; out ASymList: TFpSymbolArray);
    function  FindProcSymbol(const AName, ALibraryName: String; IsFullLibName: Boolean = True): TFpSymbol;  overload;
    function  FindProcSymbol(AAdress: TDbgPtr): TFpSymbol;  overload;
    function  FindSymbolScope(AThreadId, AStackFrame: Integer): TFpDbgSymbolScope;
    function  FindProcStartEndPC(const AAdress: TDbgPtr; out AStartPC, AEndPC: TDBGPtr): boolean;

    function  GetLineAddresses(AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray; ASymInstance: TDbgInstance = nil): Boolean;
    function  ContextFromProc(AThreadId, AStackFrame: Integer; AProcSym: TFpSymbol): TFpDbgLocationContext; inline; deprecated 'use TFpDbgSimpleLocationContext.Create';
    function  GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
    property  LibMap: TLibraryMap read FLibMap;
    property  LastLibrariesLoaded: TDbgLibraryArr read GetLastLibrariesLoaded;
    property  LastLibrariesUnloaded: TDbgLibraryArr read GetLastLibrariesUnloaded;
    procedure UpdateBreakpointsForLibraryLoaded(ALib: TDbgLibrary);
    procedure UpdateBreakpointsForLibraryUnloaded(ALib: TDbgLibrary);
    function  GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
    procedure RemoveBreak(const ABreakPoint: TFpDbgBreakpoint);
    procedure DoBeforeBreakLocationMapChange;
    function  HasBreak(const ALocation: TDbgPtr): Boolean; // TODO: remove, once an address can have many breakpoints
    procedure RemoveThread(const AID: DWord);
    function FormatAddress(const AAddress): String;
    function  Pause: boolean; virtual;

    function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; virtual;
    function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData; out APartSize: Cardinal): Boolean; virtual;
    function ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean; virtual;
    function ReadOrdinal(const AAdress: TDbgPtr; out AData): Boolean; virtual;
    function ReadString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: String): Boolean; virtual;
    function ReadWString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: WideString): Boolean; virtual;
    // Get the default location for parameters in default calling mode // Note functions may take result as argument
    function CallParamDefaultLocation(AParamIdx: Integer): TFpDbgMemLocation; virtual;

    //function LocationIsBreakInstructionCode(const ALocation: TDBGPtr): Boolean; // excludes TempRemoved
    procedure TempRemoveBreakInstructionCode(const ALocation: TDBGPtr);
    procedure RestoreTempBreakInstructionCodes;
    function HasInsertedBreakInstructionAtLocation(const ALocation: TDBGPtr): Boolean; // returns Int3, if there is no break at this location

    function CanContinueForWatchEval(ACurrentThread: TDbgThread): boolean; virtual;
    function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; virtual;
    function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; virtual; abstract;
    function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; virtual;

    // Remove (and free if applicable) all breakpoints for this process. When a
    // library is specified as OnlyForLibrary, only breakpoints that belong to this
    // library are cleared.
    procedure RemoveAllBreakPoints;

    function CheckForConsoleOutput(ATimeOutMs: integer): integer; virtual;
    function GetConsoleOutput: string; virtual;
    procedure SendConsoleInput(AString: string); virtual;

    procedure ClearAddedAndRemovedLibraries;
    procedure DoBeforeProcessLoop;
    function AddThread(AThreadIdentifier: THandle): TDbgThread;
    function GetThreadArray: TFPDThreadArray;
    procedure ThreadsBeforeContinue;
    procedure ThreadsClearCallStack;
    procedure LoadInfo; override;

    function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
    // Modify the debugee's code.
    function WriteInstructionCode(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;

    procedure TerminateProcess; virtual; abstract;
    function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual;

    property OSDbgClasses: TOSDbgClasses read FOSDbgClasses;
    property RequiresExecutionInDebuggerThread: boolean read GetRequiresExecutionInDebuggerThread;
    property Handle: THandle read GetHandle;
    property Name: String read FFileName write SetFileName;
    property ProcessID: integer read FProcessID;
    property ThreadID: integer read FThreadID;
    property ExitCode: DWord read FExitCode;
    property CurrentBreakpoint: TFpInternalBreakpoint read FCurrentBreakpoint;
    property CurrentWatchpoint: Pointer read FCurrentWatchpoint;
    property PauseRequested: boolean read GetPauseRequested write SetPauseRequested;
    function GetAndClearPauseRequested: Boolean;

    // Properties valid when last event was an deException
    property ExceptionMessage: string read FExceptionMessage write FExceptionMessage;
    property ExceptionClass: string read FExceptionClass write FExceptionClass;
    property OnDebugOutputEvent: TDebugOutputEvent read FOnDebugOutputEvent write FOnDebugOutputEvent;

    property LastEventProcessIdentifier: THandle read GetLastEventProcessIdentifier;
    property MainThread: TDbgThread read FMainThread;
    property GotExitProcess: Boolean read FGotExitProcess write FGotExitProcess;
    property Disassembler: TDbgAsmDecoder read GetDisassembler;
    property ThreadMap: TThreadMap read FThreadMap;
  end;
  TDbgProcessClass = class of TDbgProcess;

  { TFpWatchPointData }

  TFpWatchPointData = class
  private
    FChanged: Boolean;
  public
    function AddOwnedWatchpoint(AnOwner: Pointer; AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean; virtual;
    function RemoveOwnedWatchpoint(AnOwner: Pointer): boolean; virtual;
    property Changed: Boolean read FChanged write FChanged;
  end;

  { TFpIntelWatchPointData }

  TFpIntelWatchPointData = class(TFpWatchPointData)
  private
    // For Intel: Dr0..Dr3
    FOwners: array [0..3] of Pointer;
    FDr03: array [0..3] of TDBGPtr;
    FDr7: DWord;
    function GetDr03(AnIndex: Integer): TDBGPtr; inline;
    function GetOwner(AnIndex: Integer): Pointer; inline;
  public
    function AddOwnedWatchpoint(AnOwner: Pointer; AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean; override;
    function RemoveOwnedWatchpoint(AnOwner: Pointer): boolean; override;
    property Dr03[AnIndex: Integer]: TDBGPtr read GetDr03;
    property Dr7: DWord read FDr7;
    property Owner[AnIndex: Integer]: Pointer read GetOwner;
  end;

  { TOSDbgClasses }

  TOSDbgClasses = class
  public
    DbgProcessClass : TDbgProcessClass;
    DbgThreadClass : TDbgThreadClass;
    DbgDisassemblerClass : TDbgDisassemblerClass;
    constructor Create(
      ADbgProcessClass: TDbgProcessClass;
      ADbgThreadClass: TDbgThreadClass;
      ADbgDisassemblerClass: TDbgDisassemblerClass
    );
    function Equals(AnOther: TOSDbgClasses): Boolean;
  end;

const
  FPDEventNames: array[TFPDEvent] of string = (
    'deExitProcess', 'deCreateProcess',
    'deLoadLibrary', 'deUnloadLibrary',
    'deFinishedStep', 'deBreakpoint', 'deHardCodedBreakpoint',
    'deException',
    'deInternalContinue',
    'deFailed'
  );

function GetDbgProcessClass(ATargetInfo: TTargetDescriptor): TOSDbgClasses;

procedure RegisterDbgOsClasses(ADbgOsClasses: TOSDbgClasses);

implementation

uses
  FpDbgDwarfDataClasses,
  FpDbgDwarfCFI,
  FpDbgDwarf;

type
  TOSDbgClassesList = class(specialize TFPGObjectList<TOSDbgClasses>)
  public
    function Find(a: TOSDbgClasses): Integer;
  end;
var
  DBG_VERBOSE, DBG_WARNINGS, DBG_BREAKPOINTS, FPDBG_COMMANDS: PLazLoggerLogGroup;
  RegisteredDbgProcessClasses: TOSDbgClassesList;

function GetDbgProcessClass(ATargetInfo: TTargetDescriptor): TOSDbgClasses;
var
  i   : Integer;
begin
  for i := 0 to RegisteredDbgProcessClasses.Count - 1 do
  begin
    Result := RegisteredDbgProcessClasses[i];
    try
      if Result.DbgProcessClass.isSupported(ATargetInfo) then
        Exit;
    except
      on e: exception do
      begin
        //writeln('exception! WHY? ', e.Message);
      end;
    end;
  end;
  Result := nil;
end;

procedure RegisterDbgOsClasses(ADbgOsClasses: TOSDbgClasses);
begin
  if not Assigned(RegisteredDbgProcessClasses) then
    RegisteredDbgProcessClasses := TOSDbgClassesList.Create;
  if RegisteredDbgProcessClasses.Find(ADbgOsClasses) < 0 then // TODO: by content
    RegisteredDbgProcessClasses.Add(ADbgOsClasses);
end;

{ TFpDbgBreakpoint }

function TFpDbgBreakpoint.GetState: TFpDbgBreakpointState;
begin
  Result := bksUnknown;
end;

procedure TFpDbgBreakpoint.SetEnabled(AValue: boolean);
begin
  if AValue then
    SetBreak
  else
    ResetBreak;
end;

{ TDbgCallstackEntryList }

procedure TDbgCallstackEntryList.SetHasReadAllAvailableFrames;
begin
  FHasReadAllAvailableFrames := True;
end;

procedure TDbgCallstackEntryList.Clear;
begin
  inherited Clear;
  FHasReadAllAvailableFrames := False;
end;

{ TOSDbgClasses }

constructor TOSDbgClasses.Create(ADbgProcessClass: TDbgProcessClass;
  ADbgThreadClass: TDbgThreadClass;
  ADbgDisassemblerClass: TDbgDisassemblerClass);
begin
  DbgProcessClass      := ADbgProcessClass;
  DbgThreadClass       := ADbgThreadClass;
  DbgDisassemblerClass := ADbgDisassemblerClass;
end;

function TOSDbgClasses.Equals(AnOther: TOSDbgClasses): Boolean;
begin
  Result := (DbgThreadClass       = AnOther.DbgThreadClass) and
            (DbgProcessClass      = AnOther.DbgProcessClass) and
            (DbgDisassemblerClass = AnOther.DbgDisassemblerClass);
end;

{ TOSDbgClassesList }

function TOSDbgClassesList.Find(a: TOSDbgClasses): Integer;
begin
  Result := Count - 1;
  while (Result >= 0) and not (Items[Result].Equals(a)) do
    dec(Result);
end;

{ TThreadMapUnLockedEnumerator }

function TThreadMapUnLockedEnumerator.GetCurrent: TDbgThread;
begin
  GetData(Result);
end;

function TThreadMapUnLockedEnumerator.MoveNext: Boolean;
begin
  if FDoneFirst then
    Next
  else
    First;
  FDoneFirst := True;
  Result := not EOM;
end;

{ TThreadMapEnumerator }

function TThreadMapEnumerator.GetCurrent: TDbgThread;
begin
  GetData(Result);
end;

function TThreadMapEnumerator.MoveNext: Boolean;
begin
  if FDoneFirst then
    Next
  else
    First;
  FDoneFirst := True;
  Result := not EOM;
end;

{ TThreadMap }

function TThreadMap.GetEnumerator: TThreadMapEnumerator;
begin
  Result := TThreadMapEnumerator.Create(Self);
end;

{ TLibraryMapEnumerator }

function TLibraryMapEnumerator.GetCurrent: TDbgLibrary;
begin
  GetData(Result);
end;

function TLibraryMapEnumerator.MoveNext: Boolean;
begin
  if FDoneFirst then
    Next
  else
    First;
  FDoneFirst := True;
  Result := not EOM;
end;

{ TLibraryMap }

function TLibraryMap.GetEnumerator: TLibraryMapEnumerator;
begin
  Result := TLibraryMapEnumerator.Create(Self);
end;

procedure TLibraryMap.Add(const AId, AData);
begin
  inherited Add(AId, AData);
  FLibrariesAdded := Concat(FLibrariesAdded, [TDbgLibrary(AData)]);
end;

function TLibraryMap.Delete(const AId): Boolean;
var
  ALib: TDbgLibrary;
begin
  if GetData(AId, ALib) then
    FLibrariesRemoved := Concat(FLibrariesRemoved, [TDbgLibrary(ALib)]);
  Result := inherited Delete(AId);
end;

function TLibraryMap.GetLib(const AHandle: THandle; out ALib: TDbgLibrary
  ): Boolean;
var
  Iterator: TMapIterator;
  Lib: TDbgLibrary;
begin
  Result := False;
  Iterator := TMapIterator.Create(Self);
  while not Iterator.EOM do
  begin
    Iterator.GetData(Lib);
    Result := Lib.ModuleHandle = AHandle;
    if Result
    then begin
      ALib := Lib;
      Break;
    end;
    Iterator.Next;
  end;
  Iterator.Free;
end;

function TLibraryMap.GetLib(const AName: String; out ALib: TDbgLibrary;
  IsFullName: Boolean): Boolean;
var
  Iterator: TMapIterator;
  Lib: TDbgLibrary;
  s: String;
begin
  Result := False;
  Iterator := TMapIterator.Create(Self);
  while not Iterator.EOM do
  begin
    Iterator.GetData(Lib);
    if IsFullName then
      s := Lib.Name
    else
      s := ExtractFileName(Lib.Name);
    Result := CompareText(s, AName) = 0;
    if Result
    then begin
      ALib := Lib;
      Break;
    end;
    Iterator.Next;
  end;
  Iterator.Free;
end;

procedure TLibraryMap.ClearAddedAndRemovedLibraries;
var
  lib: TDbgLibrary;
begin
  for lib in FLibrariesRemoved do
    lib.Free;
  FLibrariesAdded := [];
  FLibrariesRemoved := [];
end;

{ TBreakLocationMap.TBreakLocationEntry }

function TBreakLocationMap.TBreakLocationEntry.OrigValue: Byte;
begin
  Result := TBreakLocationMap.OrigByteFromPointer(Data);
end;

function TBreakLocationMap.TBreakLocationEntry.ErrorSetting: ByteBool;
begin
  Result := TBreakLocationMap.ErrorSettingFromPointer(Data);
end;

{ TBreakLocationMap.TBreakLocationMapEnumerator }

function TBreakLocationMap.TBreakLocationMapEnumerator.GetCurrent: TBreakLocationEntry;
begin
  Result.Data := DataPtr;
  GetID(Result.Location);
end;

function TBreakLocationMap.TBreakLocationMapEnumerator.MoveNext: Boolean;
begin
  if FDoneFirst then
    Next
  else
    First;
  FDoneFirst := True;
  Result := not EOM;
end;

{ TBreakLocationMap }

procedure TBreakLocationMap.Clear;
var
  LocData: TBreakLocationEntry;
begin
  debugln(DBG_VERBOSE or DBG_BREAKPOINTS, ['TBreakLocationMap.Clear ']);
  for LocData in Self do begin
    if PInternalBreakLocationEntry(LocData.Data)^.IsBreakList then
      TFpInternalBreakpointArray(PInternalBreakLocationEntry(LocData.Data)^.InternalBreakPoint) := nil;
  end;
  inherited Clear;
end;

class function TBreakLocationMap.OrigByteFromPointer(AData: Pointer): Byte;
begin
  Result := PInternalBreakLocationEntry(AData)^.OrigValue;
end;

class function TBreakLocationMap.ErrorSettingFromPointer(AData: Pointer
  ): ByteBool;
begin
  Result := PInternalBreakLocationEntry(AData)^.ErrorSetting;
end;

constructor TBreakLocationMap.Create(AProcess: TDbgProcess);
begin
  FProcess := AProcess;
  inherited Create(itu8, SizeOf(TInternalBreakLocationEntry));
end;

destructor TBreakLocationMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TBreakLocationMap.AddLocation(const ALocation: TDBGPtr;
  const AInternalBreak: TFpInternalBreakpoint; AnIgnoreIfExists: Boolean);
var
  LocData: PInternalBreakLocationEntry;
  Len, i: Integer;
  BList: TFpInternalBreakpointArray;
  IsTempRemoved: Boolean;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.AddLocation');{$ENDIF}
  LocData := GetDataPtr(ALocation);

  if LocData <> nil then begin
    if LocData^.IsBreakList then begin
      Len := Length(TFpInternalBreakpointArray(LocData^.InternalBreakPoint));
      if AnIgnoreIfExists then begin
        i := Len - 1;
        while (i >= 0) and (TFpInternalBreakpointArray(LocData^.InternalBreakPoint)[i] <> AInternalBreak) do
          dec(i);
        if i >= 0 then
          exit;
      end;

      SetLength(TFpInternalBreakpointArray(LocData^.InternalBreakPoint), Len+1);
      TFpInternalBreakpointArray(LocData^.InternalBreakPoint)[Len] := AInternalBreak;
    end
    else begin
      if AnIgnoreIfExists and (TFpInternalBreakpoint(LocData^.InternalBreakPoint) = AInternalBreak) then
        exit;

      LocData^.IsBreakList := True;
      SetLength(BList, 2);
      BList[0] := TFpInternalBreakpoint(LocData^.InternalBreakPoint);
      BList[1] := AInternalBreak;
      LocData^.InternalBreakPoint := nil;
      TFpInternalBreakpointArray(LocData^.InternalBreakPoint) := BList;
    end;

    exit;
  end;

  // TODO: maybe remove, when TempRemoveBreakInstructionCode is called by "OS"Classes.Continue, which means no breakpoint can be set, while TempRemove are active
  IsTempRemoved := False;
  for i := 0 to high(FTmpRemovedBreaks) do begin
    IsTempRemoved := ALocation = FTmpRemovedBreaks[i];
    if IsTempRemoved then
      break;
  end;

  FProcess.DoBeforeBreakLocationMapChange; // Only if a new breakpoint is set => memory changed
  new(LocData);
  LocData^.ErrorSetting := not FProcess.InsertBreakInstructionCode(ALocation, LocData^.OrigValue, IsTempRemoved);
  LocData^.IsBreakList := False;
  LocData^.InternalBreakPoint := AInternalBreak;
  Add(ALocation, LocData^);
  Dispose(LocData);
end;

procedure TBreakLocationMap.RemoveLocation(const ALocation: TDBGPtr;
  const AInternalBreak: TFpInternalBreakpoint);
var
  LocData: PInternalBreakLocationEntry;
  Len, i: Integer;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.RemoveLocation');{$ENDIF}
  LocData := GetDataPtr(ALocation);
  if LocData = nil then begin
    DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]);
    exit;
  end;

  if LocData^.IsBreakList then begin
    Len := Length(TFpInternalBreakpointArray(LocData^.InternalBreakPoint));
    i := Len - 1;
    while (i >= 0) and (TFpInternalBreakpointArray(LocData^.InternalBreakPoint)[i] <> AInternalBreak) do
      dec(i);
    if i < 0 then begin
      DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Wrong break for loc ', FormatAddress(ALocation)]);
      exit;
    end;
    if i < Len - 1 then
      move(TFpInternalBreakpointArray(LocData^.InternalBreakPoint)[i+1],
           TFpInternalBreakpointArray(LocData^.InternalBreakPoint)[i],
           (Len - 1 - i) * sizeof(TFpInternalBreakpoint));
    SetLength(TFpInternalBreakpointArray(LocData^.InternalBreakPoint), Len-1);

    if Len > 1 then
      exit;
  end
  else
  if AInternalBreak <> TFpInternalBreakpoint(LocData^.InternalBreakPoint) then begin
    DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Wrong break for loc ', FormatAddress(ALocation)]);

    exit;
  end;

  FProcess.DoBeforeBreakLocationMapChange; // Only if a breakpoint is removed => memory changed
  if not LocData^.ErrorSetting then
    FProcess.RemoveBreakInstructionCode(ALocation, LocData^.OrigValue);
  Delete(ALocation);
end;

procedure TBreakLocationMap.UpdateMapForNewTargetCode(const AAdress: TDbgPtr;
  const ASize: Cardinal; const AData);
var
  i: Integer;
begin
  for i := 0 to ASize -1 do
    if HasInsertedBreakInstructionAtLocation(AAdress+i) then
      AdaptOriginalValueAtLocation(AAdress+i, PByte(@AData+i)^);
end;

function TBreakLocationMap.GetInternalBreaksAtLocation(const ALocation: TDBGPtr
  ): TFpInternalBreakpointArray;
var
  LocData: PInternalBreakLocationEntry;
begin
  LocData := GetDataPtr(ALocation);
  if LocData = nil then begin
    DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]);
    Result := nil;
    exit;
  end;

  if LocData^.IsBreakList then begin
    Result := TFpInternalBreakpointArray(LocData^.InternalBreakPoint)
  end
  else begin
    SetLength(Result, 1);
    Result[0] := TFpInternalBreakpoint(LocData^.InternalBreakPoint);
  end;
end;

function TBreakLocationMap.GetOrigValueAtLocation(const ALocation: TDBGPtr
  ): Byte;
var
  LocData: PInternalBreakLocationEntry;
begin
  LocData := GetDataPtr(ALocation);
  if LocData = nil then begin
    DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]);
    Result := Int3;
    exit;
  end;
  Result := LocData^.OrigValue;
end;

function TBreakLocationMap.HasInsertedBreakInstructionAtLocation(
  const ALocation: TDBGPtr): Boolean;
begin
  Result := GetDataPtr(ALocation) <> nil;
end;

function TBreakLocationMap.IsHardcodeBreakPoint(const ALocation: TDBGPtr
  ): Boolean;
begin
  Result := GetOrigValueAtLocation(ALocation) = Int3;
end;

function TBreakLocationMap.GetEnumerator: TBreakLocationMapEnumerator;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TBreakLocationMap.GetEnumerator');{$ENDIF}
  Result := TBreakLocationMapEnumerator.Create(Self);
end;

procedure TBreakLocationMap.TempRemoveBreakInstructionCode(
  const ALocation: TDBGPtr);
var
  OVal: Byte;
  l, i: Integer;
begin
  DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['>>> TempRemoveBreakInstructionCode']);
  l := length(FTmpRemovedBreaks);
  for i := 0 to l-1 do
    if FTmpRemovedBreaks[i] = ALocation then
      exit;

  OVal := GetOrigValueAtLocation(ALocation);
  if OVal = Int3 then
    exit;

  SetLength(FTmpRemovedBreaks, l+1);
  FTmpRemovedBreaks[l] := ALocation;
  FProcess.RemoveBreakInstructionCode(ALocation, OVal); // Do not update FBreakMap
  DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['<<< TempRemoveBreakInstructionCode']);
end;

procedure TBreakLocationMap.RestoreTempBreakInstructionCodes;
var
  OVal: Byte;
  t: array of TDBGPtr;
  i: Integer;
begin
  if Length(FTmpRemovedBreaks) = 0 then
    exit;
  DebugLnEnter(DBG_VERBOSE or DBG_BREAKPOINTS, ['>>> RestoreTempBreakInstructionCodes']);
  t := FTmpRemovedBreaks;
  FTmpRemovedBreaks := nil;
  for i := 0 to length(t) - 1 do
    if HasId(t[i]) then // may have been removed
      FProcess.InsertBreakInstructionCode(t[i], OVal, False);
  DebugLnExit(DBG_VERBOSE or DBG_BREAKPOINTS, ['<<< RestoreTempBreakInstructionCodes']);
end;

procedure TBreakLocationMap.MaskBreakpointsInReadData(const AAdress: TDbgPtr;
  const ASize: Cardinal; var AData);
var
  Brk: TBreakLocationEntry;
begin
  for Brk in Self do begin
    if (not Brk.ErrorSetting) and (Brk.Location >= AAdress) and (Brk.Location < (AAdress+ASize)) then
      PByte(@AData)[Brk.Location-AAdress] := Brk.OrigValue;
  end;
end;

procedure TBreakLocationMap.AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: Byte);
var
  LocData: PInternalBreakLocationEntry;
begin
  LocData := GetDataPtr(ALocation);
  if Assigned(LocData) then
    LocData^.OrigValue := NewOrigValue;
end;

{ TDbgCallstackEntry }

function TDbgCallstackEntry.GetProcSymbol: TFpSymbol;
begin
  if not FIsSymbolResolved then begin
    if (FIndex > 0) and (FAnAddress <> 0) then
      FSymbol := FThread.Process.FindProcSymbol(FAnAddress - 1) // -1 => inside the call instruction
    else
      FSymbol := FThread.Process.FindProcSymbol(FAnAddress);

    if FSymbol is TFpSymbolDwarfDataProc then
      FSymbol := TFpSymbolDwarfDataProc(FSymbol).ResolveInternalFinallySymbol(FThread.Process);


    FIsSymbolResolved := FSymbol <> nil
  end;
  result := FSymbol;
end;

function TDbgCallstackEntry.GetFunctionName: string;
var
  Symbol: TFpSymbol;
begin
  Symbol := GetProcSymbol;
  if assigned(Symbol) then begin
    if Symbol is TFpSymbolTableProc then begin
      if AnAddress > Symbol.Address.Address then
        result := Format('%s+%d', [Symbol.Name, AnAddress - Symbol.Address.Address])
      else
        result := Symbol.Name;
    end
    else
      result := Symbol.Name;
  end
  else
    result := '';
end;

function TDbgCallstackEntry.GetLine: integer;
var
  Symbol: TFpSymbol;
begin
  Symbol := GetProcSymbol;
  if assigned(Symbol) then
    result := Symbol.Line
  else
    result := -1;
end;

function TDbgCallstackEntry.GetSourceFile: string;
var
  Symbol: TFpSymbol;
begin
  Symbol := GetProcSymbol;
  if assigned(Symbol) then
    result := Symbol.FileName
  else
    result := '';
end;

function TDbgCallstackEntry.GetSrcClassName: string;
var
  Symbol: TFpSymbol;
begin
  result := '';
  Symbol := GetProcSymbol;
  if assigned(Symbol) then begin
    Symbol := Symbol.Parent;
    if assigned(Symbol) then begin
      result := Symbol.Name;
      Symbol.ReleaseReference;
    end;
  end;
end;

constructor TDbgCallstackEntry.create(AThread: TDbgThread; AnIndex: integer; AFrameAddress, AnAddress: TDBGPtr);
begin
  FThread := AThread;
  FFrameAdress:=AFrameAddress;
  FAnAddress:=AnAddress;
  FIndex:=AnIndex;
  FRegisterValueList := TDbgRegisterValueList.Create;
end;

destructor TDbgCallstackEntry.Destroy;
begin
  FreeAndNil(FRegisterValueList);
  ReleaseRefAndNil(FSymbol);
  inherited Destroy;
end;

{ TDbgMemReader }

function TDbgMemReader.GetDbgThread(AContext: TFpDbgLocationContext): TDbgThread;
var
  Process: TDbgProcess;
begin
  Process := GetDbgProcess;
  // In fact, AContext should always be assigned, assuming that the main thread
  // should be used is dangerous. But functions like TFpDbgMemManager.ReadSignedInt
  // have a default value of nil for the context. Which is a lot of work to fix.
  if not Assigned(AContext) or not Process.GetThread(AContext.ThreadId, Result) then
    Result := Process.MainThread;
end;

function TDbgMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
begin
  result := GetDbgProcess.ReadData(AnAddress, ASize, ADest^);
end;

function TDbgMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
  ADest: Pointer; out ABytesRead: Cardinal): Boolean;
begin
  result := GetDbgProcess.ReadData(AnAddress, ASize, ADest^, ABytesRead);
end;

function TDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
begin
  Assert(AnAddressSpace>0,'TDbgMemReader.ReadMemoryEx ignores AddressSpace');
  result := GetDbgProcess.ReadData(AnAddress, ASize, ADest^);
end;

function TDbgMemReader.WriteMemory(AnAddress: TDbgPtr; ASize: Cardinal;
  ASource: Pointer): Boolean;
begin
  result := GetDbgProcess.WriteData(AnAddress, ASize, ASource^);
end;

function TDbgMemReader.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean;
var
  ARegister: TDbgRegisterValue;
  StackFrame: Integer;
  AFrame: TDbgCallstackEntry;
  CtxThread: TDbgThread;
begin
  // TODO: Thread with ID
  result := false;
  CtxThread := GetDbgThread(AContext);
  if CtxThread = nil then
    exit;

  if AContext <> nil then // TODO: Always true?
    StackFrame := AContext.StackFrame
  else
    StackFrame := 0;
  if StackFrame = 0 then
    begin
    ARegister:=CtxThread.RegisterValueList.FindRegisterByDwarfIndex(ARegNum);
    end
  else
    begin
    CtxThread.PrepareCallStackEntryList(StackFrame+1);
    if CtxThread.CallStackEntryList.Count <= StackFrame then
      exit;
    AFrame := CtxThread.CallStackEntryList[StackFrame];
    if AFrame <> nil then
      ARegister:=AFrame.RegisterValueList.FindRegisterByDwarfIndex(ARegNum)
    else
      ARegister:=nil;
    end;
  if assigned(ARegister) then
    begin
    AValue := ARegister.NumValue;
    result := true;
    end;
end;

function TDbgMemReader.WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean;
var
  ARegister: TDbgRegisterValue;
  StackFrame: Integer;
  CtxThread: TDbgThread;
begin
  result := false;
  CtxThread := GetDbgThread(AContext);
  if CtxThread = nil then
    exit;

  if AContext <> nil then // TODO: Always true?
    StackFrame := AContext.StackFrame
  else
    StackFrame := 0;
  if StackFrame = 0 then
    begin
    ARegister:=CtxThread.RegisterValueList.FindRegisterByDwarfIndex(ARegNum);
    if assigned(ARegister) then
      begin
      CtxThread.SetRegisterValue(ARegister.Name, AValue);
      CtxThread.LoadRegisterValues;
      result := true;
      end;
    end
end;

function TDbgMemReader.RegisterSize(ARegNum: Cardinal): Integer;
var
  ARegister: TDbgRegisterValue;
begin
  ARegister:=GetDbgProcess.MainThread.RegisterValueList.FindRegisterByDwarfIndex(ARegNum);
  if assigned(ARegister) then
    result := ARegister.Size
  else
    result := sizeof(pointer);
end;

function TDbgMemReader.RegisterNumber(ARegName: String; out ARegNum: Cardinal
  ): Boolean;
var
  ARegister: TDbgRegisterValue;
  CtxThread: TDbgThread;
begin
  Result := False;
  CtxThread := GetDbgThread(nil);
  if CtxThread = nil then
    exit;

  ARegister:=CtxThread.RegisterValueList.FindRegisterByName(ARegName);
  Result := ARegister <> nil;
  if Result then
    ARegNum := ARegister.DwarfIdx;
end;

{ TDbgRegisterValueList }

function TDbgRegisterValueList.GetDbgRegister(AName: string
  ): TDbgRegisterValue;
var
  i: integer;
begin
  AName := UpperCase(AName);
  for i := 0 to Count -1 do
    if UpperCase(Items[i].Name)=AName then
      begin
      result := items[i];
      exit;
      end;
  result := nil;
end;

function TDbgRegisterValueList.GetDbgRegisterAutoCreate(const AName: string
  ): TDbgRegisterValue;
begin
  result := GetDbgRegister(AName);
  if not Assigned(result) then
    begin
    result := TDbgRegisterValue.Create(AName);
    add(result);
    end;
end;

function TDbgRegisterValueList.GetIsModified(AReg: TDbgRegisterValue): boolean;
begin
  Result := FPreviousRegisterValueList <> nil;
  if not Result then
    exit;

  Result := not FPreviousRegisterValueList.FindRegisterByDwarfIndex(AReg.DwarfIdx).HasEqualVal(AReg);
end;

procedure TDbgRegisterValueList.Assign(ASource: TDbgRegisterValueList);
var
  i: Integer;
  Dest: TDbgRegisterValue;
begin
  If Count > ASource.Count then
    Count := ASource.Count;
  Capacity := ASource.Count;

  for i := 0 to ASource.Count - 1 do begin
    if i >= Count then begin
      Dest := TDbgRegisterValue.Create('');
      Add(Dest);
    end
    else
      Dest := Items[i];
    Dest.Assign(ASource[i]);
  end;
end;

function TDbgRegisterValueList.FindRegisterByDwarfIndex(AnIdx: cardinal): TDbgRegisterValue;
var
  i: Integer;
begin
  for i := 0 to Count-1 do
    if Items[i].DwarfIdx=AnIdx then
    begin
      result := Items[i];
      exit;
    end;
  result := nil;
end;

function TDbgRegisterValueList.FindRegisterByName(AnName: String
  ): TDbgRegisterValue;
begin
  Result := GetDbgRegister(AnName);
end;

{ TDbgRegisterValue }

constructor TDbgRegisterValue.Create(const AName: String);
begin
  FName:=AName;
end;

procedure TDbgRegisterValue.Assign(ASource: TDbgRegisterValue);
begin
  FDwarfIdx := ASource.FDwarfIdx;
  FName     := ASource.FName;
  FNumValue := ASource.FNumValue;
  FSize     := ASource.FSize;
  FStrValue := ASource.FStrValue;
end;

function TDbgRegisterValue.HasEqualVal(AnOther: TDbgRegisterValue): Boolean;
begin
  Result :=
    (FNumValue = AnOther.FNumValue) and
    (FSize     = AnOther.FSize)     and
    (FStrValue = AnOther.FStrValue);
end;

procedure TDbgRegisterValue.SetValue(ANumValue: TDBGPtr;
  const AStrValue: string; ASize: byte; ADwarfIdx: cardinal);
begin
  FStrValue:=AStrValue;
  FNumValue:=ANumValue;
  FSize:=ASize;
  FDwarfIdx:=ADwarfIdx;
end;

procedure TDbgRegisterValue.Setx86EFlagsValue(ANumValue: TDBGPtr);
var
  FlagS: string;
begin
  FlagS := '';
  if ANumValue and (1 shl 0) <> 0 then FlagS := FlagS + 'CF ';
  if ANumValue and (1 shl 2) <> 0 then FlagS := FlagS + 'PF ';
  if ANumValue and (1 shl 4) <> 0 then FlagS := FlagS + 'AF ';
  if ANumValue and (1 shl 6) <> 0 then FlagS := FlagS + 'ZF ';
  if ANumValue and (1 shl 7) <> 0 then FlagS := FlagS + 'SF ';
  if ANumValue and (1 shl 8) <> 0 then FlagS := FlagS + 'TF ';
  if ANumValue and (1 shl 9) <> 0 then FlagS := FlagS + 'IF ';
  if ANumValue and (1 shl 10) <> 0 then FlagS := FlagS + 'DF ';
  if ANumValue and (1 shl 11) <> 0 then FlagS := FlagS + 'OF ';
  if (ANumValue shr 12) and 3 <> 0 then FlagS := FlagS + 'IOPL=' + IntToStr((ANumValue shr 12) and 3);
  if ANumValue and (1 shl 14) <> 0 then FlagS := FlagS + 'NT ';
  if ANumValue and (1 shl 16) <> 0 then FlagS := FlagS + 'RF ';
  if ANumValue and (1 shl 17) <> 0 then FlagS := FlagS + 'VM ';
  if ANumValue and (1 shl 18) <> 0 then FlagS := FlagS + 'AC ';
  if ANumValue and (1 shl 19) <> 0 then FlagS := FlagS + 'VIF ';
  if ANumValue and (1 shl 20) <> 0 then FlagS := FlagS + 'VIP ';
  if ANumValue and (1 shl 21) <> 0 then FlagS := FlagS + 'ID ';

  SetValue(ANumValue, trim(FlagS),4,Cardinal(-1));
end;

{ TDbgAsmInstruction }

function TDbgAsmInstruction.IsCallInstruction: boolean;
begin
  Result := False;
end;

function TDbgAsmInstruction.IsReturnInstruction: boolean;
begin
  Result := False;
end;

function TDbgAsmInstruction.IsLeaveStackFrame: boolean;
begin
  Result := False;
end;

function TDbgAsmInstruction.ModifiesStackPointer: boolean;
begin
  Result := False;
end;

function TDbgAsmInstruction.IsJumpInstruction(IncludeConditional: Boolean;
  IncludeUncoditional: Boolean): boolean;
begin
  Result := False;
end;

function TDbgAsmInstruction.InstructionLength: Integer;
begin
  Result := 0;
end;

{ TDbgAsmDecoder }

function TDbgAsmDecoder.GetLastErrorWasMemReadErr: Boolean;
begin
  Result := False;
end;

function TDbgAsmDecoder.GetCanReverseDisassemble: boolean;
begin
  Result := false;
end;

procedure TDbgAsmDecoder.Disassemble(var AAddress: Pointer; out
  ACodeBytes: String; out ACode: String; out AnInfo: TDbgInstInfo);
begin
  AnInfo := Default(TDbgInstInfo);
  Disassemble(AAddress, ACodeBytes, ACode);
end;

// Naive backwards scanner, decode MaxInstructionSize
// if pointer to next instruction matches, done!
// If not decrease instruction size and try again.
// Many pitfalls with X86 instruction encoding...
// Avr may give 130/65535 = 0.2% errors per instruction reverse decoded
procedure TDbgAsmDecoder.ReverseDisassemble(var AAddress: Pointer; out
  ACodeBytes: String; out ACode: String);
var
  instrLen: integer;
  tmpAddress: PtrUint;
begin
  // Decode max instruction length backwards,
  instrLen := MaxInstructionSize + MinInstructionSize;
  repeat
    dec(instrLen, MinInstructionSize);
    tmpAddress := PtrUInt(AAddress) - instrLen;
    Disassemble(pointer(tmpAddress), ACodeBytes, ACode);
  until (tmpAddress >= PtrUInt(AAddress)) or (instrLen = MinInstructionSize);

  // After disassemble tmpAddress points to the starting address of next instruction
  // Decrement with the instruction length to point to the start of this instruction
  AAddress := AAddress - instrLen;
end;

function TDbgAsmDecoder.GetFunctionFrameInfo(AnAddress: TDBGPtr; out
  AnIsOutsideFrame: Boolean): Boolean;
begin
  Result := False;
end;

function TDbgAsmDecoder.IsAfterCallInstruction(AnAddress: TDBGPtr): boolean;
begin
  Result := True; // if we don't know, then assume yes
end;

function TDbgAsmDecoder.UnwindFrame(var AnAddress, AStackPtr,
  AFramePtr: TDBGPtr; AQuick: boolean): boolean;
begin
  Result := False;
end;

{ TDbgInstance }


function TDbgInstance.FindProcSymbol(const AName: String): TFpSymbol;
begin
  if FDbgInfo <> nil then
    Result := FDbgInfo.FindProcSymbol(AName)
  else
    Result := nil;
  if (Result = nil) and (SymbolTableInfo <> nil) then
    Result := SymbolTableInfo.FindProcSymbol(AName);
end;

constructor TDbgInstance.Create(const AProcess: TDbgProcess);
begin
  FProcess := AProcess;
  FMemManager := AProcess.MemManager;
  FLoaderList := TDbgImageLoaderList.Create(True);

  inherited Create;
end;

destructor TDbgInstance.Destroy;
begin
  FreeAndNil(FDbgInfo);
  FreeAndNil(FSymbolTableInfo);
  FreeAndNil(FLoaderList);
  inherited;
end;

function TDbgInstance.GetLineAddresses(AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean;
var
  FoundLine: Integer;
begin
  if Assigned(DbgInfo) and DbgInfo.HasInfo then
    Result := DbgInfo.GetLineAddresses(AFileName, ALine, AResultList, fsNone, @FoundLine, @FLastLineAddressesFoundFile)
  else
    Result := False;
end;

function TDbgInstance.FindProcSymbol(AAdress: TDbgPtr): TFpSymbol;
var
  LI: TFpSymbol;
begin
  {$PUSH}{$R-}{$Q-}
  AAdress := AAdress;
  {$POP}
  Result := nil;
  LI := FDbgInfo.FindLineInfo(AAdress);
  if (LI <> nil) and (LI.Kind in [skFunction, skProcedure]) then begin
    Result := LI;
  end
  else begin
    Result := FSymbolTableInfo.FindProcSymbol(AAdress);
    if (Result <> nil) and (Result is TFpSymbolTableProc) then
      TFpSymbolTableProc(Result).SetLineSym(LI);
    LI.ReleaseReference;
  end;
end;

function TDbgInstance.FindProcStartEndPC(AAdress: TDbgPtr; out AStartPC,
  AEndPC: TDBGPtr): boolean;
begin
  {$PUSH}{$R-}{$Q-}
  AAdress := AAdress;
  {$POP}
  Result := FDbgInfo.FindProcStartEndPC(AAdress, AStartPC, AEndPC);
end;

function TDbgInstance.EnclosesAddress(AnAddress: TDBGPtr): Boolean;
begin
  Result := EnclosesAddressRange(AnAddress, AnAddress);
end;

function TDbgInstance.EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean;
begin
  Result := FLoaderList.EnclosesAddressRange(AStartAddress, AnEndAddress);
end;

procedure TDbgInstance.LoadInfo;
begin
  InitializeLoaders;
  if FLoaderList.TargetInfo.bitness = b64 then  //Image64Bit then
    FMode:=dm64
  else
    FMode:=dm32;
  FDbgInfo := TFpDwarfInfo.Create(FLoaderList, MemManager);
  TFpDwarfInfo(FDbgInfo).LoadCompilationUnits;
  if self is TDbgProcess then
    FSymbolTableInfo := TFpSymbolInfo.Create(FLoaderList, MemManager)
  else
    FSymbolTableInfo := TFpSymbolInfo.Create(FLoaderList, MemManager, ExtractFileNameOnly(FFileName));
  TFpDwarfInfo(FDbgInfo).LoadCallFrameInstructions;
end;

procedure TDbgInstance.SetFileName(const AValue: String);
begin
  FFileName := AValue;
end;

procedure TDbgInstance.SetMode(AMode: TFPDMode);
begin
  FMode := AMode;
end;

function TDbgInstance.GetPointerSize: Integer;
const
  PTRSZ: array[TFPDMode] of Integer = (4, 8); // (dm32, dm64)
begin
  Result := PTRSZ[FMode];
end;

function TDbgInstance.GetOSDbgClasses: TOSDbgClasses;
begin
  Result := FProcess.OSDbgClasses;
end;

procedure TDbgInstance.InitializeLoaders;
begin
  // Do nothing;
end;

{ TDbgLibrary }

constructor TDbgLibrary.Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle);

begin
  inherited Create(AProcess);
  FModuleHandle:=AModuleHandle;
end;

{ TDbgProcess }

function TDbgProcess.AddBreak(const ALocation: TDBGPtr; AnEnabled: Boolean
  ): TFpDbgBreakpoint;
var
  a: TDBGPtrArray;
begin
  SetLength(a, 1);
  a[0] := ALocation;
  Result := AddBreak(a, AnEnabled);
// TODO: if a = GetInstructionPointerRegisterValue (of any thread?)
end;

function TDbgProcess.AddBreak(const ALocation: TDBGPtrArray; AnEnabled: Boolean
  ): TFpDbgBreakpoint;
begin
  Result := TFpInternalBreakpoint.Create(Self, ALocation, AnEnabled);
  AfterBreakpointAdded(Result);
end;

function TDbgProcess.AddBreak(const AFileName: String; ALine: Cardinal;
  AnEnabled: Boolean; ASymInstance: TDbgInstance): TFpDbgBreakpoint;
begin
  Result := TFpInternalBreakpointAtFileLine.Create(Self, AFileName, ALine, AnEnabled, ASymInstance);
  AfterBreakpointAdded(Result);
end;

function TDbgProcess.AddBreak(const AFuncName: String; AnEnabled: Boolean;
  ASymInstance: TDbgInstance): TFpDbgBreakpoint;
begin
  Result := TFpInternalBreakpointAtSymbol.Create(Self, AFuncName, AnEnabled, ASymInstance);
  AfterBreakpointAdded(Result);
end;

function TDbgProcess.AddWatch(const ALocation: TDBGPtr; ASize: Cardinal;
  AReadWrite: TDBGWatchPointKind; AScope: TDBGWatchPointScope
  ): TFpInternalWatchpoint;
begin
  Result := TFpInternalWatchpoint.Create(Self, ALocation, ASize, AReadWrite, AScope);
end;

function TDbgProcess.FindProcSymbol(const AName: String; ASymInstance: TDbgInstance
  ): TFpSymbol;
var
  Lib: TDbgLibrary;
begin
  if ASymInstance <> nil then begin
    Result := ASymInstance.FindProcSymbol(AName);
  end
  else begin
    Result := FindProcSymbol(AName);
    if Result <> nil then
      exit;
    for Lib in FLibMap do begin
      Result := Lib.FindProcSymbol(AName);
      if Result <> nil then
        exit;
    end;
  end;
end;

procedure TDbgProcess.FindProcSymbol(const AName: String;
  ASymInstance: TDbgInstance; out ASymList: TFpSymbolArray);
var
  Lib: TDbgLibrary;
  Sym: TFpSymbol;
begin
  // TODO: find multiple symbols within the same DbgInfo
  ASymList := nil;
  if ASymInstance <> nil then begin
    Sym := ASymInstance.FindProcSymbol(AName);
    if Sym <> nil then begin
      SetLength(ASymList, 1);
      ASymList[0] := Sym;
    end;
  end
  else begin
    Sym := FindProcSymbol(AName);
    if Sym <> nil then begin
      SetLength(ASymList, 1);
      ASymList[0] := Sym;
    end;

    for Lib in FLibMap do begin
      Sym := Lib.FindProcSymbol(AName);
      if Sym <> nil then begin
        SetLength(ASymList, 1);
        ASymList[0] := Sym;
      end;
    end;
  end;
end;

function TDbgProcess.FindProcSymbol(const AName: String): TFpSymbol;
begin
  Result := inherited FindProcSymbol(AName);
end;

function TDbgProcess.FindProcSymbol(const AName, ALibraryName: String;
  IsFullLibName: Boolean): TFpSymbol;
var
  lib: TDbgLibrary;
begin
  Result := nil;
  if not FLibMap.GetLib(ALibraryName, lib, IsFullLibName) then
    exit;
  Result := lib.FindProcSymbol(AName);
end;

constructor TDbgProcess.Create(const AFileName: string; AnOsClasses: TOSDbgClasses;
  AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig);
const
  {.$IFDEF CPU64}
  MAP_ID_SIZE = itu8;
  {.$ELSE}
//  MAP_ID_SIZE = itu4;
  {.$ENDIF}
begin
  FMemManager := AMemManager;
  FProcessID := 0;
  FThreadID := 0;
  FOSDbgClasses := AnOsClasses;
  FProcessConfig := AProcessConfig;

  FBreakpointList := TFpInternalBreakpointList.Create(False);
  FWatchPointList := TFpInternalBreakpointList.Create(False);
  FThreadMap := TThreadMap.Create(itu4, SizeOf(TDbgThread));
  FLibMap := TLibraryMap.Create(MAP_ID_SIZE, SizeOf(TDbgLibrary));
  FWatchPointData := CreateWatchPointData;
  FBreakMap := TBreakLocationMap.Create(Self);
  FCurrentBreakpoint := nil;
  FCurrentWatchpoint := nil;

  FSymInstances := TList.Create;

  SetFileName(AFileName);

  inherited Create(Self);
end;

destructor TDbgProcess.Destroy;

  procedure FreeItemsInMap(AMap: TMap);
  var
    AnObject: TObject;
    Iterator: TMapIterator;
  begin
    iterator := TMapIterator.Create(AMap);
    try
      Iterator.First;
      while not Iterator.EOM do
      begin
        Iterator.GetData(AnObject);
        AnObject.Free;
        iterator.Next;
      end;
    finally
      Iterator.Free;
    end;
  end;

var
  i: Integer;
begin
  FProcessID:=0;
  SetLastLibraryUnloaded(nil);

  for i := 0 to FBreakpointList.Count - 1 do begin
    FBreakpointList[i].FProcess := nil;
    if FBreakpointList[i].FreeByDbgProcess then
      FBreakpointList[i].Free;
  end;
  for i := 0 to FWatchPointList.Count - 1 do begin
    FWatchPointList[i].FProcess := nil;
    if FWatchPointList[i].FreeByDbgProcess then
      FWatchPointList[i].Free;
  end;
  FreeAndNil(FBreakpointList);
  FreeAndNil(FWatchPointList);
  //Assert(FBreakMap.Count=0, 'No breakpoints left');
  //FreeItemsInMap(FBreakMap);
  FreeItemsInMap(FThreadMap);
  FreeItemsInMap(FLibMap);
  FLibMap.ClearAddedAndRemovedLibraries;

  FreeAndNil(FWatchPointData);
  FreeAndNil(FBreakMap);
  FreeAndNil(FThreadMap);
  FreeAndNil(FLibMap);
  FreeAndNil(FSymInstances);
  FreeAndNil(FDisassembler);
  inherited;
end;

function TDbgProcess.StartInstance(AParams, AnEnvironment: TStrings;
  AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; out
  AnError: TFpError): boolean;
begin
  DebugLn(DBG_VERBOSE, 'Debug support is not available for this platform.');
  result := false;
end;

function TDbgProcess.AttachToInstance(APid: Integer; out AnError: TFpError): boolean;
begin
  DebugLn(DBG_VERBOSE, 'Attach not supported');
  Result := false;
end;

function TDbgProcess.AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint;
begin
  Result := TFpInternalBreakpoint(AddBreak(ALocation));
  Result.FInternal := True;
end;

function TDbgProcess.AddInternalBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint;
begin
  Result := TFpInternalBreakpoint(AddBreak(ALocation));
  Result.FInternal := True;
end;

function TDbgProcess.FindProcSymbol(AAdress: TDbgPtr): TFpSymbol;
var
  n: Integer;
  Inst: TDbgInstance;
begin
  for n := 0 to FSymInstances.Count - 1 do
  begin
    Inst := TDbgInstance(FSymInstances[n]);
    Result := Inst.FindProcSymbol(AAdress);
    if Result <> nil then Exit;
  end;
  Result := nil;
end;

function TDbgProcess.FindSymbolScope(AThreadId, AStackFrame: Integer): TFpDbgSymbolScope;
var
  Thread: TDbgThread;
  Frame: TDbgCallstackEntry;
  Addr: TDBGPtr;
  Ctx: TFpDbgSimpleLocationContext;
  sym: TFpSymbol;
begin
  Result := nil;
  Ctx := nil;

  if GetThread(AThreadId, Thread) then begin
    Thread.PrepareCallStackEntryList(AStackFrame + 1);

    if AStackFrame < Thread.CallStackEntryList.Count then begin
      Frame := Thread.CallStackEntryList[AStackFrame];

      if Frame <> nil then begin
        Addr := Frame.AnAddress;
        Ctx := TFpDbgSimpleLocationContext.Create(MemManager, Addr, DBGPTRSIZE[Mode], AThreadId, AStackFrame);
        sym := Frame.ProcSymbol;
        if sym <> nil then
          Result := sym.CreateSymbolScope(Ctx);

        if Result = nil then begin
          if (Addr <> 0) or (FDbgInfo.TargetInfo.machineType = mtAVR8) then
            Result := FDbgInfo.FindSymbolScope(Ctx, Addr);
        end;
      end;
    end;

    // SymbolTableInfo.FindSymbolScope()
  end;

  if Result = nil then begin
    if Ctx = nil then
      Ctx := TFpDbgSimpleLocationContext.Create(MemManager, 0, DBGPTRSIZE[Mode], AThreadId, AStackFrame);
    Result := TFpDbgSymbolScope.Create(Ctx);
  end;

  Ctx.ReleaseReference;
end;

function TDbgProcess.FindProcStartEndPC(const AAdress: TDbgPtr; out AStartPC,
  AEndPC: TDBGPtr): boolean;
var
  n: Integer;
  Inst: TDbgInstance;
begin
  for n := 0 to FSymInstances.Count - 1 do
  begin
    Inst := TDbgInstance(FSymInstances[n]);
    Result := Inst.FindProcStartEndPC(AAdress, AStartPC, AEndPC);
    if Result then Exit;
  end;
end;

function TDbgProcess.GetLineAddresses(AFileName: String; ALine: Cardinal;
  var AResultList: TDBGPtrArray; ASymInstance: TDbgInstance): Boolean;
var
  Lib: TDbgLibrary;
begin
  if ASymInstance <> nil then begin
    if ASymInstance = self then begin
      Result := inherited GetLineAddresses(AFileName, ALine, AResultList);
    end
    else begin
      Result := ASymInstance.GetLineAddresses(AFileName, ALine, AResultList);
      FLastLineAddressesFoundFile := ASymInstance.FLastLineAddressesFoundFile;
    end;
    exit;
  end;

  Result := inherited GetLineAddresses(AFileName, ALine, AResultList);
  for Lib in FLibMap do begin
    if Lib.GetLineAddresses(AFileName, ALine, AResultList) then
      Result := True;
    if Lib.FLastLineAddressesFoundFile then
      FLastLineAddressesFoundFile := True;
  end;
end;

function TDbgProcess.ContextFromProc(AThreadId, AStackFrame: Integer;
  AProcSym: TFpSymbol): TFpDbgLocationContext;
begin
  Result := TFpDbgSimpleLocationContext.Create(MemManager, LocToAddrOrNil(AProcSym.Address), DBGPTRSIZE[Mode], AThreadId, AStackFrame);
end;

function TDbgProcess.GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
begin
  Result := FLibMap.GetLib(AHandle, ALib);
end;

procedure TDbgProcess.UpdateBreakpointsForLibraryLoaded(ALib: TDbgLibrary);
var
  i: Integer;
begin
  if (ALib.DbgInfo.HasInfo) or (ALib.SymbolTableInfo.HasInfo) then begin
    debugln(DBG_VERBOSE and (ALib.FBreakUpdateDone), ['TDbgProcess.UpdateBreakpointsForLibraryLoaded: Called twice for ', ALib.Name]);
    assert(not ALib.FBreakUpdateDone, 'TDbgProcess.UpdateBreakpointsForLibraryLoaded: not ALib.FBreakUpdateDone');
    if ALib.FBreakUpdateDone then
      exit;
    ALib.FBreakUpdateDone := True;
    debuglnEnter(DBG_BREAKPOINTS,['> TDbgProcess.UpdateBreakpointsForLibraryLoaded ',ALib.Name ]); try
    for i := 0 to FBreakpointList.Count - 1 do
      FBreakpointList[i].UpdateForLibraryLoaded(ALib);
    finally debuglnExit(DBG_BREAKPOINTS,['< TDbgProcess.UpdateBreakpointsForLibraryLoaded ' ]); end;
  end;
end;

procedure TDbgProcess.UpdateBreakpointsForLibraryUnloaded(ALib: TDbgLibrary);
var
  i: LongInt;
  b: TFpInternalBreakBase;
begin
  // The library is unloaded by the OS, so all breakpoints are already gone.
  // This is more to update our administration and free some memory.
  debuglnEnter(DBG_BREAKPOINTS, ['> TDbgProcess.UpdateBreakpointsForLibraryUnloaded ' ]); try if ALib <> nil then debugln(DBG_BREAKPOINTS, [ALib.Name]);
  i := FBreakpointList.Count - 1;
  while i >= 0 do begin
    b := FBreakpointList[i];
    b.UpdateForLibrareUnloaded(ALib);
    dec(i);
  end;
  i := FWatchPointList.Count - 1;
  while i >= 0 do begin
    b := FWatchPointList[i];
    b.UpdateForLibrareUnloaded(ALib);
    dec(i);
  end;
  finally debuglnExit(DBG_BREAKPOINTS,['< TDbgProcess.UpdateBreakpointsForLibraryUnloaded ' ]); end;
end;

function TDbgProcess.GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
var
  Thread: TDbgThread;
begin
  AThread := nil;
  Result := FThreadMap.GetData(AID, Thread) and (Thread <> nil);
  if Result
  then AThread := Thread;
end;

function TDbgProcess.ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean;
begin
  result := false
end;

function TDbgProcess.ReadData(const AAdress: TDbgPtr; const ASize: Cardinal;
  out AData; out APartSize: Cardinal): Boolean;
var
  SizeRemaining, sz: Cardinal;
  Offs: Integer;
  APartAddr: TDBGPtr;
  Dummy: QWord;
begin
  // subclasses can do better implementation if checking for error reasons, such as part_read
  APartSize := ASize;
  Result := ReadData(AAdress, APartSize, AData);
  if Result then
    exit;

  SizeRemaining := ASize;
  Offs := 0;
  APartAddr := AAdress;
  APartSize := 0;

  // check if the address is readable at all
  Result := ReadData(AAdress, 1, Dummy);
  if not Result then
    exit;

  while SizeRemaining > 0 do begin
    Result := False;
    sz := SizeRemaining;
    while (not Result) and (sz > 1) do begin
      sz := sz div 2;
      Result := ReadData(APartAddr, sz, (@AData + Offs)^);
    end;
    if not Result then
      break;

    APartSize := APartSize + sz;
    Offs := Offs + sz;
    APartAddr := APartAddr + sz;
    SizeRemaining := SizeRemaining - sz;
  end;

  Result := APartSize > 0;
end;

function TDbgProcess.ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean;
var
  dw: DWord;
  qw: QWord;
begin
  case Mode of
    dm32:
      begin
        result := ReadData(AAdress, sizeof(dw), dw);
        AData:=dw;
      end;
    dm64:
      begin
        result := ReadData(AAdress, sizeof(qw), qw);
        AData:=qw;
      end;
  end;
end;

function TDbgProcess.ReadOrdinal(const AAdress: TDbgPtr; out AData): Boolean;
begin
  Result := ReadData(AAdress, 4, AData);
end;

function TDbgProcess.ReadString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: String): Boolean;
begin
  Result := false;
end;

function TDbgProcess.ReadWString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: WideString): Boolean;
begin
  result := false;
end;

function TDbgProcess.CallParamDefaultLocation(AParamIdx: Integer
  ): TFpDbgMemLocation;
begin
  Result := InvalidLoc;
end;

function TDbgProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread;
  SingleStep: boolean): boolean;
begin
  result := false;
end;

function TDbgProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
var
  CurrentAddr: TDBGPtr;
begin
  if AThread <> nil then
    AThread.ValidateRemovedBreakPointInfo;
  result := AnalyseDebugEvent(AThread);

  if (result = deBreakpoint) and (AThread <> nil) then
  begin
    // Determine the address where the execution has stopped
    CurrentAddr:=AThread.GetInstructionPointerRegisterValue;
    FCurrentWatchpoint:=AThread.DetectHardwareWatchpoint;
    if (FCurrentWatchpoint <> nil) and (FWatchPointList.IndexOf(TFpInternalWatchpoint(FCurrentWatchpoint)) < 0) then
      FCurrentWatchpoint := Pointer(-1);
    FCurrentBreakpoint:=nil;
    AThread.NextIsSingleStep:=false;

    // Whatever reason there was to change the result to deInternalContinue,
    // if a breakpoint has been hit, always trigger it...
    if DoBreak(CurrentAddr, AThread.ID) then
      result := deBreakpoint;
  end
end;

function TDbgProcess.CheckForConsoleOutput(ATimeOutMs: integer): integer;
begin
  result := -1;
end;

function TDbgProcess.GetConsoleOutput: string;
begin
  result := '';
end;

procedure TDbgProcess.SendConsoleInput(AString: string);
begin
  // Do nothing
end;

procedure TDbgProcess.ClearAddedAndRemovedLibraries;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.ClearAddedAndRemovedLibraries');{$ENDIF}
  FLibMap.ClearAddedAndRemovedLibraries;
end;

procedure TDbgProcess.DoBeforeProcessLoop;
var
  t: TDbgThread;
begin
  ClearAddedAndRemovedLibraries;

  for t in FThreadMap do
    t.DoBeforeProcessLoop;
end;

function TDbgProcess.AddThread(AThreadIdentifier: THandle): TDbgThread;
var
  IsMainThread: boolean;
begin
  result := CreateThread(AthreadIdentifier, IsMainThread);
  if assigned(result) then
  begin
    FThreadMap.Add(AThreadIdentifier, Result);
    if IsMainThread then
    begin
      assert(FMainThread=nil);
      FMainThread := result;
    end;
    Result.ApplyWatchPoints(FWatchPointData);
  end
  else
    DebugLn(DBG_WARNINGS, 'Unknown thread ID %u for process %u', [AThreadIdentifier, ProcessID]);
end;

function TDbgProcess.GetThreadArray: TFPDThreadArray;
var
  Iterator: TMapIterator;
  Thread: TDbgThread;
  I: Integer;
begin
  SetLength(Result, FThreadMap.Count);
  Iterator := TMapIterator.Create(FThreadMap);
  try
    Iterator.First;
    I := 0;
    while not Iterator.EOM do
    begin
      Iterator.GetData(Thread);
      Result[I] := Thread;
      Inc(I);
      iterator.Next;
    end;
  finally
    Iterator.Free;
  end;
end;

procedure TDbgProcess.ThreadsBeforeContinue;
var
  Iterator: TMapIterator;
  Thread: TDbgThread;
begin
  Iterator := TLockedMapIterator.Create(FThreadMap);
  try
    Iterator.First;
    while not Iterator.EOM do
    begin
      Iterator.GetData(Thread);
      if FWatchPointData.Changed then
        Thread.ApplyWatchPoints(FWatchPointData);
      Thread.BeforeContinue;
      iterator.Next;
    end;
  finally
    Iterator.Free;
  end;
  FWatchPointData.Changed := False;
end;

procedure TDbgProcess.ThreadsClearCallStack;
var
  Iterator: TMapIterator;
  Thread: TDbgThread;
begin
  Iterator := TLockedMapIterator.Create(FThreadMap);
  try
    Iterator.First;
    while not Iterator.EOM do
    begin
      Iterator.GetData(Thread);
      Thread.ClearCallStack;
      iterator.Next;
    end;
  finally
    Iterator.Free;
  end;
end;

procedure TDbgProcess.RemoveBreak(const ABreakPoint: TFpDbgBreakpoint);
begin
  if ABreakPoint=FCurrentBreakpoint then
    FCurrentBreakpoint := nil;
end;

procedure TDbgProcess.DoBeforeBreakLocationMapChange;
var
  t: TDbgThread;
begin
  for t in FThreadMap do
    t.DoBeforeBreakLocationMapChange;
end;

function TDbgProcess.HasBreak(const ALocation: TDbgPtr): Boolean;
begin
  if FBreakMap = nil then
    Result := False
  else
    result := FBreakMap.HasId(ALocation);
end;

procedure TDbgProcess.RemoveThread(const AID: DWord);
begin
  if FThreadMap = nil then Exit;
  FThreadMap.Delete(AID);
end;

function TDbgProcess.FormatAddress(const AAddress): String;
begin
  Result := HexValue(AAddress, DBGPTRSIZE[Mode], [hvfIncludeHexchar]);
end;

function TDbgProcess.Pause: boolean;
begin
  result := false;
end;

function TDbgProcess.GetHandle: THandle;
begin
  result := 0;
end;

procedure TDbgProcess.SetThreadId(AThreadId: Integer);
begin
  assert(FThreadID = 0, 'TDbgProcess.SetThreadId: FThreadID = 0');
  FThreadID := AThreadId;
end;

procedure TDbgProcess.SetExitCode(AValue: DWord);
begin
  FExitCode:=AValue;
end;

class function TDbgProcess.isSupported(ATargetInfo: TTargetDescriptor): boolean;
begin
  result := false;
end;

procedure TDbgProcess.ThreadDestroyed(const AThread: TDbgThread);
begin
  if AThread = FMainThread
  then FMainThread := nil;
end;

function TDbgProcess.GetPauseRequested: boolean;
begin
  Result := Boolean(InterLockedExchangeAdd(FPauseRequested, 0));
end;

function TDbgProcess.GetRequiresExecutionInDebuggerThread: boolean;
begin
  Result := False;
end;

function TDbgProcess.GetDisassembler: TDbgAsmDecoder;
begin
  if FDisassembler = nil then
    FDisassembler := OSDbgClasses.DbgDisassemblerClass.Create(Self);
  Result := FDisassembler;
end;

function TDbgProcess.GetLastLibrariesLoaded: TDbgLibraryArr;
begin
  Result := FLibMap.FLibrariesAdded;
end;

function TDbgProcess.GetLastLibrariesUnloaded: TDbgLibraryArr;
begin
  Result := FLibMap.FLibrariesRemoved;
end;

function TDbgProcess.GetAndClearPauseRequested: Boolean;
begin
  Result := Boolean(InterLockedExchange(FPauseRequested, ord(False)));
end;

procedure TDbgProcess.SetPauseRequested(AValue: boolean);
begin
  InterLockedExchange(FPauseRequested, ord(AValue));
end;

procedure TDbgProcess.LoadInfo;
begin
  inherited LoadInfo;

  if DbgInfo.HasInfo then
    FSymInstances.Add(Self);
end;

procedure TDbgProcess.InitializeLoaders;
begin
  inherited InitializeLoaders;
end;

function TDbgProcess.GetLastEventProcessIdentifier: THandle;
begin
  result := 0;
end;

function TDbgProcess.DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
var
  BList: TFpInternalBreakpointArray;
  i: Integer;
begin
  Result := False;

  BList := FBreakMap.GetInternalBreaksAtLocation(BreakpointAddress);
  if BList = nil then exit;
  i := 0;
  FCurrentBreakpoint := nil;
  while (i < Length(BList)) and (FCurrentBreakpoint = nil) do
    if BList[0].FInternal then
      inc(i)
    else
      FCurrentBreakpoint := BList[i];
  if FCurrentBreakpoint = nil then Exit;

  Result := True;
  if not FCurrentBreakpoint.Hit(AThreadId, BreakpointAddress)
  then FCurrentBreakpoint := nil; // no need for a singlestep if we continue
end;

procedure TDbgProcess.SetLastLibraryUnloaded(ALib: TDbgLibrary);
begin
  if FLastLibraryUnloaded <> nil then
    FLastLibraryUnloaded.Destroy;
  FLastLibraryUnloaded := ALib;
end;

procedure TDbgProcess.SetLastLibraryUnloadedNil(ALib: TDbgLibrary);
begin
  assert(ALib = nil, 'TDbgProcess.SetLastLibraryUnloadedNil: ALib = nil');
  SetLastLibraryUnloaded(nil);
end;

procedure TDbgProcess.AddLibrary(ALib: TDbgLibrary; AnID: TDbgPtr);
begin
  if FLibMap.HasId(AnID) then begin
    debugln(DBG_VERBOSE or DBG_WARNINGS, ['Error: Attempt to add duplicate library ', AnID]);
    exit;
  end;
  FLibMap.Add(AnID, ALib);

  if (ALib.DbgInfo.HasInfo) or (ALib.SymbolTableInfo.HasInfo) then
    FSymInstances.Add(ALib);
end;

function TDbgProcess.InsertBreakInstructionCode(const ALocation: TDBGPtr; out
  OrigValue: Byte; AMakeTempRemoved: Boolean): Boolean;
begin
  Result := FProcess.ReadData(ALocation, 1, OrigValue);
  if not Result then begin
    DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, 'Unable to read pre-breakpoint at '+FormatAddress(ALocation));
    exit;
  end;

  if (OrigValue = Int3) or AMakeTempRemoved then
    exit; // breakpoint on a hardcoded breakpoint

  BeforeChangingInstructionCode(ALocation, 1);

  Result := FProcess.WriteData(ALocation, 1, Int3);
  DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['Breakpoint Int3 set to '+FormatAddress(ALocation), ' Result:',Result, ' OVal:', OrigValue]);
  if not Result then
    DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, 'Unable to set breakpoint at '+FormatAddress(ALocation));

  if Result then
    AfterChangingInstructionCode(ALocation, 1);
end;

function TDbgProcess.RemoveBreakInstructionCode(const ALocation: TDBGPtr;
  const OrigValue: Byte): Boolean;
begin
  if OrigValue = Int3 then
    exit(True); // breakpoint on a hardcoded breakpoint

  BeforeChangingInstructionCode(ALocation, 1);

  Result := WriteData(ALocation, 1, OrigValue);
  DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['Breakpoint Int3 removed from '+FormatAddress(ALocation), ' Result:',Result, ' OVal:', OrigValue]);
  DebugLn((not Result) and (not GotExitProcess) and (DBG_WARNINGS or DBG_BREAKPOINTS), 'Unable to reset breakpoint at %s', [FormatAddress(ALocation)]);

  if Result then
    AfterChangingInstructionCode(ALocation, 1);
end;

procedure TDbgProcess.RemoveAllBreakPoints;
var
  i: LongInt;
  b: TFpInternalBreakBase;
begin
  i := FBreakpointList.Count - 1;
  while i >= 0 do begin
    b := FBreakpointList[i];
    b.ResetBreak;
    b.FProcess := nil;
    FBreakpointList.Delete(i);
    dec(i);
  end;
  i := FWatchPointList.Count - 1;
  while i >= 0 do begin
    b := FWatchPointList[i];
    b.ResetBreak;
    b.FProcess := nil;
    FWatchPointList.Delete(i);
    dec(i);
  end;
end;

procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer);
begin
  //
end;

procedure TDbgProcess.AfterChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer);
begin
  //
end;

procedure TDbgProcess.AfterBreakpointAdded(ABreak: TFpDbgBreakpoint);
begin
  if not assigned(FCurrentBreakpoint) then begin
    if ABreak.HasLocation(FMainThread.GetInstructionPointerRegisterValue) then
      FCurrentBreakpoint := TFpInternalBreakpoint(ABreak);
  end;
end;

//function TDbgProcess.LocationIsBreakInstructionCode(const ALocation: TDBGPtr
//  ): Boolean;
//var
//  OVal: Byte;
//begin
//  Result := FBreakMap.HasId(ALocation);
//  if not Result then
//    exit;
//
//  Result := FProcess.ReadData(ALocation, 1, OVal);
//  if Result then
//    Result := OVal = Int3
//  else
//    DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS'Unable to read pre-breakpoint at '+FormatAddress(ALocation));
//end;

procedure TDbgProcess.TempRemoveBreakInstructionCode(const ALocation: TDBGPtr);
begin
  FBreakMap.TempRemoveBreakInstructionCode(ALocation);
end;

procedure TDbgProcess.RestoreTempBreakInstructionCodes;
begin
  FBreakMap.RestoreTempBreakInstructionCodes;
end;

function TDbgProcess.HasInsertedBreakInstructionAtLocation(
  const ALocation: TDBGPtr): Boolean;
begin
  Result := FBreakMap.HasInsertedBreakInstructionAtLocation(ALocation);
end;

function TDbgProcess.CanContinueForWatchEval(ACurrentThread: TDbgThread
  ): boolean;
begin
  Result := True;
end;

procedure TDbgProcess.MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
begin
  if FBreakMap <> nil then
    FBreakMap.MaskBreakpointsInReadData(AAdress, ASize, AData);
end;

function TDbgProcess.CreateWatchPointData: TFpWatchPointData;
begin
  Result := TFpWatchPointData.Create;
end;

procedure TDbgProcess.Init(const AProcessID, AThreadID: Integer);
begin
  FProcessID := AProcessID;
  FThreadID := AThreadID;
end;

function TDbgProcess.WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean;
begin
  result := false;
end;

function TDbgProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread
  ): boolean;
begin
  Result := False;
end;

function TDbgProcess.WriteInstructionCode(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean;
begin
  FBreakMap.UpdateMapForNewTargetCode(AAdress, ASize, AData);
  BeforeChangingInstructionCode(AAdress, ASize);
  Result := WriteData(AAdress, ASize, AData);
  AfterChangingInstructionCode(AAdress, ASize);
end;


{ TDbgStackFrameInfo }

procedure TDbgStackFrameInfo.DoAfterRun;
var
  CurStackFrame: TDBGPtr;
begin
  FProcessAfterRun := False;
  case FLeaveState of
    lsWasAtLeave1: begin
        CurStackFrame   := FThread.GetStackBasePointerRegisterValue;
        FStoredStackPointer := FThread.GetStackPointerRegisterValue;
        if CurStackFrame <> FStoredStackFrame then
          FLeaveState := lsLeaveDone // real leave
        else
          FLeaveState := lsWasAtLeave2; // lea rsp,[rbp+$00] / pop ebp // epb in next command
      end;
    lsWasAtLeave2: begin
        // TODO: maybe check, if stackpointer only goes down by sizeof(pointer) "Pop bp"
        FStoredStackFrame   := FThread.GetStackBasePointerRegisterValue;
        FStoredStackPointer := FThread.GetStackPointerRegisterValue;
        FLeaveState := lsLeaveDone;
      end;
  end;
end;

procedure TDbgStackFrameInfo.DoCheckNextInstruction(
  ANextInstruction: TDbgAsmInstruction; NextIsSingleStep: Boolean);
begin
  if FProcessAfterRun then
    DoAfterRun;

  if not NextIsSingleStep then begin
    if FLeaveState = lsWasAtLeave2 then
      FLeaveState := lsLeaveDone;
    exit;
  end;

  if ANextInstruction.IsReturnInstruction then begin
    FHasSteppedOut := True;
    FLeaveState := lsLeaveDone;
  end
  else if FLeaveState = lsNone then begin
    if ANextInstruction.IsLeaveStackFrame then
      FLeaveState := lsWasAtLeave1;
  end;

  FProcessAfterRun := FLeaveState in [lsWasAtLeave1, lsWasAtLeave2];
end;

function TDbgStackFrameInfo.CalculateHasSteppedOut: Boolean;
var
  CurBp, CurSp: TDBGPtr;
begin
  if FProcessAfterRun then
    DoAfterRun;

  Result := False;
  CurBp := FThread.GetStackBasePointerRegisterValue;
  if FStoredStackFrame < CurBp then begin
    CurSp := FThread.GetStackPointerRegisterValue;
    if FStoredStackPointer >= CurSp then // this happens, if current was recorded before the BP frame was set up // a finally handle may then fake an outer frame
      exit;
//    {$PUSH}{$Q-}{$R-}
//    if CurSp = FStoredStackPointer + FThread.Process.PointerSize then
//      exit; // Still in proc, but passed asm "leave" (BP has been popped, but IP not yet)
//    {$POP}
    Result := True;
    debugln(FPDBG_COMMANDS, ['BreakStepBaseCmd.GetIsSteppedOut: Has stepped out Stored-BP=', FStoredStackFrame, ' < BP=', CurBp, ' / SP', CurSp]);
  end;
end;

constructor TDbgStackFrameInfo.Create(AThread: TDbgThread);
begin
  FThread := AThread;
  FStoredStackFrame   := AThread.GetStackBasePointerRegisterValue;
  FStoredStackPointer := AThread.GetStackPointerRegisterValue;
end;

procedure TDbgStackFrameInfo.CheckNextInstruction(
  ANextInstruction: TDbgAsmInstruction; NextIsSingleStep: Boolean);
begin
  if not FHasSteppedOut then
    DoCheckNextInstruction(ANextInstruction, NextIsSingleStep);
end;

function TDbgStackFrameInfo.HasSteppedOut: Boolean;
begin
  Result := FHasSteppedOut;
  if Result then
    exit;
  FHasSteppedOut := CalculateHasSteppedOut;
  Result := FHasSteppedOut;
end;

procedure TDbgStackFrameInfo.FlagAsSteppedOut;
begin
  FHasSteppedOut := True;
end;

{ TDbgThread }

function TDbgThread.GetRegisterValueList: TDbgRegisterValueList;
begin
  if not FRegisterValueListValid then
    LoadRegisterValues;
  result := FRegisterValueList;
end;

function TDbgThread.CompareStepInfo(AnAddr: TDBGPtr; ASubLine: Boolean
  ): TFPDCompareStepInfo;
var
  Sym: TFpSymbol;
  l: TDBGPtr;
begin
  if FStoreStepSrcLineNo = -1 then begin // stepping from location with no line info
    Result := dcsiNewLine;
    exit;
  end;

  if AnAddr = 0 then
    AnAddr := GetInstructionPointerRegisterValue;

  if (FStoreStepStartAddr <> 0) then begin
    if (AnAddr > FStoreStepStartAddr) and (AnAddr < FStoreStepEndAddr)
    then begin
      result := dcsiSameLine;
      exit;
    end
    else
    if ASubLine then begin
      // this is used for the (unmarked) proloque of finally handlers in 3.1.1
      result := dcsiNewLine; // may have the same line number, but has a new address block
      exit;
    end;
  end;

  sym := FProcess.FindProcSymbol(AnAddr);
  if assigned(sym) then
  begin
    if sym is TFpSymbolDwarfDataProc then
      l := TFpSymbolDwarfDataProc(sym).LineUnfixed
    else
      l := Sym.Line;
    debugln(FPDBG_COMMANDS, ['CompareStepInfo @IP=',AnAddr,' ',sym.FileName, ':',l, ' in ',sym.Name, ' @Func=',sym.Address.Address]);
    if (((FStoreStepSrcFilename=sym.FileName) and (FStoreStepSrcLineNo=l)) {or FStepOut}) then
      result := dcsiSameLine
    else if sym.FileName = '' then
      result := dcsiNoLineInfo
    else if l = 0 then
      result := dcsiZeroLine
    else
      result := dcsiNewLine;
    sym.ReleaseReference;
  end
  else
    result := dcsiNoLineInfo;
end;

function TDbgThread.IsAtStartOfLine: boolean;
var
  AnAddr, b: TDBGPtr;
  Sym: TFpSymbol;
  CU: TDwarfCompilationUnit;
  a: TDBGPtrArray;
begin
  AnAddr := GetInstructionPointerRegisterValue;
  sym := FProcess.FindProcSymbol(AnAddr);
  if (sym is TDbgDwarfSymbolBase) then
  begin
    CU := TDbgDwarfSymbolBase(sym).CompilationUnit;
    Result := False;
    CU.GetLineAddresses(sym.FileName, sym.Line, a);
    for b in a do begin
      Result := b = AnAddr;
      if Result then break;
    end;
  end
  else
    Result := True;
  sym.ReleaseReference;
end;

procedure TDbgThread.StoreStepInfo(AnAddr: TDBGPtr);
var
  Sym: TFpSymbol;
begin
  if AnAddr = 0 then
    AnAddr := GetInstructionPointerRegisterValue;
  sym := FProcess.FindProcSymbol(AnAddr);
  FStoreStepStartAddr := AnAddr;
  FStoreStepEndAddr := AnAddr;
  if assigned(sym) then
  begin
    FStoreStepSrcFilename:=sym.FileName;
    FStoreStepFuncAddr:=sym.Address.Address;
    FStoreStepFuncName:=sym.Name;
    if sfHasLineAddrRng in sym.Flags then begin
      FStoreStepStartAddr := sym.LineStartAddress;
      FStoreStepEndAddr := sym.LineEndAddress;
    end;
    if sym is TFpSymbolDwarfDataProc then begin
      FStoreStepSrcLineNo := TFpSymbolDwarfDataProc(sym).LineUnfixed;
    end
    else
      FStoreStepSrcLineNo:=sym.Line;
    debugln(FPDBG_COMMANDS, ['StoreStepInfo @IP=',AnAddr,' ',sym.FileName, ':',FStoreStepSrcLineNo, ' in ',sym.Name, ' @Func=',sym.Address.Address]);
    sym.ReleaseReference;
  end
  else begin
    debugln(FPDBG_COMMANDS, ['StoreStepInfo @IP=',AnAddr,' - No symbol']);
    FStoreStepSrcLineNo:=-1;
  end;
end;

procedure TDbgThread.LoadRegisterValues;
begin
  // Do nothing
end;

procedure TDbgThread.DoBeforeBreakLocationMapChange;
var
  t: TDBGPtr;
begin
  if (FPausedAtRemovedBreakPointState <> rbUnknown) and
     (FPausedAtRemovedBreakPointAddress = GetInstructionPointerRegisterValue) then
    exit;

  t := GetInstructionPointerRegisterValue;
  if (t <> 0) and Process.HasInsertedBreakInstructionAtLocation(t - 1) then begin
  (* There is a chance, that the code jumped to this Addr, instead of executing the breakpoint.
     But if the next signal for this thread is a breakpoint at this address, then
     it must be handled (even if the breakpoint has been removed since)
  *)
    FPausedAtRemovedBreakPointAddress := t;
    FPausedAtRemovedBreakPointState := rbFound;
    // Most likely the debugger should see the previous address (unless we got here
    // by jump.
    // Call something like ResetInstructionPointerAfterBreakpointForPendingSignal; virtual;
    ////ResetInstructionPointerAfterBreakpoint;
  end
  else
    FPausedAtRemovedBreakPointState := rbNone;
end;

procedure TDbgThread.ValidateRemovedBreakPointInfo;
begin
  if (FPausedAtRemovedBreakPointState <> rbUnknown) and
     (FPausedAtRemovedBreakPointAddress <> GetInstructionPointerRegisterValue)
  then
    FPausedAtRemovedBreakPointState := rbUnknown;
end;

function TDbgThread.GetName: String;
begin
  Result := 'Thread ' + IntToStr(FID);
end;

constructor TDbgThread.Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle);
begin
  FID := AID;
  FHandle := AHandle;
  FProcess := AProcess;
  FRegisterValueList:=TDbgRegisterValueList.Create;
  FPreviousRegisterValueList:=TDbgRegisterValueList.Create;
  inherited Create;
end;

procedure TDbgThread.DoBeforeProcessLoop;
begin
  FPreviousRegisterValueList.Assign(FRegisterValueList);
  if FRegisterValueListValid then
    FRegisterValueList.FPreviousRegisterValueList := FPreviousRegisterValueList
  else
    FRegisterValueList.FPreviousRegisterValueList := nil;
  FRegisterValueListValid:=false;
end;

function TDbgThread.HasInsertedBreakInstructionAtLocation(const ALocation: TDBGPtr): Boolean;
var
  t: TDBGPtr;
begin
  t := GetInstructionPointerRegisterValue;
  Result := ( (FPausedAtRemovedBreakPointState = rbFound) and
              (FPausedAtRemovedBreakPointAddress = t) ) or
            ( (t <> 0) and Process.HasInsertedBreakInstructionAtLocation(t - 1) );
end;

procedure TDbgThread.CheckAndResetInstructionPointerAfterBreakpoint;
var
  t: TDBGPtr;
  OVal: Byte;
begin
  // todo: check that the breakpoint is NOT in the temp removed list
  t := GetInstructionPointerRegisterValue;
  if t = 0 then
    exit;
  if HasInsertedBreakInstructionAtLocation(t - 1)
  then begin
    FPausedAtRemovedBreakPointState := rbFound;
    ResetInstructionPointerAfterBreakpoint;
  end
  else begin
    // TODO: allow to skip this, while detaching
    if FProcess.ReadData(t-1, 1, OVal) then
      FPausedAtHardcodeBreakPoint := OVal = TDbgProcess.Int3;
  end;
end;

function TDbgThread.CheckForHardcodeBreakPoint(AnAddr: TDBGPtr): boolean;
var
  OVal: Byte;
begin
  Result := False;
  if AnAddr = 0 then
    exit;
  if FProcess.ReadData(AnAddr, 1, OVal) then
    FPausedAtHardcodeBreakPoint := OVal = TDbgProcess.Int3;
  Result := FPausedAtHardcodeBreakPoint;
end;

procedure TDbgThread.BeforeContinue;
begin
  // On Windows this is only called, if this was the signalled thread
  FPausedAtHardcodeBreakPoint := False;
  FPausedAtRemovedBreakPointState := rbUnknown;
  FPausedAtRemovedBreakPointAddress := 0;
end;

procedure TDbgThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
begin
  //
end;

function TDbgThread.DetectHardwareWatchpoint: Pointer;
begin
  result := nil;
end;

function TDbgThread.GetCurrentStackFrameInfo: TDbgStackFrameInfo;
begin
  Result := TDbgStackFrameInfo.Create(Self);
end;

function TDbgThread.AllocStackMem(ASize: Integer): TDbgPtr;
begin
  Result := GetStackPointerRegisterValue;
  if FStackBeforeAlloc = 0 then
    FStackBeforeAlloc := Result;
  dec(Result, ASize);
  SetStackPointerRegisterValue(Result);
end;

procedure TDbgThread.RestoreStackMem;
begin
  if FStackBeforeAlloc <> 0 then
    SetStackPointerRegisterValue(FStackBeforeAlloc);
  FStackBeforeAlloc := 0;
end;

procedure TDbgThread.PrepareCallStackEntryList(AFrameRequired: Integer);
const
  MAX_FRAMES = 150000; // safety net
var
  Address, FrameBase, LastFrameBase, Dummy: QWord;
  PrevAddress, PrevFrameBase, PrevStackPtr: QWord;
  Size, CountNeeded, IP, BP, CodeReadErrCnt, SP, i,
    PrevStmtAddressOffs: integer;
  AnEntry, NewEntry: TDbgCallstackEntry;
  R, StackReg, FrameReg: TDbgRegisterValue;
  nIP, nBP, nSP: String;
  NextIdx: LongInt;
  OutSideFrame: Boolean;
  StackPtr: TDBGPtr;
  Row: TDwarfCallFrameInformationRow;
  CIE: TDwarfCIE;
  CU: TDwarfCompilationUnit;

  procedure CheckFrame(var NextEntry: TDbgCallstackEntry; AForce: boolean = False);
  begin
    if (not AForce) and (NextEntry <> nil) and Process.Disassembler.IsAfterCallInstruction(Address) then
      exit;

    if not Process.Disassembler.UnwindFrame(PrevAddress, PrevStackPtr, PrevFrameBase, False) then
      exit;

    if (NextEntry <> nil) and
       (Address = PrevAddress) and (FrameBase = PrevFrameBase) and (StackPtr = PrevStackPtr)
    then
      exit;
    if not Process.Disassembler.IsAfterCallInstruction(PrevAddress) then
      exit;

    Address := PrevAddress;
    FrameBase := PrevFrameBase;
    StackPtr := PrevStackPtr;
    NextEntry.Free;
    NextEntry := TDbgCallstackEntry.create(Self, NextIdx, FrameBase, Address);
    NextEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
    NextEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
    NextEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
    LastFrameBase := FrameBase;
    {$PUSH}{$R-}{$Q-}
    if LastFrameBase > 0 then
      LastFrameBase := LastFrameBase - 1;
    {$POP}
  end;

begin
  // TODO: use AFrameRequired // check if already partly done
  if FCallStackEntryList = nil then
    FCallStackEntryList := TDbgCallstackEntryList.Create;
  if AFrameRequired = -2 then
    exit;

  if (AFrameRequired >= 0) and (AFrameRequired < FCallStackEntryList.Count) then
    exit;

  case FProcess.Mode of
    dm32: begin
      Size := 4;
      IP := 8; // Dwarf Reg Num EIP
      BP := 5; // EBP
      SP := 4; // ESP
      nIP := 'eip';
      nBP := 'ebp';
      nSP := 'esp';
    end;
    dm64: begin
      Size := 8;
      IP := 16; // Dwarf Reg Num RIP
      BP := 6; // RBP
      SP := 7; // RSP
      nIP := 'rip';
      nBP := 'rbp';
      nSP := 'rsp';
    end;
    else begin
      assert(False, 'unknown address size for stack');
      exit;
    end;
  end;

  FCallStackEntryList.FreeObjects:=true;

  PrevStmtAddressOffs := 1;
  if FCallStackEntryList.Count > 0 then begin
    AnEntry := FCallStackEntryList[FCallStackEntryList.Count - 1];
    Address:=AnEntry.AnAddress;
    FrameBase:=AnEntry.FrameAdress;
    R := AnEntry.RegisterValueList.FindRegisterByDwarfIndex(SP);
    if R = nil then exit;
    StackPtr := R.NumValue;
  end
  else begin
    PrevStmtAddressOffs := 0;
    Address := GetInstructionPointerRegisterValue;
    FrameBase := GetStackBasePointerRegisterValue;
    StackPtr := GetStackPointerRegisterValue;
    AnEntry := TDbgCallstackEntry.create(Self, 0, FrameBase, Address);

    // Initialize register values
    // Top level could do without entry in registerlist, but this way the
    // same code can handle both cases.
    i := 0;
    R := RegisterValueList.FindRegisterByDwarfIndex(i);
    while Assigned(R) do
      begin
      AnEntry.RegisterValueList.DbgRegisterAutoCreate[R.Name].SetValue(R.NumValue, R.StrValue, R.Size, R.DwarfIdx);
      inc(i);
      R := RegisterValueList.FindRegisterByDwarfIndex(i);
      end;
    FCallStackEntryList.Add(AnEntry);
  end;

  NextIdx := FCallStackEntryList.Count;
  if AFrameRequired < 0 then
    AFrameRequired := MaxInt;
  CountNeeded := AFrameRequired - FCallStackEntryList.Count;
  LastFrameBase := 0;
  CodeReadErrCnt := 0;
  while (CountNeeded > 0) do
  begin
    PrevAddress := Address;
    PrevFrameBase := FrameBase;
    PrevStackPtr := StackPtr;
    {$PUSH}{$R-}{$Q-}
    if (Process.DbgInfo as TFpDwarfInfo).FindCallFrameInfo(Address - PrevStmtAddressOffs, CIE, Row) and
       TDwarfCallFrameInformation.TryObtainNextCallFrame(AnEntry, CIE, Size, NextIdx, Self, Row, Process, NewEntry)
    {$POP}
    then begin
      PrevStmtAddressOffs := 1;
      if not Assigned(NewEntry) then begin
        CU := (Process.DbgInfo as TFpDwarfInfo).CompilationUnitForAddr(Address);
        if (CU = nil) or (CU.DwarfSymbolClassMap = nil) or (not CU.DwarfSymbolClassMap.IgnoreCfiStackEnd) then
          // Done.
          Break;
      end
      else begin
        Address := NewEntry.AnAddress;
        StackReg := NewEntry.RegisterValueList.FindRegisterByDwarfIndex(SP);
        FrameReg := NewEntry.RegisterValueList.FindRegisterByDwarfIndex(BP);
        StackPtr := 0;
        if (StackReg <> nil) and (FrameReg <> nil) then begin
          StackPtr := StackReg.FNumValue;
          FrameBase := FrameReg.FNumValue;
        end;
        AnEntry := NewEntry;
        CheckFrame(NewEntry);
        FCallStackEntryList.Add(NewEntry);
        Dec(CountNeeded);
        inc(NextIdx);
        If (NextIdx > MAX_FRAMES) then
          Break;

        Continue;
      end;
    end;
    PrevStmtAddressOffs := 1;

    if Process.Disassembler.UnwindFrame(PrevAddress, PrevStackPtr, PrevFrameBase, True) and
       Process.Disassembler.IsAfterCallInstruction(PrevAddress)
    then begin
      Address := PrevAddress;
      FrameBase := PrevFrameBase;
      StackPtr := PrevStackPtr;
      AnEntry := TDbgCallstackEntry.create(Self, NextIdx, FrameBase, Address);
      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
      FCallStackEntryList.Add(AnEntry);
      Dec(CountNeeded);
      inc(NextIdx);
      CodeReadErrCnt := 0;
      If (NextIdx > MAX_FRAMES) then
        break;
      LastFrameBase := FrameBase;
      {$PUSH}{$R-}{$Q-}
      if LastFrameBase > 0 then
        LastFrameBase := LastFrameBase - 1;
      {$POP}
      continue;
    end;
    Address := PrevAddress;
    FrameBase := PrevFrameBase;
    StackPtr := PrevStackPtr;

    if (FrameBase <> 0) and (FrameBase > LastFrameBase)
    then begin
      if StackPtr = 0 then
        break;
      // CFI not available or contains unsupported structures. Fallback to
      // old fashioned stack-tracing.
      OutSideFrame := False;
      if not Process.Disassembler.GetFunctionFrameInfo(Address, OutSideFrame) then begin
        if Process.Disassembler.LastErrorWasMemReadErr then begin
          inc(CodeReadErrCnt);
          if CodeReadErrCnt > 5 then break; // If the code cannot be read the stack pointer is wrong.
          if NextIdx <= 1 then
            OutSideFrame := True; // Maybe after "TProc(nil)();" call, then no frame could have been set up
        end;
      end;
      LastFrameBase := FrameBase;

      if (not OutSideFrame) and (NextIdx = 1) and (AnEntry.ProcSymbol <> nil) then begin
        OutSideFrame := Address = LocToAddrOrNil(AnEntry.ProcSymbol.Address); // the top frame must be outside frame, if it is at entrypoint / needed for exceptions
      end;

      if OutSideFrame then begin
        if not Process.ReadData(StackPtr, Size, Address) or (Address = 0) then Break;

        if (not Process.ReadData(Address, 1, Dummy) or (Address = 0)) then begin
          OutSideFrame := False;
        end
        else begin
          {$PUSH}{$R-}{$Q-}
          StackPtr := StackPtr + 1 * Size; // After popping return-addr from "StackPtr"
          if LastFrameBase > 0 then
            LastFrameBase := LastFrameBase - 1; // Make the loop think thas LastFrameBase was smaller
          {$POP}
          // last stack has no frame
          //AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(0, '0',Size, BP);
        end;
      end;
      if not OutSideFrame then begin
        {$PUSH}{$R-}{$Q-}
        StackPtr := FrameBase + 2 * Size; // After popping return-addr from "FrameBase + Size"
        {$POP}
        if not Process.ReadData(FrameBase + Size, Size, Address) or (Address = 0) then Break;
        if not Process.ReadData(FrameBase, Size, FrameBase) then Break;
      end;
      AnEntry := TDbgCallstackEntry.create(Self, NextIdx, FrameBase, Address);
      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
      CheckFrame(AnEntry, FrameBase < StackPtr);
      FCallStackEntryList.Add(AnEntry);
      Dec(CountNeeded);
      inc(NextIdx);
      CodeReadErrCnt := 0;
      If (NextIdx > MAX_FRAMES) then
        break;
    end
    else
    begin
      AnEntry := nil;
      CheckFrame(AnEntry);
      if AnEntry <> nil then
        FCallStackEntryList.Add(AnEntry)
      else
        Break;
    end;
  end;
  if CountNeeded > 0 then // there was an error / not possible to read more frames
    FCallStackEntryList.SetHasReadAllAvailableFrames;
end;

function TDbgThread.FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr;
  AMaxFrameToSearch: Integer; AStartFrame: integer): Integer;
var
  RegFP: Integer;
  AFrame: TDbgCallstackEntry;
  ARegister: TDbgRegisterValue;
  fp, prev_fp: TDBGPtr;
begin
  if Process.Mode = dm64 then
    RegFP := 6
  else
    RegFP := 5;

  Result := AStartFrame;
  prev_fp := low(prev_fp);
  while Result <= AMaxFrameToSearch do begin
    PrepareCallStackEntryList(Result+1);
    if CallStackEntryList.Count <= Result then
      exit(-1);

    AFrame := CallStackEntryList[Result];
    if AFrame = nil then
      exit(-1);
    ARegister := AFrame.RegisterValueList.FindRegisterByDwarfIndex(RegFP);
    if ARegister = nil then
      exit(-1);

    fp := ARegister.NumValue;

    if fp = AFrameBasePointer then
      exit;

    if (fp < prev_fp) or (fp > AFrameBasePointer) then
      exit(-1);

    prev_fp := fp;
    inc(Result);
  end;
end;

function TDbgThread.FindCallStackEntryByInstructionPointer(
  AInstructionPointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer
  ): Integer;
var
  RegIP: Integer;
  AFrame: TDbgCallstackEntry;
  ARegister: TDbgRegisterValue;
  ip: TDBGPtr;
begin
  if Process.Mode = dm64 then
    RegIP := 16
  else
    RegIP := 8;

  Result := AStartFrame;
  while Result <= AMaxFrameToSearch do begin
    PrepareCallStackEntryList(Result+1);
    if CallStackEntryList.Count <= Result then
      exit(-1);

    AFrame := CallStackEntryList[Result];
    if AFrame = nil then
      exit(-1);
    ARegister := AFrame.RegisterValueList.FindRegisterByDwarfIndex(RegIP);
    if ARegister = nil then
      exit(-1);

    ip := ARegister.NumValue;

    if ip = AInstructionPointer then
      exit;

    inc(Result);
  end;
end;

procedure TDbgThread.ClearCallStack;
begin
  if FCallStackEntryList <> nil then
    FCallStackEntryList.Clear;
end;

destructor TDbgThread.Destroy;
begin
  FProcess.ThreadDestroyed(Self);
  FreeAndNil(FRegisterValueList);
  FreeAndNil(FPreviousRegisterValueList);
  ClearCallStack;
  FreeAndNil(FCallStackEntryList);
  inherited;
end;

procedure TDbgThread.ClearExceptionSignal;
begin
  // To be implemented in sub-classes
end;

procedure TDbgThread.IncSuspendCount;
begin
  inc(FSuspendCount);
end;

procedure TDbgThread.DecSuspendCount;
begin
  dec(FSuspendCount);
  DebugLn((DBG_VERBOSE or DBG_WARNINGS) and (FSuspendCount < 0), ['DecSuspendCount went negative: ', FSuspendCount])
end;

{ TFpWatchPointData }

function TFpWatchPointData.AddOwnedWatchpoint(AnOwner: Pointer;
  AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean;
begin
  Result := False;
end;

function TFpWatchPointData.RemoveOwnedWatchpoint(AnOwner: Pointer): boolean;
begin
  Result := True;
end;

{ TFpIntelWatchPointData }

function TFpIntelWatchPointData.GetDr03(AnIndex: Integer): TDBGPtr;
begin
  Result := FDr03[AnIndex];
end;

function TFpIntelWatchPointData.GetOwner(AnIndex: Integer): Pointer;
begin
  Result := FOwners[AnIndex];
end;

function TFpIntelWatchPointData.AddOwnedWatchpoint(AnOwner: Pointer;
  AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean;
var
  SizeBits, ModeBits: DWord;
  idx: Integer;
begin
  Result := False;
  case ASize of
    1: SizeBits := $00000 shl 2;
    2: SizeBits := $10000 shl 2;
    4: SizeBits := $30000 shl 2;
    8: SizeBits := $20000 shl 2; // Only certain cpu / must be 8byte aligned
    else exit;
  end;
  case AReadWrite of
    wpkWrite:     ModeBits := $10000;
    wpkRead:      ModeBits := $30000; // caller must check
    wpkReadWrite: ModeBits := $30000;
    wkpExec:      ModeBits := $00000; // Size must be 1 (SizeBits=0)
  end;

  for idx := 0 to 3 do begin
    if (FDr7 and (1 shl (idx * 2))) = 0 then begin
      FDr7 := FDr7 or (1 shl (idx*2))
                   or (ModeBits shl (idx*4)) // read/write
                   or (SizeBits shl (idx*4)); // size
      FDr03[idx] := AnAddr;
      FOwners[idx] := AnOwner;
      Changed := True;
      Result := True;
      break;
    end;
  end;
end;

function TFpIntelWatchPointData.RemoveOwnedWatchpoint(AnOwner: Pointer
  ): boolean;
var
  idx: Integer;
begin
  Result := False;
  for idx := 0 to 3 do begin
    if FOwners[idx] = AnOwner then begin
      FDr7 := FDr7 and not (
                   (DWord(3) shl (idx*2)) or
                   (DWord($F0000) shl (idx*4))
      );
      FDr03[idx] := 0;
      FOwners[idx] := nil;
      Changed := True;
      Result := True;
    end;
  end;
end;

{ TFpInternalBreakBase }

procedure TFpInternalBreakBase.UpdateForLibraryLoaded(ALib: TDbgLibrary);
begin
  //
end;

procedure TFpInternalBreakBase.UpdateForLibrareUnloaded(ALib: TDbgLibrary);
begin
  //
end;

constructor TFpInternalBreakBase.Create(const AProcess: TDbgProcess);
begin
  inherited Create;
  FProcess := AProcess;
end;

{ TDbgBreak }

function TFpInternalBreakpoint.GetState: TFpDbgBreakpointState;
begin
  Result := FState;
end;

procedure TFpInternalBreakpoint.SetState(AState: TFpDbgBreakpointState);
begin
  if AState = FState then
    exit;
  FState := AState;
  if FOn_Thread_StateChange <> nil then
    FOn_Thread_StateChange(Self, AState);
end;

procedure TFpInternalBreakpoint.UpdateState;
begin
  if Length(FLocation) > 0 then
    SetState(bksOk)
  else
    SetState(bksFailed);
end;

procedure TFpInternalBreakpoint.UpdateForLibrareUnloaded(ALib: TDbgLibrary);
var
  i, j: Integer;
  a: TDBGPtr;
begin
  j := 0;
  for i := 0 to Length(FLocation) - 1 do begin
    a := FLocation[i];
    FLocation[j] := a;
    if ALib.EnclosesAddressRange(a, a) then
      FProcess.FBreakMap.RemoveLocation(a, Self)
    else
      inc(j);
  end;
  if j < Length(FLocation) then begin
    SetLength(FLocation, j);
    UpdateState;
  end;
end;

constructor TFpInternalBreakpoint.Create(const AProcess: TDbgProcess;
  const ALocation: TDBGPtrArray; AnEnabled: Boolean);
begin
  inherited Create(AProcess);
  FProcess.FBreakpointList.Add(Self);
  FLocation := ALocation;
  FEnabled := AnEnabled;
  FState := bksUnknown;
  if AnEnabled then
    SetBreak;
  UpdateState;
end;

destructor TFpInternalBreakpoint.Destroy;
begin
  On_Thread_StateChange := nil;
  if FProcess <> nil then
    FProcess.FBreakpointList.Remove(Self);
  ResetBreak;
  inherited;
end;

function TFpInternalBreakpoint.Hit(const AThreadID: Integer;
  ABreakpointAddress: TDBGPtr): Boolean;
begin
  Result := False;
  assert(FProcess<>nil, 'TFpInternalBreakpoint.Hit: FProcess<>nil');
  if //FProcess.FBreakMap.HasId(ABreakpointAddress) and
     (FProcess.FBreakMap.IsHardcodeBreakPoint(ABreakpointAddress))
  then
    exit; // breakpoint on a hardcoded breakpoint
          // no need to jump back and restore instruction

  Result := true;
end;

function TFpInternalBreakpoint.HasLocation(const ALocation: TDBGPtr): Boolean;
var
  i: Integer;
begin
  Result := True;
  for i := 0 to High(FLocation) do begin
    if FLocation[i] = ALocation then
      exit;
  end;
  Result := False;
end;

procedure TFpInternalBreakpoint.AddAddress(const ALocation: TDBGPtr);
var
  l: Integer;
begin
  l := Length(FLocation);
  SetLength(FLocation, l+1);
  FLocation[l] := ALocation;
  if Enabled then
    FProcess.FBreakMap.AddLocation(ALocation, Self, True);
  UpdateState;
end;

procedure TFpInternalBreakpoint.AddAddress(const ALocations: TDBGPtrArray);
var
  l, i: Integer;
begin
  l := Length(FLocation);
  SetLength(FLocation, l + Length(ALocations));

  if Enabled then begin
    for i := 0 to Length(ALocations) - 1 do begin
      FLocation[l + i] := ALocations[i];
      FProcess.FBreakMap.AddLocation(ALocations[i], Self, True);
    end;
  end
  else begin
    for i := 0 to Length(ALocations) - 1 do
      FLocation[l + i] := ALocations[i];
  end;
  UpdateState;
end;

procedure TFpInternalBreakpoint.RemoveAddress(const ALocation: TDBGPtr);
var
  l, i: Integer;
begin
  l := Length(FLocation) - 1;
  i := l;
  while (i >= 0) and (FLocation[i] <> ALocation) do
    dec(i);
  if i < 0 then
    exit;
  FLocation[i] := FLocation[l];
  SetLength(FLocation, l);
  FProcess.FBreakMap.RemoveLocation(ALocation, Self);
  UpdateState;
end;

procedure TFpInternalBreakpoint.RemoveAllAddresses;
begin
  ResetBreak;
  SetLength(FLocation, 0);
  UpdateState;
end;

procedure TFpInternalBreakpoint.ResetBreak;
var
  i: Integer;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.ResetBreak');{$ENDIF}
  if FProcess = nil then
    exit;

  FEnabled := False;
  for i := 0 to High(FLocation) do
    FProcess.FBreakMap.RemoveLocation(FLocation[i], Self);
end;

procedure TFpInternalBreakpoint.SetBreak;
var
  i: Integer;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.SetBreak');{$ENDIF}
  if FProcess = nil then
    exit;

  FEnabled := True;
  for i := 0 to High(FLocation) do
    FProcess.FBreakMap.AddLocation(FLocation[i], Self, True);
end;

{ TFpInternalBreakpointAtSymbol }

procedure TFpInternalBreakpointAtSymbol.UpdateState;
begin
  if Length(FLocation) > 0 then
    SetState(bksOk)
  else
    SetState(bksPending);
end;

procedure TFpInternalBreakpointAtSymbol.UpdateForLibraryLoaded(ALib: TDbgLibrary
  );
var
  a: TDBGPtrArray;
  AProcList: TFpSymbolArray;
  i: Integer;
begin
  if FSymInstance <> nil then // Can not be the newly created ...
    exit;

  FProcess.FindProcSymbol(FFuncName, ALib, AProcList);
  SetLength(a, Length(AProcList));
  for i := 0 to Length(AProcList) - 1 do begin
    a[i] := AProcList[i].Address.Address;
    AProcList[i].ReleaseReference;
  end;

  AddAddress(a);
end;

constructor TFpInternalBreakpointAtSymbol.Create(const AProcess: TDbgProcess;
  const AFuncName: String; AnEnabled: Boolean; ASymInstance: TDbgInstance);
var
  a: TDBGPtrArray;
  AProcList: TFpSymbolArray;
  i: Integer;
begin
  FFuncName := AFuncName;
  FSymInstance := ASymInstance;

  AProcess.FindProcSymbol(AFuncName, ASymInstance, AProcList);
  SetLength(a, Length(AProcList));
  for i := 0 to Length(AProcList) - 1 do begin
    a[i] := AProcList[i].Address.Address;
    AProcList[i].ReleaseReference;
  end;

  inherited Create(AProcess, a, AnEnabled);
end;

{ TFpInternalBreakpointAtFileLine }

procedure TFpInternalBreakpointAtFileLine.UpdateState;
begin
  if Length(FLocation) > 0 then
    SetState(bksOk)
  else
  if FFoundFileWithoutLine then
    SetState(bksFailed)
  else
    SetState(bksPending);
end;

procedure TFpInternalBreakpointAtFileLine.UpdateForLibraryLoaded(
  ALib: TDbgLibrary);
var
  addr: TDBGPtrArray;
begin
  if FSymInstance <> nil then // Can not be the newly created ...
    exit;

  addr := nil;
  FProcess.GetLineAddresses(FFileName, FLine, addr, ALib);
  if FProcess.FLastLineAddressesFoundFile and (Length(addr) = 0) then
    FFoundFileWithoutLine := True;
  AddAddress(addr);
end;

constructor TFpInternalBreakpointAtFileLine.Create(const AProcess: TDbgProcess;
  const AFileName: String; ALine: Cardinal; AnEnabled: Boolean;
  ASymInstance: TDbgInstance);
var
  addr: TDBGPtrArray;
begin
  FFileName := AFileName;
  FLine := ALine;
  FSymInstance := ASymInstance;

  addr := nil;
  AProcess.GetLineAddresses(AFileName, ALine, addr, ASymInstance);
  FFoundFileWithoutLine := AProcess.FLastLineAddressesFoundFile and (Length(addr) = 0);
  inherited Create(AProcess, addr, AnEnabled);
end;

{ TFpInternalWatchpoint }

constructor TFpInternalWatchpoint.Create(const AProcess: TDbgProcess;
  const ALocation: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind;
  AScope: TDBGWatchPointScope);
(* FROM INTEL DOCS / About 8 byte watchpoints
For Pentium® 4 and Intel® Xeon® processors with a CPUID signature corresponding to family 15 (model 3, 4, and 6),
break point conditions permit specifying 8-byte length on data read/write with an of encoding 10B in the LENn field.
Encoding 10B is also supported in processors based on Intel Core microarchitecture or
enhanced Intel Core microarchitecture, the respective CPUID signatures corresponding to family 6, model 15,
and family 6, DisplayModel value 23 (see CPUID instruction in Chapter 3,
“Instruction Set Reference, A-L” in the Intel® 64 and IA-32 Architectures Software Developer’s Manual, Volume 2A).
The Encoding 10B is supported in processors based on Intel® Atom™ microarchitecture,
with CPUID signature of family 6, DisplayModel value 1CH. The encoding 10B is undefined for other processors
*)
const
  MAX_WATCH_SIZE = 8;
  SIZE_TO_BOUNDMASK: array[1..8] of TDBGPtr = (
    0,        // Size=1
    1, 0,     // Size=2
    3, 0,0,0, // Size=4
    7         // Size=8
    );
  SIZE_TO_WATCHSIZE: array[0..8] of Integer = (0, 1, 2, 4, 4, 8, 8, 8, 8);
var
  MaxWatchSize: Integer;
  BoundaryOffset, S, HalfSize: Integer;
begin
  inherited Create(AProcess);
  FProcess.FWatchPointList.Add(Self);
  FLocation := ALocation;
  FSize := ASize;
  FReadWrite := AReadWrite;
  FScope := AScope;

  MaxWatchSize := MAX_WATCH_SIZE;
//   Wach at 13FFC20:4 TO First 13FFC18:8 Other 0 (0) Last 0

  FFirstWatchSize := MaxWatchSize;
  BoundaryOffset := Integer(FLocation and SIZE_TO_BOUNDMASK[FFirstWatchSize]);
  // As long as the full first half of the watch is unused, use the next smaller watch-size
  HalfSize := FFirstWatchSize div 2;
  while (FFirstWatchSize > 1) and
        ( (BoundaryOffset >= HalfSize) or
          (FSize <= HalfSize)
        )
  do begin
    FFirstWatchSize := HalfSize;
    HalfSize := FFirstWatchSize div 2;
    BoundaryOffset := Integer(FLocation and SIZE_TO_BOUNDMASK[FFirstWatchSize]);
  end;
  FFirstWatchLocation := FLocation - BoundaryOffset;

  FOtherWatchesSize := 0;
  FOtherWatchCount := 0;
  FLastWatchSize := 0;

  S := FSize - FFirstWatchSize + BoundaryOffset; // remainder size
  if S > 0 then begin
    FOtherWatchCount := (S - 1) div MaxWatchSize;
    if FOtherWatchCount > 0 then
      FOtherWatchesSize := MaxWatchSize;

    S := S - FOtherWatchCount * FOtherWatchesSize;
    assert(S >= 0, 'TFpInternalWatchpoint.Create: S >= 0');

    FLastWatchSize := SIZE_TO_WATCHSIZE[S];
  end;
  debugln(DBG_VERBOSE, 'Wach at %x:%d TO First %x:%d Other %d (%d) Last %d',
    [FLocation, FSize, FFirstWatchLocation, FFirstWatchSize, FOtherWatchCount, FOtherWatchesSize, FLastWatchSize]);

  SetBreak;
end;

destructor TFpInternalWatchpoint.Destroy;
begin
  if FProcess <> nil then
    FProcess.FWatchPointList.Remove(Self);
  ResetBreak;
  inherited Destroy;
end;

procedure TFpInternalWatchpoint.SetBreak;
var
  a: TDBGPtr;
  wd: TFpWatchPointData;
  R: Boolean;
  i: Integer;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalWatchpoint.SetBreak');{$ENDIF}
  if FProcess = nil then
    exit;
  //TODO: read current mem content. So in case of overlap it can be checked

  wd := FProcess.WatchPointData;

  a := FFirstWatchLocation;
  R := wd.AddOwnedWatchpoint(Self, a, FFirstWatchSize, FReadWrite);
  if not R then begin
    ResetBreak;
    exit;
  end;

  a := a + FFirstWatchSize;
  for i := 0 to FOtherWatchCount - 1 do begin
    R := wd.AddOwnedWatchpoint(Self, a, FOtherWatchesSize, FReadWrite);
    if not R then begin
      ResetBreak;
      exit;
    end;
    a := a + FOtherWatchesSize;
  end;

  if FLastWatchSize > 0 then
    R := wd.AddOwnedWatchpoint(Self, a, FLastWatchSize, FReadWrite);
  if not R then
    ResetBreak;
end;

procedure TFpInternalWatchpoint.ResetBreak;
begin
  {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalWatchpoint.ResetBreak');{$ENDIF}
  if FProcess = nil then
    exit;

  FProcess.WatchPointData.RemoveOwnedWatchpoint(Self);
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_BREAKPOINTS := DebugLogger.FindOrRegisterLogGroup('DBG_BREAKPOINTS' {$IFDEF DBG_BREAKPOINTS} , True {$ENDIF} );
  FPDBG_COMMANDS := DebugLogger.FindOrRegisterLogGroup('FPDBG_COMMANDS' {$IFDEF FPDBG_COMMANDS} , True {$ENDIF} );

finalization
  if assigned(RegisteredDbgProcessClasses) then
    FreeAndNil(RegisteredDbgProcessClasses);

end.
