LazDebuggerFp (pure): Ability to pause debuggee (Windows)

git-svn-id: trunk@44749 -

components/fpdebug/fpdbgclasses.pp

@@ -237,6 +237,7 @@ type
     procedure RemoveThread(const AID: DWord);
     procedure Log(AString: string);
     procedure Log(AString: string; Options: array of const);
+    function  Pause: boolean; virtual;
 
     function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; virtual;
     function ReadOrdinal(const AAdress: TDbgPtr; out AData): Boolean; virtual;
@@ -681,6 +682,11 @@ begin
   Log(Format(AString, Options));
 end;
 
+function TDbgProcess.Pause: boolean;
+begin
+  result := false;
+end;
+
 function TDbgProcess.GetHandle: THandle;
 begin
   result := 0;

components/fpdebug/fpdbgcontroller.pas

@@ -51,6 +51,7 @@ type
     procedure StepIntoInstr;
     procedure StepOverInstr;
     procedure Next;
+    procedure Pause;
     procedure ProcessLoop;
     procedure SendEvents(out continue: boolean);
 
@@ -147,6 +148,11 @@ begin
   FCurrentThread.Next;
 end;
 
+procedure TDbgController.Pause;
+begin
+  FCurrentProcess.Pause;
+end;
+
 procedure TDbgController.ProcessLoop;
 
 var
@@ -223,7 +229,7 @@ begin
         end;
       deInternalContinue :
         begin
-          if FCurrentThread.Stepping then
+          if assigned(FCurrentThread) and FCurrentThread.Stepping then
             FCurrentThread.Next;
         end;
     end; {case}

components/fpdebug/fpdbgwinclasses.pas

@@ -77,6 +77,7 @@ type
   TDbgWinProcess = class(TDbgProcess)
   private
     FInfo: TCreateProcessDebugInfo;
+    FPauseRequested: boolean;
   protected
     function GetHandle: THandle; override;
     function GetLastEventProcessIdentifier: THandle; override;
@@ -100,6 +101,7 @@ type
 
     function GetInstructionPointerRegisterValue: TDbgPtr; override;
     function GetStackBasePointerRegisterValue: TDbgPtr; override;
+    function Pause: boolean; override;
 
     procedure TerminateProcess; override;
 
@@ -752,6 +754,10 @@ begin
                 result := deInternalContinue
               else
                 result := deBreakpoint;
+            end else if FPauseRequested
+            then begin
+              result := deBreakpoint;
+              FPauseRequested:=false;
             end
             else begin
               // Unknown breakpoint.
@@ -886,6 +892,18 @@ begin
 {$endif}
 end;
 
+function DebugBreakProcess(Process:HANDLE): WINBOOL; external 'kernel32' name 'DebugBreakProcess';
+
+function TDbgWinProcess.Pause: boolean;
+var
+  hndl: Handle;
+begin
+  hndl := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessID);
+  FPauseRequested:=true;
+  result := DebugBreakProcess(hndl);
+  CloseHandle(hndl);
+end;
+
 procedure TDbgWinProcess.TerminateProcess;
 begin
   Windows.TerminateProcess(Handle, 0);

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -699,6 +699,10 @@ begin
         StartDebugLoop;
         result := true;
       end;
+    dcPause:
+      begin
+        FDbgController.Pause;
+      end;
     dcStepOver:
       begin
         FDbgController.Next;
@@ -806,7 +810,7 @@ end;
 
 function TFpDebugDebugger.GetSupportedCommands: TDBGCommands;
 begin
-  Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver];
+  Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver, dcPause];
 end;
 
 end.