Merged revision(s) 59439 #fdd25c4c9c, 59443 #9b2f44b8c8, 59445 #59e211fd44 from trunk:

Debugger, asm dialog: fix mouse wheel scrolling
........
Lldb/Gdb - FpDebug: fix crash in pretty printer when called from lldb/gdb mixed debugger (MemManager not set)
........
lldb debugger: Fixed "stop" => now works while running. Implemented "pause"
........

git-svn-id: branches/fixes_2_0@59460 -

components/fpdebug/fppascalbuilder.pas

@@ -680,7 +680,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
       exit;
     end;
 
-    Cache := MemManager.CacheManager.AddCache(AValue.DataAddress.Address, AValue.DataSize);
+    if (MemManager <> nil) and (MemManager.CacheManager <> nil) then
+      Cache := MemManager.CacheManager.AddCache(AValue.DataAddress.Address, AValue.DataSize)
+    else
+      Cache := nil;
     try
 
       if (ppvCreateDbgType in AFlags) then begin
@@ -764,7 +767,8 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
         APrintedValue := '(' + APrintedValue + ')';
       Result := True;
     finally
-      MemManager.CacheManager.RemoveCache(Cache)
+      if Cache <> nil then
+        MemManager.CacheManager.RemoveCache(Cache)
     end;
   end;
 

components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp

@@ -276,6 +276,7 @@ begin
     exit;
   end;
   FpDebugger.FPrettyPrinter.AddressSize := ctx.SizeOfAddress;
+  FpDebugger.FPrettyPrinter.MemManager := ctx.MemManager;
 
   ALocals.Clear;
   for i := 0 to ProcVal.MemberCount - 1 do begin

components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas

@@ -285,6 +285,7 @@ begin
       exit;
     end;
     FpDebugger.FPrettyPrinter.AddressSize := ctx.SizeOfAddress;
+    FpDebugger.FPrettyPrinter.MemManager := ctx.MemManager;
 
     ALocals.Clear;
     for i := 0 to ProcVal.MemberCount - 1 do begin

components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas

@@ -37,6 +37,7 @@ type
   public
     constructor Create(ADebugger: TLldbDebugger);
     destructor Destroy; override;
+    procedure CancelAll;
     procedure LockQueueRun;
     procedure UnLockQueueRun;
     property Items[Index: Integer]: TLldbDebuggerCommand read Get write Put; default;
@@ -50,12 +51,14 @@ type
   TLldbDebuggerCommand = class(TRefCountedObject)
   private
     FOwner: TLldbDebugger;
+    FIsRunning: Boolean;
     function GetDebuggerState: TDBGState;
     function GetCommandQueue: TLldbDebuggerCommandQueue;
     function GetInstructionQueue: TLldbInstructionQueue;
   protected
     procedure DoLineDataReceived(var ALine: String); virtual;
     procedure DoExecute; virtual; abstract;
+    procedure DoCancel; virtual;
     procedure Finished;
 
     procedure InstructionSucceeded(AnInstruction: TObject);
@@ -71,6 +74,7 @@ type
     constructor Create(AOwner: TLldbDebugger);
     destructor Destroy; override;
     procedure Execute;
+    procedure Cancel;
   end;
 
   { TLldbDebuggerCommandInit }
@@ -117,6 +121,7 @@ type
   protected
     FStepAction: TLldbInstructionProcessStepAction;
     procedure DoLineDataReceived(var ALine: String); override;
+    procedure DoCancel; override;
   public
     constructor Create(AOwner: TLldbDebugger);
     destructor Destroy; override;
@@ -253,6 +258,7 @@ type
     function  LldbRun: Boolean;
     function  LldbStep(AStepAction: TLldbInstructionProcessStepAction): Boolean;
     function  LldbStop: Boolean;
+    function  LldbPause: Boolean;
     function  LldbEvaluate(const AExpression: String; EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
     function  LldbEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
   protected
@@ -1009,6 +1015,14 @@ begin
 
 end;
 
+procedure TLldbDebuggerCommandRun.DoCancel;
+begin
+  InstructionQueue.CancelAllForCommand(Self); // in case there still are any
+  DeleteTempBreakPoint;
+  // Must not call Finished; => would cancel DeleteTempBreakPoint;
+  CommandQueue.CommandFinished(Self);
+end;
+
 procedure TLldbDebuggerCommandRun.RunInstructionSucceeded(AnInstruction: TObject
   );
 begin
@@ -1838,6 +1852,21 @@ DebugLnExit(['<<< CommandQueue.Run (Destroy)', FRunningCommand.ClassName, ', ',
   inherited Destroy;
 end;
 
+procedure TLldbDebuggerCommandQueue.CancelAll;
+var
+  i: Integer;
+begin
+  i := Count - 1;
+  while i >= 0 do begin
+    Items[i].Cancel;
+    dec(i);
+    if i > Count then
+      i := Count - 1;
+  end;
+  if FRunningCommand <> nil then
+    FRunningCommand.Cancel;
+end;
+
 procedure TLldbDebuggerCommandQueue.LockQueueRun;
 begin
   inc(FLockQueueRun);
@@ -1914,6 +1943,7 @@ procedure TLldbDebuggerCommand.Execute;
 var
   d: TLldbDebugger;
 begin
+  FIsRunning := True;
   d := Debugger;
   try
     d.LockRelease;
@@ -1923,11 +1953,23 @@ begin
   end;
 end;
 
+procedure TLldbDebuggerCommand.Cancel;
+begin
+  Debugger.CommandQueue.Remove(Self); // current running command is not on queue // dec refcount, may call destroy
+  if FIsRunning then
+    DoCancel;  // should call CommandQueue.CommandFinished
+end;
+
 procedure TLldbDebuggerCommand.DoLineDataReceived(var ALine: String);
 begin
   //
 end;
 
+procedure TLldbDebuggerCommand.DoCancel;
+begin
+  //
+end;
+
 { TLldbDebuggerCommandInit }
 
 procedure TLldbDebuggerCommandInit.DoExecute;
@@ -2432,11 +2474,22 @@ begin
   DebugLn('*** Stop');
   Result := True;
 
+  CommandQueue.CancelAll;
   Cmd := TLldbDebuggerCommandStop.Create(Self);
   QueueCommand(Cmd);
   Cmd.ReleaseReference;
 end;
 
+function TLldbDebugger.LldbPause: Boolean;
+var
+  Instr: TLldbInstruction;
+begin
+  Result := True;
+  Instr := TLldbInstructionProcessInterrupt.Create();
+  FDebugInstructionQueue.QueueInstruction(Instr);
+  Instr.ReleaseReference;
+end;
+
 function TLldbDebugger.LldbEvaluate(const AExpression: String;
   EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
 var
@@ -2569,8 +2622,8 @@ end;
 function TLldbDebugger.GetSupportedCommands: TDBGCommands;
 begin
   Result := [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOut, dcEvaluate,
-             dcStepOverInstr, dcStepIntoInstr, dcEnvironment];
-//  Result := [dcPause, dcRunTo, dcAttach, dcDetach, dcJumpto,
+             dcStepOverInstr, dcStepIntoInstr, dcPause, dcEnvironment];
+//  Result := [dcRunTo, dcAttach, dcDetach, dcJumpto,
 //             dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
 //             dcSetStackFrame, dcDisassemble
 //            ];
@@ -2585,7 +2638,7 @@ begin
   try
     case ACommand of
       dcRun:         Result := LldbRun;
-      //dcPause:       Result := ;
+      dcPause:       Result := LldbPause;
       dcStop:        Result := LldbStop;
       dcStepOver:    Result := LldbStep(saOver);
       dcStepInto:    Result := LldbStep(saInto);

components/lazdebuggers/lazdebuggerlldb/lldbinstructions.pas

@@ -132,6 +132,15 @@ type
     constructor Create();
   end;
 
+  { TLldbInstructionProcessInterrupt }
+
+  TLldbInstructionProcessInterrupt = class(TLldbInstruction)
+  protected
+    function ProcessInputFromDbg(const AData: String): Boolean; override;
+  public
+    constructor Create();
+  end;
+
   { TLldbInstructionBreakOrWatchSet }
 
   TLldbInstructionBreakOrWatchSet = class(TLldbInstruction)
@@ -721,6 +730,20 @@ begin
   inherited Create('process kill');
 end;
 
+{ TLldbInstructionProcessInterrupt }
+
+function TLldbInstructionProcessInterrupt.ProcessInputFromDbg(
+  const AData: String): Boolean;
+begin
+  Result := True;
+  SetContentReceieved;
+end;
+
+constructor TLldbInstructionProcessInterrupt.Create();
+begin
+  inherited Create('process interrupt');
+end;
+
 { TLldbInstructionBreakSet }
 
 constructor TLldbInstructionBreakSet.Create(AFileName: String; ALine: Integer;

debugger/assemblerdlg.pp

@@ -85,6 +85,7 @@ type
     procedure Timer1Timer(Sender: TObject);
     procedure ToolButtonPowerClick(Sender: TObject);
   private
+    FWheelAccu: Integer;
     FDebugger: TDebuggerIntf;
     FDebugManager: TBaseDebugManager;
     FDisassembler: TIDEDisassembler;
@@ -598,7 +599,12 @@ begin
   if not ToolButtonPower.Down then exit;
   Handled := True;
 
-  j := WheelDelta div 120;
+  FWheelAccu := FWheelAccu + WheelDelta;
+  j := FWheelAccu div 120;
+  if j = 0 then
+    exit;
+
+  FWheelAccu := FWheelAccu - j * 120;
   i := FTopLine ;
   if FSelectLine <> MaxInt
   then SetSelection(FSelectLine - j, False, ssShift in Shift);