FpDebug: Partial implement WatchPoints.

- No local watches yet. Always global scope.
- Break on Write is the same Read/Write
- Info pop up has no old/new value
- No feedback (in some cases) if watch failed to set

git-svn-id: trunk@61990 -

components/debuggerintf/dbgintfdebuggerbase.pp

@@ -292,7 +292,8 @@ type
   TDBGWatchPointKind = (
     wpkWrite,
     wpkRead,
-    wpkReadWrite
+    wpkReadWrite,
+    wkpExec
   );
 
   { TBaseBreakPoint }

components/fpdebug/fpdbgclasses.pp

@@ -117,6 +117,7 @@ type
   TDbgCallstackEntryList = specialize TFPGObjectList<TDbgCallstackEntry>;
 
   TDbgProcess = class;
+  TFpWatchPointData = class;
 
   { TDbgMemReader }
 
@@ -140,7 +141,6 @@ type
     FProcess: TDbgProcess;
     FID: Integer;
     FHandle: THandle;
-
     FPausedAtRemovedBreakPointState: (rbUnknown, rbNone, rbFound{, rbFoundAndDec});
     FPausedAtRemovedBreakPointAddress: TDBGPtr;
 
@@ -163,9 +163,8 @@ type
     function HasInsertedBreakInstructionAtLocation(const ALocation: TDBGPtr): Boolean; // include removed breakpoints that (may have) already triggered
     procedure CheckAndResetInstructionPointerAfterBreakpoint;
     procedure BeforeContinue; virtual;
-    function AddWatchpoint(AnAddr: TDBGPtr): integer; virtual;
+    procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); virtual;
-    function RemoveWatchpoint(AnId: integer): boolean; virtual;
+    function DetectHardwareWatchpoint: Pointer; virtual;
-    function DetectHardwareWatchpoint: integer; virtual;
 
     function GetInstructionPointerRegisterValue: TDbgPtr; virtual; abstract;
     function GetStackBasePointerRegisterValue: TDbgPtr; virtual; abstract;
@@ -260,15 +259,26 @@ type
     procedure ResetBreak; virtual; abstract;
   end;
 
-  { TFpInternalBreakpoint }
+  { TFpInternalBreakBase }
 
-  TFpInternalBreakpoint = class(TFpDbgBreakpoint)
+  TFpInternalBreakBase = class(TFpDbgBreakpoint)
   private
     FProcess: TDbgProcess;
+  protected
+    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;
   protected
-    property Process: TDbgProcess read FProcess;
     property Location: TDBGPtrArray read FLocation;
   public
     constructor Create(const AProcess: TDbgProcess; const ALocation: TDBGPtrArray); virtual;
@@ -281,8 +291,34 @@ type
   end;
   TFpInternalBreakpointClass = class of TFpInternalBreakpoint;
 
-  TFpInternalBreakpointList = specialize TFPGObjectList<TFpInternalBreakpoint>;
+  { 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;
+  TFpInternalWatchpointClass = class of TFpInternalWatchpoint;
 
   { TDbgInstance }
 
@@ -342,15 +378,16 @@ type
     FGotExitProcess: Boolean;
     FProcessID: Integer;
     FThreadID: Integer;
+    FWatchPointData: TFpWatchPointData;
 
     function GetPauseRequested: boolean;
     procedure SetPauseRequested(AValue: boolean);
     procedure ThreadDestroyed(const AThread: TDbgThread);
   protected
-    FBreakpointList: TFpInternalBreakpointList;
+    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: integer;
+    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
 
@@ -380,6 +417,8 @@ type
     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;
 public
     class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; virtual;
     class function AttachToInstance(AFileName: string; APid: Integer): TDbgProcess; virtual;
@@ -389,6 +428,9 @@ type
     function  AddInternalBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload;
     function  AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
     function  AddBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload;
+    function  AddWatch(const ALocation: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind;
+                      AScope: TDBGWatchPointScope): TFpInternalWatchpoint;
+    property WatchPointData: TFpWatchPointData read FWatchPointData;
     function  FindProcSymbol(const AName: String): TFpSymbol;
     function  FindProcSymbol(AAdress: TDbgPtr): TFpSymbol;
     function  FindContext(AThreadId, AStackFrame: Integer): TFpDbgInfoContext;
@@ -438,7 +480,7 @@ type
     property ThreadID: integer read FThreadID;
     property ExitCode: DWord read FExitCode;
     property CurrentBreakpoint: TFpInternalBreakpoint read FCurrentBreakpoint;
-    property CurrentWatchpoint: integer read FCurrentWatchpoint;
+    property CurrentWatchpoint: Pointer read FCurrentWatchpoint;
     property PauseRequested: boolean read GetPauseRequested write SetPauseRequested;
     function GetAndClearPauseRequested: Boolean;
 
@@ -452,10 +494,40 @@ type
   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 = class
   public
     DbgThreadClass : TDbgThreadClass;
     DbgBreakpointClass : TFpInternalBreakpointClass;
+    DbgWatchpointClass : TFpInternalWatchpointClass;
     DbgProcessClass : TDbgProcessClass;
   end;
 
@@ -498,6 +570,7 @@ begin
     GOSDbgClasses := TOSDbgClasses.create;
     GOSDbgClasses.DbgThreadClass := TDbgThread;
     GOSDbgClasses.DbgBreakpointClass := TFpInternalBreakpoint;
+    GOSDbgClasses.DbgWatchpointClass := TFpInternalWatchpoint;
     GOSDbgClasses.DbgProcessClass := TDbgProcess;
     {$ifdef windows}
     RegisterDbgClasses;
@@ -1105,6 +1178,13 @@ begin
       end;
 end;
 
+function TDbgProcess.AddWatch(const ALocation: TDBGPtr; ASize: Cardinal;
+  AReadWrite: TDBGWatchPointKind; AScope: TDBGWatchPointScope
+  ): TFpInternalWatchpoint;
+begin
+  Result := OSDbgClasses.DbgWatchpointClass.Create(Self, ALocation, ASize, AReadWrite, AScope);
+end;
+
 constructor TDbgProcess.Create(const AFileName: string; const AProcessID,
   AThreadID: Integer);
 const
@@ -1118,11 +1198,13 @@ begin
   FThreadID := AThreadID;
 
   FBreakpointList := TFpInternalBreakpointList.Create(False);
+  FWatchPointList := TFpInternalBreakpointList.Create(False);
   FThreadMap := TThreadMap.Create(itu4, SizeOf(TDbgThread));
   FLibMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgLibrary));
+  FWatchPointData := CreateWatchPointData;
   FBreakMap := TBreakLocationMap.Create(Self);
   FCurrentBreakpoint := nil;
-  FCurrentWatchpoint := -1;
+  FCurrentWatchpoint := nil;
 
   FSymInstances := TList.Create;
 
@@ -1159,12 +1241,16 @@ begin
 
   for i := 0 to FBreakpointList.Count - 1 do
     FBreakpointList[i].FProcess := nil;
+  for i := 0 to FWatchPointList.Count - 1 do
+    FWatchPointList[i].FProcess := nil;
   FreeAndNil(FBreakpointList);
+  FreeAndNil(FWatchPointList);
   //Assert(FBreakMap.Count=0, 'No breakpoints left');
   //FreeItemsInMap(FBreakMap);
   FreeItemsInMap(FThreadMap);
   FreeItemsInMap(FLibMap);
 
+  FreeAndNil(FWatchPointData);
   FreeAndNil(FBreakMap);
   FreeAndNil(FThreadMap);
   FreeAndNil(FLibMap);
@@ -1326,6 +1412,8 @@ 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;
 
@@ -1364,6 +1452,7 @@ begin
       assert(FMainThread=nil);
       FMainThread := result;
     end;
+    Result.ApplyWatchPoints(FWatchPointData);
   end
   else
     DebugLn(DBG_WARNINGS, 'Unknown thread ID %u for process %u', [AThreadIdentifier, ProcessID]);
@@ -1403,12 +1492,15 @@ begin
     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;
@@ -1603,8 +1695,8 @@ end;
 
 procedure TDbgProcess.RemoveAllBreakPoints;
 var
-  b: TFpInternalBreakpoint;
   i: LongInt;
+  b: TFpInternalBreakBase;
 begin
   i := FBreakpointList.Count - 1;
   while i >= 0 do begin
@@ -1614,6 +1706,14 @@ begin
     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;
   assert(FBreakMap.Count = 0, 'TDbgProcess.RemoveAllBreakPoints: FBreakMap.Count = 0');
 end;
 
@@ -1697,6 +1797,11 @@ begin
   end;
 end;
 
+function TDbgProcess.CreateWatchPointData: TFpWatchPointData;
+begin
+  Result := TFpWatchPointData.Create;
+end;
+
 function TDbgProcess.WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean;
 begin
   result := false;
@@ -1860,21 +1965,14 @@ begin
   FPausedAtRemovedBreakPointAddress := 0;
 end;
 
-function TDbgThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
+procedure TDbgThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
 begin
-  DebugLn(DBG_VERBOSE, 'Hardware watchpoints are not available.');
+  //
-  result := -1;
 end;
 
-function TDbgThread.RemoveWatchpoint(AnId: integer): boolean;
+function TDbgThread.DetectHardwareWatchpoint: Pointer;
 begin
-  DebugLn(DBG_VERBOSE, 'Hardware watchpoints are not available: '+self.classname);
+  result := nil;
-  result := false;
-end;
-
-function TDbgThread.DetectHardwareWatchpoint: integer;
-begin
-  result := -1;
 end;
 
 procedure TDbgThread.PrepareCallStackEntryList(AFrameRequired: Integer);
@@ -1969,15 +2067,102 @@ begin
   inherited;
 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 }
+
+constructor TFpInternalBreakBase.Create(const AProcess: TDbgProcess);
+begin
+  inherited Create;
+  FProcess := AProcess;
+end;
+
 { TDbgBreak }
 
 constructor TFpInternalBreakpoint.Create(const AProcess: TDbgProcess;
   const ALocation: TDBGPtrArray);
 begin
-  FProcess := AProcess;
+  inherited Create(AProcess);
   FProcess.FBreakpointList.Add(Self);
   FLocation := ALocation;
-  inherited Create;
   SetBreak;
 end;
 
@@ -2035,6 +2220,132 @@ begin
     FProcess.FBreakMap.AddLocotion(FLocation[i], Self, True);
 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
+  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
+  if FProcess = nil then
+    exit;
+
+  FProcess.WatchPointData.RemoveOwnedWatchpoint(Self);
+end;
+
 initialization
   GOSDbgClasses := nil;
 

components/fpdebug/fpdbgcontroller.pas

@@ -10,7 +10,7 @@ uses
   SysUtils,
   Maps,
   LazLoggerBase,
-  DbgIntfBaseTypes,
+  DbgIntfBaseTypes, DbgIntfDebuggerBase,
   FpDbgDisasX86,
   FpDbgClasses;
 
@@ -949,6 +949,7 @@ begin
        deBreakpoint: begin
            b := FCurrentProcess.GetAndClearPauseRequested;
            AExit := (FCurrentProcess.CurrentBreakpoint <> nil) or
+                    ( (FCurrentProcess.CurrentWatchpoint <> nil) and (FCurrentProcess.CurrentWatchpoint <> Pointer(-1)) ) or
                     (b and (InterLockedExchangeAdd(FPauseRequest, 0) = 1))
          end;
 {        deLoadLibrary :
@@ -974,9 +975,14 @@ end;
 procedure TDbgController.SendEvents(out continue: boolean);
 var
   HasPauseRequest: Boolean;
+  CurWatch: TFpInternalWatchpoint;
 begin
   // reset pause request. If Pause() is called after this, it will be seen in the next loop
   HasPauseRequest := InterLockedExchange(FPauseRequest, 0) = 1;
+  CurWatch := nil;
+  if (FCurrentProcess.CurrentWatchpoint <> nil) and (FCurrentProcess.CurrentWatchpoint <> Pointer(-1)) then
+    CurWatch := TFpInternalWatchpoint(FCurrentProcess.CurrentWatchpoint);
+
   case FPDEvent of
     deCreateProcess:
       begin
@@ -993,28 +999,35 @@ begin
       end;
     deFinishedStep:
       begin
-          continue:=false;
+        if assigned(OnHitBreakpointEvent) then begin
           // if there is a breakpoint at the stepping end, execute its actions
-        if assigned(OnHitBreakpointEvent) and assigned(FCurrentProcess.CurrentBreakpoint) then
+          continue:=false;
+          if (CurWatch <> nil) and assigned(OnHitBreakpointEvent) then
+            OnHitBreakpointEvent(continue, CurWatch);
+          continue:=false;
+          if assigned(FCurrentProcess.CurrentBreakpoint) then
             OnHitBreakpointEvent(continue, FCurrentProcess.CurrentBreakpoint);
-        if continue or not assigned(FCurrentProcess.CurrentBreakpoint) then begin
+
           // TODO: dedicated event to set pause and location
           // ensure state = dsPause and location is set
           continue:=false;
           OnHitBreakpointEvent(continue, nil);
-        end;
-        // but do not continue
           HasPauseRequest := False;
+        end;
         continue:=false;
       end;
     deBreakpoint:
       begin
         // If there is no breakpoint AND no pause-request then this is a deferred, allready handled pause request
-        continue := (FCurrentProcess.CurrentBreakpoint = nil) and (not HasPauseRequest);
+        continue := (FCurrentProcess.CurrentBreakpoint = nil) and (CurWatch = nil) and (not HasPauseRequest);
-        if (not continue) and assigned(OnHitBreakpointEvent) then
+        if (not continue) and assigned(OnHitBreakpointEvent) then begin
+          if (CurWatch <> nil) then
+            OnHitBreakpointEvent(continue, CurWatch);
+          if assigned(FCurrentProcess.CurrentBreakpoint) then
             OnHitBreakpointEvent(continue, FCurrentProcess.CurrentBreakpoint);
           HasPauseRequest := False;
         end;
+      end;
     deExitProcess:
       begin
       (* Only events for the main process get here / See ProcessLoop *)

components/fpdebug/fpdbgdarwinclasses.pas

@@ -13,7 +13,7 @@ uses
   process,
   FpDbgClasses,
   FpDbgLoader,
-  DbgIntfBaseTypes,
+  DbgIntfBaseTypes, DbgIntfDebuggerBase,
   FpDbgLinuxExtra,
   FpDbgDwarfDataClasses,
   FpImgReaderMacho,
@@ -113,9 +113,10 @@ type
     function ReadDebugState: boolean;
   public
     function ResetInstructionPointerAfterBreakpoint: boolean; override;
-    function AddWatchpoint(AnAddr: TDBGPtr): integer; override;
+    function AddWatchpoint(AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): integer; override;
     function RemoveWatchpoint(AnId: integer): boolean; override;
-    function DetectHardwareWatchpoint: integer; override;
+    procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); override;
+    function DetectHardwareWatchpoint: Pointer; override;
     procedure BeforeContinue; override;
     procedure LoadRegisterValues; override;
 
@@ -144,6 +145,7 @@ type
     procedure InitializeLoaders; override;
     function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
     function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
+    function CreateWatchPointData: TFpWatchPointData; override;
   public
     class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
     constructor Create(const AName: string; const AProcessID, AThreadID: Integer); override;
@@ -382,128 +384,64 @@ type
   TDr32bitArr = array[0..4] of cuint32;
   TDr64bitArr = array[0..4] of cuint64;
 
-function TDbgDarwinThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
+procedure TDbgDarwinThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
-
+  procedure UpdateWatches32;
-  function SetBreakpoint32(ind: byte): boolean;
   var
     drArr: ^TDr32bitArr;
+    i: Integer;
+    r: boolean;
+    addr: cuint32;
   begin
     drArr := @FDebugState32.__dr0;
-    if (drArr^[ind]=0) and ((FDebugState32.__dr7 and (1 shl ind))=0) then
+
-    begin
+    r := True;
-      FDebugState32.__dr7 := FDebugState32.__dr7 or (1 shl (ind*2));
+    for i := 0 to 3 do begin
-      FDebugState32.__dr7 := FDebugState32.__dr7 or ($30000 shl (ind*4));
+      addr := cuint32(TFpIntelWatchPointData(AWatchPointData).Dr03[i]);
-      drArr^[ind]:=AnAddr;
+      drArr^[i]:=addr;
-      FDebugStateChanged:=true;
-      Result := True;
-    end
-    else
-    begin
-      result := False;
     end;
+    FDebugState32.__dr7 := (FDebugState32.__dr7 and $0000FF00);
+    if r then
+      FDebugState32.__dr7 := FDebugState32.__dr7 or cuint32(TFpIntelWatchPointData(AWatchPointData).Dr7);
   end;
 
-  function SetBreakpoint64(ind: byte): boolean;
+  procedure UpdateWatches64;
   var
     drArr: ^TDr64bitArr;
+    i: Integer;
+    r: boolean;
+    addr: cuint64;
   begin
     drArr := @FDebugState64.__dr0;
-    if (drArr^[ind]=0) and ((FDebugState64.__dr7 and (1 shl ind))=0) then
-    begin
-      FDebugState64.__dr7 := FDebugState64.__dr7 or (1 shl (ind*2));
-      FDebugState64.__dr7 := FDebugState64.__dr7 or ($30000 shl (ind*4));
-      drArr^[ind]:=AnAddr;
-      FDebugStateChanged:=true;
-      Result := True;
-    end
-    else
-    begin
-      result := False;
-    end;
-  end;
 
-var
+    r := True;
-  i: integer;
+    for i := 0 to 3 do begin
-begin
+      addr := cuint64(TFpIntelWatchPointData(AWatchPointData).Dr03[i]);
-  result := -1;
+      drArr^[i]:=addr;
-  if ID<0 then
-    Exit;
-  if not ReadDebugState then
-    exit;
-
-  i := 0;
-  if Process.Mode=dm32 then
-    while (i<4) and not SetBreakpoint32(i) do
-      inc(i)
-  else
-    while (i<4) and not SetBreakpoint64(i) do
-      inc(i);
-  if i=4 then
-    debugln(DBG_WARNINGS, 'No hardware breakpoint available.')
-  else
-    result := i;
-end;
-
-function TDbgDarwinThread.RemoveWatchpoint(AnId: integer): boolean;
-
-  function RemoveBreakpoint32(ind: byte): boolean;
-  var
-    drArr: ^TDr32bitArr;
-  begin
-    drArr := @FDebugState32.__dr0;
-    if (drArr^[ind]<>0) and ((FDebugState32.__dr7 and (1 shl (ind*2)))<>0) then
-    begin
-      FDebugState32.__dr7 := FDebugState32.__dr7 xor (1 shl (ind*2));
-      FDebugState32.__dr7 := FDebugState32.__dr7 xor ($30000 shl (ind*4));
-      drArr^[ind]:=0;
-      FDebugStateChanged:=true;
-      Result := True;
-    end
-    else
-    begin
-      result := False;
-      debugln(DBG_WARNINGS, 'HW watchpoint %d is not set.',[ind]);
-    end;
-  end;
-
-  function RemoveBreakpoint64(ind: byte): boolean;
-  var
-    drArr: ^TDr64bitArr;
-  begin
-    drArr := @FDebugState64.__dr0;
-    if (drArr^[ind]<>0) and ((FDebugState64.__dr7 and (1 shl (ind*2)))<>0) then
-    begin
-      FDebugState64.__dr7 := FDebugState64.__dr7 xor (1 shl (ind*2));
-      FDebugState64.__dr7 := FDebugState64.__dr7 xor ($30000 shl (ind*4));
-      drArr^[ind]:=0;
-      FDebugStateChanged:=true;
-      Result := True;
-    end
-    else
-    begin
-      result := False;
-      debugln(DBG_WARNINGS, 'HW watchpoint %d is not set.',[ind]);
     end;
+    FDebugState32.__dr7 := (FDebugState32.__dr7 and $0000FF00);
+    if r then
+      FDebugState32.__dr7 := FDebugState32.__dr7 or cuint64(TFpIntelWatchPointData(AWatchPointData).Dr7);
   end;
 
 begin
-  result := false;
   if ID<0 then
     Exit;
   if not ReadDebugState then
     exit;
 
   if Process.Mode=dm32 then
-    result := RemoveBreakpoint32(AnId)
+    result := UpdateWatches32
   else
-    result := RemoveBreakpoint64(AnId);
+    result := UpdateWatches64;
+  FDebugStateChanged:=true;
 end;
 
-function TDbgDarwinThread.DetectHardwareWatchpoint: integer;
+function TDbgDarwinThread.DetectHardwareWatchpoint: Pointer;
 var
   dr6: DWord;
+  wd: TFpIntelWatchPointData;
 begin
-  result := -1;
+  result := nil;
   if ID<0 then
     Exit;
   if ReadDebugState then
@@ -513,10 +451,13 @@ begin
     else
       dr6 := lo(FDebugState64.__dr6);
 
-    if dr6 and 1 = 1 then result := 0
+    wd := TFpIntelWatchPointData(Process.WatchPointData);
-    else if dr6 and 2 = 2 then result := 1
+    if dr6 and 1 = 1 then result := wd.Owner[0]
-    else if dr6 and 4 = 4 then result := 2
+    else if dr6 and 2 = 2 then result := wd.Owner[1]
-    else if dr6 and 8 = 8 then result := 3;
+    else if dr6 and 4 = 4 then result := wd.Owner[2]
+    else if dr6 and 8 = 8 then result := wd.Owner[3];
+    if (Result = nil) and ((dr6 and 15) <> 0) then
+      Result := Pointer(-1); // not owned watchpoint
     end;
 end;
 
@@ -526,7 +467,7 @@ var
   old_StateCnt: mach_msg_Type_number_t;
 begin
   inherited;
-  if Process.CurrentWatchpoint>-1 then
+  if Process.CurrentWatchpoint <> nil then
     begin
     if Process.Mode=dm32 then
       FDebugState32.__dr6:=0
@@ -680,6 +621,11 @@ begin
   result := TDbgDarwinThread.Create(Self, AthreadIdentifier, AthreadIdentifier)
 end;
 
+function TDbgDarwinProcess.CreateWatchPointData: TFpWatchPointData;
+begin
+  Result := TFpIntelWatchPointData.Create;
+end;
+
 constructor TDbgDarwinProcess.Create(const AName: string; const AProcessID,
   AThreadID: Integer);
 var

components/fpdebug/fpdbglinuxclasses.pas

@@ -15,7 +15,7 @@ uses
   process,
   FpDbgClasses,
   FpDbgLoader,
-  DbgIntfBaseTypes,
+  DbgIntfBaseTypes, DbgIntfDebuggerBase,
   FpDbgLinuxExtra,
   FpDbgInfo,
   FpDbgUtil,
@@ -261,9 +261,8 @@ type
     procedure ResetPauseStates;
   public
     function ResetInstructionPointerAfterBreakpoint: boolean; override;
-    function AddWatchpoint(AnAddr: TDBGPtr): integer; override;
+    procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); override;
-    function RemoveWatchpoint(AnId: integer): boolean; override;
+    function DetectHardwareWatchpoint: Pointer; override;
-    function DetectHardwareWatchpoint: integer; override;
     procedure BeforeContinue; override;
     procedure LoadRegisterValues; override;
 
@@ -290,6 +289,7 @@ type
     procedure InitializeLoaders; override;
     function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
     function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
+    function CreateWatchPointData: TFpWatchPointData; override;
   public
     class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
       AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
@@ -558,76 +558,42 @@ begin
   FUserRegsChanged:=true;
 end;
 
-function TDbgLinuxThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
+procedure TDbgLinuxThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
-var
-  dr7: PtrUInt;
-
-  function SetHWBreakpoint(ind: byte): boolean;
-  var
-    Addr: PtrUInt;
-  begin
-    result := false;
-    if ((dr7 and (1 shl ind))=0) then
-    begin
-      if not ReadDebugReg(ind, Addr) or (Addr<>0) then
-        Exit;
-
-      dr7 := dr7 or (1 shl (ind*2));
-      dr7 := dr7 or ($30000 shl (ind*4));
-      if WriteDebugReg(7, dr7) and WriteDebugReg(ind, AnAddr) then
-        result := true;
-    end;
-  end;
-
 var
   i: integer;
-begin
+  r: boolean;
-  result := -1;
-  if not ReadDebugReg(7, dr7) then
-    Exit;
-
-  i := 0;
-  while (i<4) and not SetHWBreakpoint(i) do
-    inc(i);
-  if i=4 then
-    DebugLn(DBG_WARNINGS, 'No hardware breakpoint available.')
-  else
-    result := i;
-end;
-
-function TDbgLinuxThread.RemoveWatchpoint(AnId: integer): boolean;
-var
   dr7: PtrUInt;
   addr: PtrUInt;
 begin
-  result := false;
+  if not ReadDebugReg(7, dr7) then
-  if not ReadDebugReg(7, dr7) or not ReadDebugReg(AnId, addr) then
     Exit;
 
-  if (addr<>0) and ((dr7 and (1 shl (AnId*2)))<>0) then
+  r := True;
-  begin
+  for i := 0 to 3 do begin
-    dr7 := dr7 xor (1 shl (AnId*2));
+    addr := PtrUInt(TFpIntelWatchPointData(AWatchPointData).Dr03[i]);
-    dr7 := dr7 xor ($30000 shl (AnId*4));
+    r := r and WriteDebugReg(i, addr);
-    if WriteDebugReg(AnId, 0) and WriteDebugReg(7, dr7) then
-      Result := True;
-  end
-  else
-  begin
-    DebugLn(DBG_WARNINGS, 'HW watchpoint %d is not set.',[AnId]);
   end;
+  Dr7 := (Dr7 and $0000FF00);
+  if r then
+    Dr7 := Dr7 or PtrUInt(TFpIntelWatchPointData(AWatchPointData).Dr7);
+  WriteDebugReg(7, dr7);
 end;
 
-function TDbgLinuxThread.DetectHardwareWatchpoint: integer;
+function TDbgLinuxThread.DetectHardwareWatchpoint: Pointer;
 var
   dr6: PtrUInt;
+  wd: TFpIntelWatchPointData;
 begin
-  result := -1;
+  result := nil;
   if ReadDebugReg(6, dr6) then
   begin
-    if dr6 and 1 = 1 then result := 0
+    wd := TFpIntelWatchPointData(Process.WatchPointData);
-    else if dr6 and 2 = 2 then result := 1
+    if dr6 and 1 = 1 then result := wd.Owner[0]
-    else if dr6 and 4 = 4 then result := 2
+    else if dr6 and 2 = 2 then result := wd.Owner[1]
-    else if dr6 and 8 = 8 then result := 3;
+    else if dr6 and 4 = 4 then result := wd.Owner[2]
+    else if dr6 and 8 = 8 then result := wd.Owner[3];
+    if (Result = nil) and ((dr6 and 15) <> 0) then
+      Result := Pointer(-1); // not owned watchpoint
   end;
 end;
 
@@ -639,7 +605,7 @@ begin
     exit;
 
   inherited;
-  if Process.CurrentWatchpoint>-1 then
+  if Process.CurrentWatchpoint <> nil then
     WriteDebugReg(6, 0);
 
   if FUserRegsChanged then
@@ -761,6 +727,11 @@ begin
     result := nil;
 end;
 
+function TDbgLinuxProcess.CreateWatchPointData: TFpWatchPointData;
+begin
+  Result := TFpIntelWatchPointData.Create;
+end;
+
 constructor TDbgLinuxProcess.Create(const AName: string; const AProcessID,
   AThreadID: Integer);
 begin

components/fpdebug/fpdbgwinclasses.pas

@@ -117,7 +117,7 @@ uses
   strutils,
   FpDbgInfo,
   FpDbgLoader,
-  DbgIntfBaseTypes,
+  DbgIntfBaseTypes, DbgIntfDebuggerBase,
   LazLoggerBase, UTF8Process;
 
 type
@@ -146,8 +146,8 @@ type
     procedure SetSingleStepOverBreakPoint;
     procedure EndSingleStepOverBreakPoint;
     procedure SetSingleStep;
-    function AddWatchpoint(AnAddr: TDBGPtr): integer; override;
+    procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); override;
-    function RemoveWatchpoint(AnId: integer): boolean; override;
+    function DetectHardwareWatchpoint: Pointer; override;
     procedure BeforeContinue; override;
     function ResetInstructionPointerAfterBreakpoint: boolean; override;
     function ReadThreadState: boolean;
@@ -175,6 +175,7 @@ type
     function GetHandle: THandle; override;
     function GetLastEventProcessIdentifier: THandle; override;
     procedure InitializeLoaders; override;
+    function CreateWatchPointData: TFpWatchPointData; override;
   public
     constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer); override;
     destructor Destroy; override;
@@ -476,6 +477,11 @@ begin
   TDbgImageLoader.Create(FInfo.hFile).AddToLoaderList(LoaderList);
 end;
 
+function TDbgWinProcess.CreateWatchPointData: TFpWatchPointData;
+begin
+  Result := TFpIntelWatchPointData.Create;
+end;
+
 constructor TDbgWinProcess.Create(const AFileName: string; const AProcessID,
   AThreadID: Integer);
 begin
@@ -812,7 +818,7 @@ begin
   DebugLn([dbgs(MDebugEvent), ' ', Result]);
   for TDbgThread(t) in FThreadMap do begin
   if t.ReadThreadState then
-    DebugLn('Thr.Id:%d %x  SSTep %s EF %s     DR6:%x  WP:%x  RegAcc: %d,  SStep: %d  Task: %d, ExcBrk: %d', [t.ID, t.GetInstructionPointerRegisterValue, dbgs(t.FCurrentContext^.def.EFlags and FLAG_TRACE_BIT), dbghex(t.FCurrentContext^.def.EFlags), t.FCurrentContext^.def.Dr6, t.FCurrentContext^.def.Dr6 and 15, t.FCurrentContext^.def.Dr6 and (1<< 13), t.FCurrentContext^.def.Dr6 and (1<< 14), t.FCurrentContext^.def.Dr6 and (1<< 15), t.FCurrentContext^.def.Dr6 and (1<< 16)]);
+    DebugLn('Thr.Id:%d %x  SSTep %s EF %s     DR6:%x  DR7:%x  WP:%x  RegAcc: %d,  SStep: %d  Task: %d, ExcBrk: %d', [t.ID, t.GetInstructionPointerRegisterValue, dbgs(t.FCurrentContext^.def.EFlags and FLAG_TRACE_BIT), dbghex(t.FCurrentContext^.def.EFlags), t.FCurrentContext^.def.Dr6, t.FCurrentContext^.def.Dr7, t.FCurrentContext^.def.Dr6 and 15, t.FCurrentContext^.def.Dr6 and (1<< 13), t.FCurrentContext^.def.Dr6 and (1<< 14), t.FCurrentContext^.def.Dr6 and (1<< 15), t.FCurrentContext^.def.Dr6 and (1<< 16)]);
   end;
   {$ENDIF}
 
@@ -1481,141 +1487,71 @@ begin
   FThreadContextChanged:=true;
 end;
 
-function TDbgWinThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
+procedure TDbgWinThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
-
-  function SetBreakpoint(var Dr, Dr7: DWORD; ind: byte): boolean;
 begin
-    if (Dr=0) and ((Dr7 and (1 shl ind))=0) then
-    begin
-      Dr7 := Dr7 or (1 shl (ind*2));
-      Dr7 := Dr7 or ($30000 shl (ind*4));
-      Dr:=AnAddr;
-      FThreadContextChanged:=true;
-      Result := True;
-    end
-    else
-      Result := False;
-  end;
-  function SetBreakpoint(var Dr, Dr7: DWORD64; ind: byte): boolean;
-  begin
-    if (Dr=0) and ((Dr7 and (1 shl ind))=0) then
-    begin
-      Dr7 := Dr7 or (1 shl (ind*2));
-      Dr7 := Dr7 or ($30000 shl (ind*4));
-      Dr:=AnAddr;
-      FThreadContextChanged:=true;
-      Result := True;
-    end
-    else
-      Result := False;
-  end;
-
-begin
-  result := -1;
   if FCurrentContext = nil then
     if not ReadThreadState then
       exit;
   {$ifdef cpux86_64}
   if (TDbgWinProcess(Process).FBitness = b32) then begin
-    with FCurrentContext^.WOW do
+    with FCurrentContext^.WOW do begin
-    if SetBreakpoint(Dr0, DR7, 0) then
+      Dr0 := DWORD(TFpIntelWatchPointData(AWatchPointData).Dr03[0]);
-      result := 0
+      Dr1 := DWORD(TFpIntelWatchPointData(AWatchPointData).Dr03[1]);
-    else if SetBreakpoint(Dr1, DR7, 1) then
+      Dr2 := DWORD(TFpIntelWatchPointData(AWatchPointData).Dr03[2]);
-      result := 1
+      Dr3 := DWORD(TFpIntelWatchPointData(AWatchPointData).Dr03[3]);
-    else if SetBreakpoint(Dr2, DR7, 2) then
+      Dr7 := (Dr7 and $0000FF00) or DWORD(TFpIntelWatchPointData(AWatchPointData).Dr7);
-      result := 2
+DebugLn('### WATCH ADDED  dr0 %x  dr1 %x  dr2 %x  dr3 %x      dr7 %x', [ dr0,dr1,dr2,dr3, dr7]);
-    else if SetBreakpoint(Dr3, DR7, 3) then
+    end;
-      result := 3
-    else
-      DebugLn(DBG_WARNINGS ,'No hardware breakpoint available.');
   end
   else begin
   {$endif}
-    with FCurrentContext^.def do
+    with FCurrentContext^.def do begin
-    if SetBreakpoint(Dr0, DR7, 0) then
+      Dr0 := TFpIntelWatchPointData(AWatchPointData).Dr03[0];
-      result := 0
+      Dr1 := TFpIntelWatchPointData(AWatchPointData).Dr03[1];
-    else if SetBreakpoint(Dr1, DR7, 1) then
+      Dr2 := TFpIntelWatchPointData(AWatchPointData).Dr03[2];
-      result := 1
+      Dr3 := TFpIntelWatchPointData(AWatchPointData).Dr03[3];
-    else if SetBreakpoint(Dr2, DR7, 2) then
+      Dr7 := (Dr7 and $0000FF00) or TFpIntelWatchPointData(AWatchPointData).Dr7;
-      result := 2
+DebugLn('### WATCH ADDED   dr0 %x  dr1 %x  dr2 %x  dr3 %x      dr7 %x', [ dr0,dr1,dr2,dr3, dr7]);
-    else if SetBreakpoint(Dr3, DR7, 3) then
+    end;
-      result := 3
-    else
-      DebugLn(DBG_WARNINGS ,'No hardware breakpoint available.');
   {$ifdef cpux86_64}
   end;
   {$endif}
-end;
-
-function TDbgWinThread.RemoveWatchpoint(AnId: integer): boolean;
-
-  function RemoveBreakpoint(var Dr, Dr7: DWORD; ind: byte): boolean;
-  begin
-    if (Dr<>0) and ((Dr7 and (1 shl (ind*2)))<>0) then
-    begin
-      Dr7 := Dr7 xor (1 shl (ind*2));
-      Dr7 := Dr7 xor ($30000 shl (ind*4));
-      Dr:=0;
   FThreadContextChanged:=true;
-      Result := True;
-    end
-    else
-    begin
-      result := False;
-      DebugLn(DBG_WARNINGS ,'HW watchpoint is not set.');
-    end;
-  end;
-  function RemoveBreakpoint(var Dr, Dr7: DWORD64; ind: byte): boolean;
-  begin
-    if (Dr<>0) and ((Dr7 and (1 shl (ind*2)))<>0) then
-    begin
-      Dr7 := Dr7 xor (1 shl (ind*2));
-      Dr7 := Dr7 xor ($30000 shl (ind*4));
-      Dr:=0;
-      FThreadContextChanged:=true;
-      Result := True;
-    end
-    else
-    begin
-      result := False;
-      DebugLn(DBG_WARNINGS ,'HW watchpoint is not set.');
-    end;
 end;
 
+function TDbgWinThread.DetectHardwareWatchpoint: Pointer;
+var
+  Dr6: DWORD64;
+  wd: TFpIntelWatchPointData;
 begin
-  Result := False;
+  result := nil;
   if FCurrentContext = nil then
     if not ReadThreadState then
       exit;
+
   {$ifdef cpux86_64}
   if (TDbgWinProcess(Process).FBitness = b32) then begin
-    with FCurrentContext^.WOW do
+    Dr6 := DWORD64(FCurrentContext^.WOW.Dr6);
-    case AnId of
-      0: result := RemoveBreakpoint(Dr0, DR7, 0);
-      1: result := RemoveBreakpoint(Dr1, DR7, 1);
-      2: result := RemoveBreakpoint(Dr2, DR7, 2);
-      3: result := RemoveBreakpoint(Dr3, DR7, 3);
-    end
   end
   else begin
   {$endif}
-    with FCurrentContext^.def do
+    Dr6 := FCurrentContext^.def.Dr6;
-    case AnId of
-      0: result := RemoveBreakpoint(Dr0, DR7, 0);
-      1: result := RemoveBreakpoint(Dr1, DR7, 1);
-      2: result := RemoveBreakpoint(Dr2, DR7, 2);
-      3: result := RemoveBreakpoint(Dr3, DR7, 3);
-    end
   {$ifdef cpux86_64}
   end;
   {$endif}
+
+  wd := TFpIntelWatchPointData(Process.WatchPointData);
+  if dr6 and 1 = 1 then result := wd.Owner[0]
+  else if dr6 and 2 = 2 then result := wd.Owner[1]
+  else if dr6 and 4 = 4 then result := wd.Owner[2]
+  else if dr6 and 8 = 8 then result := wd.Owner[3];
+  if (Result = nil) and ((dr6 and 15) <> 0) then
+    Result := Pointer(-1); // not owned watchpoint
 end;
 
 procedure TDbgWinThread.BeforeContinue;
 begin
-  if ID <> MDebugEvent.dwThreadId then
+  if ID = MDebugEvent.dwThreadId then begin
-    exit;
-
     inherited;
 
     {$ifdef cpux86_64}
@@ -1638,6 +1574,7 @@ begin
     {$ifdef cpux86_64}
     end;
     {$endif}
+  end;
 
   if FThreadContextChanged then
   begin

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -95,6 +95,8 @@ type
     FCacheLocation: TDBGPtr;
     FCacheBoolean: boolean;
     FCachePointer: pointer;
+    FCacheReadWrite: TDBGWatchPointKind;
+    FCacheScope: TDBGWatchPointScope;
     FCacheThreadId, FCacheStackFrame: Integer;
     FCacheContext: TFpDbgInfoContext;
     {$endif linux}
@@ -152,6 +154,7 @@ type
     FCallStackEntryListFrameRequired: Integer;
     procedure DoAddBreakLine;
     procedure DoAddBreakLocation;
+    procedure DoAddBWatch;
     procedure DoReadData;
     procedure DoPrepareCallStackEntryList;
     procedure DoFreeBreakpoint;
@@ -159,6 +162,8 @@ type
     {$endif linux}
     function AddBreak(const ALocation: TDbgPtr): TFpDbgBreakpoint; overload;
     function AddBreak(const AFileName: String; ALine: Cardinal): TFpDbgBreakpoint; overload;
+    function AddWatch(const ALocation: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind;
+                      AScope: TDBGWatchPointScope): TFpDbgBreakpoint;
     procedure FreeBreakpoint(const ABreakpoint: TFpDbgBreakpoint);
     function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; inline;
     function ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean;
@@ -861,19 +866,38 @@ begin
 end;
 
 procedure TFPBreakpoint.SetBreak;
+var
+  CurThreadId, CurStackFrame: Integer;
+  CurContext: TFpDbgInfoContext;
+  WatchPasExpr: TFpPascalExpression;
+  R: TFpValue;
+  s: QWord;
 begin
   assert(FInternalBreakpoint=nil);
   debuglnEnter(DBG_BREAKPOINTS, ['>> TFPBreakpoint.SetBreak  ADD ',FSource,':',FLine,'/',dbghex(Address),' ' ]);
   case Kind of
     bpkAddress:   FInternalBreakpoint := TFpDebugDebugger(Debugger).AddBreak(Address);
     bpkSource:    FInternalBreakpoint := TFpDebugDebugger(Debugger).AddBreak(Source, cardinal(Line));
-  else
+    bpkData: begin
-    Raise Exception.Create('Breakpoints of this kind are not suported.');
+        TFpDebugDebugger(Debugger).GetCurrentThreadAndStackFrame(CurThreadId, CurStackFrame);
+        CurContext := TFpDebugDebugger(Debugger).GetContextForEvaluate(CurThreadId, CurStackFrame);
+        if CurContext <> nil then begin
+          WatchPasExpr := TFpPascalExpression.Create(WatchData, CurContext);
+          R := WatchPasExpr.ResultValue; // Address and Size
+// TODO: Cache current value
+          if WatchPasExpr.Valid and IsTargetNotNil(R.Address) and R.GetSize(s) then begin
+// pass context
+            FInternalBreakpoint := TFpDebugDebugger(Debugger).AddWatch(R.Address.Address, s, WatchKind, WatchScope);
+          end;
+          WatchPasExpr.Free;
+          CurContext.ReleaseReference;
+        end;
+      end;
   end;
   debuglnExit(DBG_BREAKPOINTS, ['<< TFPBreakpoint.SetBreak ' ]);
   FIsSet:=true;
   if not assigned(FInternalBreakpoint) then
-    FValid:=vsInvalid
+    FValid:=vsInvalid // pending?
   else
     FValid:=vsValid;
 end;
@@ -1741,6 +1765,14 @@ begin
 
         if assigned(ABreakPoint) then
           ABreakPoint.Hit(&continue);
+
+        if (not &continue) and (ABreakPoint.Kind = bpkData) and (OnFeedback <> nil) then begin
+          // For message use location(Address - 1)
+          OnFeedback(self,
+              Format('The Watchpoint for "%1:s" was triggered.%0:s%0:s', // 'Old value: %2:s%0:sNew value: %3:s',
+                     [LineEnding, ABreakPoint.WatchData{, AOldVal, ANewVal}]),
+              '', ftInformation, [frOk]);
+        end;
       end;
     end
   else if FQuickPause then
@@ -1754,8 +1786,10 @@ begin
     ALocationAddr := GetLocation;
 
   // if &continue then SetState(dsInternalPause) else
+  if State <> dsPause then begin
     SetState(dsPause);
     DoCurrent(ALocationAddr);
+  end;
 
   if &continue then begin
     // wait for any watches for Snapshots
@@ -2056,6 +2090,11 @@ begin
   FCacheBreakpoint := FDbgController.CurrentProcess.AddBreak(FCacheLocation);
 end;
 
+procedure TFpDebugDebugger.DoAddBWatch;
+begin
+  FCacheBreakpoint := FDbgController.CurrentProcess.AddWatch(FCacheLocation, FCacheLine, FCacheReadWrite, FCacheScope);
+end;
+
 procedure TFpDebugDebugger.DoReadData;
 begin
   FCacheBoolean:=FDbgController.CurrentProcess.ReadData(FCacheLocation, FCacheLine, FCachePointer^);
@@ -2103,6 +2142,22 @@ begin
 {$endif linux}
 end;
 
+function TFpDebugDebugger.AddWatch(const ALocation: TDBGPtr; ASize: Cardinal;
+  AReadWrite: TDBGWatchPointKind; AScope: TDBGWatchPointScope
+  ): TFpDbgBreakpoint;
+begin
+{$ifdef linux}
+  FCacheLocation:=ALocation;
+  FCacheLine:=ASize;
+  FCacheReadWrite:=AReadWrite;
+  FCacheScope:=AScope;
+  ExecuteInDebugThread(@DoAddBWatch);
+  result := FCacheBreakpoint;
+{$else linux}
+  result := FDbgController.CurrentProcess.AddWatch(ALocation, ASize, AReadWrite, AScope);
+{$endif linux}
+end;
+
 procedure TFpDebugDebugger.FreeBreakpoint(
   const ABreakpoint: TFpDbgBreakpoint);
 begin