FpDebugDebugger: replace Control-thread with ThreadWorkQueue

git-svn-id: trunk@64020 -

.gitattributes

@@ -2618,6 +2618,7 @@ components/lazdebuggers/lazdebuggerfp/Makefile svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfp/Makefile.compiled svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfp/Makefile.fpc svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas svneol=native#text/plain
+components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerutils.pas svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.lpk svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.pas svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfp/test/LazDebFpTest.lpi svneol=native#text/plain

components/debuggerintf/dbgintfdebuggerbase.pp

@@ -1076,7 +1076,7 @@ type
 
   { TCallStackEntryBase }
 
-  TCallStackEntry = class(TObject)
+  TCallStackEntry = class(TFreeNotifyingObject)
   private
     FValidity: TDebuggerDataState;
     FIndex: Integer;
@@ -1482,6 +1482,13 @@ type
                        const AThreadId: Integer; const AThreadName: String;
                        const AThreadState: String;
                        AState: TDebuggerDataState = ddsValid);
+    procedure Init(const AnAdress: TDbgPtr;
+                       const AnArguments: TStrings; const AFunctionName: String;
+                       const FileName, FullName: String;
+                       const ALine: Integer;
+                       const AThreadId: Integer; const AThreadName: String;
+                       const AThreadState: String;
+                       AState: TDebuggerDataState = ddsValid);
     function CreateCopy: TThreadEntry; virtual;
     destructor Destroy; override;
     procedure Assign(AnOther: TThreadEntry); virtual;
@@ -2500,6 +2507,18 @@ begin
   FThreadState := AThreadState;
 end;
 
+procedure TThreadEntry.Init(const AnAdress: TDbgPtr;
+  const AnArguments: TStrings; const AFunctionName: String; const FileName,
+  FullName: String; const ALine: Integer; const AThreadId: Integer;
+  const AThreadName: String; const AThreadState: String;
+  AState: TDebuggerDataState);
+begin
+  TopFrame.Init(AnAdress, AnArguments, AFunctionName, FileName, FullName, ALine, AState);
+  FThreadId    := AThreadId;
+  FThreadName  := AThreadName;
+  FThreadState := AThreadState;
+end;
+
 function TThreadEntry.CreateCopy: TThreadEntry;
 begin
   Result := TThreadEntry.Create;

components/fpdebug/fpdbgclasses.pp

@@ -119,7 +119,17 @@ type
     property Index: integer read FIndex;
   end;
 
-  TDbgCallstackEntryList = specialize TFPGObjectList<TDbgCallstackEntry>;
+  { TDbgCallstackEntryList }
+
+  TDbgCallstackEntryList = class(specialize TFPGObjectList<TDbgCallstackEntry>)
+  private
+    FHasReadAllAvailableFrames: boolean;
+  protected
+    procedure SetHasReadAllAvailableFrames;
+  public
+    procedure Clear;
+    property HasReadAllAvailableFrames: boolean read FHasReadAllAvailableFrames;
+  end;
 
   TDbgProcess = class;
   TFpWatchPointData = class;
@@ -646,6 +656,7 @@ public
     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;
 
@@ -749,6 +760,19 @@ begin
     RegisteredDbgProcessClasses.Add(ADbgOsClasses);
 end;
 
+{ TDbgCallstackEntryList }
+
+procedure TDbgCallstackEntryList.SetHasReadAllAvailableFrames;
+begin
+  FHasReadAllAvailableFrames := True;
+end;
+
+procedure TDbgCallstackEntryList.Clear;
+begin
+  inherited Clear;
+  FHasReadAllAvailableFrames := False;
+end;
+
 { TOSDbgClasses }
 
 constructor TOSDbgClasses.Create(ADbgProcessClass: TDbgProcessClass;
@@ -2674,6 +2698,9 @@ 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;
 
@@ -2776,6 +2803,8 @@ begin
     If (NextIdx > MAX_FRAMES) then
       break;
   end;
+  if CountNeeded > 0 then // there was an error / not possible to read more frames
+    FCallStackEntryList.SetHasReadAllAvailableFrames;
 end;
 
 function TDbgThread.FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr;

components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerutils.pas

@@ -0,0 +1,210 @@
+{
+ ---------------------------------------------------------------------------
+ FpDebugDebuggerUtils
+ ---------------------------------------------------------------------------
+
+ ***************************************************************************
+ *                                                                         *
+ *   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 FpDebugDebuggerUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  FpDbgUtil, LazLoggerBase, sysutils, Classes, syncobjs;
+
+type
+
+  TFpThreadWorkerPriority = (
+    twpUser,
+    twpThread, twpStack, twpLocal, twpWatch,
+    twpContinue
+  );
+
+const
+  twpInspect = twpWatch;
+  twpDefault = twpUser;
+type
+
+  { TFpThreadPriorityWorkerItem }
+
+  TFpThreadPriorityWorkerItem = class(TFpThreadWorkerItem)
+  private
+    FPriority: TFpThreadWorkerPriority;
+  public
+    constructor Create(APriority: TFpThreadWorkerPriority);
+    function DebugText: String; override;
+    property Priority: TFpThreadWorkerPriority read FPriority;
+  end;
+
+  { TFpThreadPriorityWorkerQueue }
+
+  TFpThreadPriorityWorkerQueue = class(TFpThreadWorkerQueue)
+  private
+    function GetOnQueueIdle: TThreadMethod;
+    procedure SetOnQueueIdle(AValue: TThreadMethod);
+  protected type
+    TFpDbgTypedFifoQueue2 = TFpDbgTypedFifoQueue;
+    TFpDbgPriorytyFifoQueue = class(TFpDbgTypedFifoQueue2)
+    private
+      FOnQueueIdle: TThreadMethod;
+      FQueuedThread: TThread;
+      FQueues: array[TFpThreadWorkerPriority] of TFpDbgTypedFifoQueue2;
+      FLowestAvail: TFpThreadWorkerPriority;
+    public
+      constructor create(AQueueDepth: Integer = 10);
+      destructor Destroy; override;
+      function PushItem(const AItem: TFpThreadWorkerItem): Boolean; override;
+      function PopItem(out AItem: TFpThreadWorkerItem): Boolean; override;
+    end;
+  protected
+    function CreateFifoQueue(AQueueDepth: Integer): TLazTypedFifoQueue; override;
+  public
+    constructor Create(AQueueDepth: Integer = 10; PushTimeout: cardinal = INFINITE; PopTimeout: cardinal = INFINITE);
+    procedure Lock; inline;
+    procedure Unlock; inline;
+    function Count: Integer;
+    property OnQueueIdle: TThreadMethod read GetOnQueueIdle write SetOnQueueIdle;
+  end;
+
+
+implementation
+
+var
+  FPDBG_QUEUE: PLazLoggerLogGroup;
+
+{ TFpThreadPriorityWorkerItem }
+
+constructor TFpThreadPriorityWorkerItem.Create(
+  APriority: TFpThreadWorkerPriority);
+begin
+  FPriority := APriority;
+end;
+
+function TFpThreadPriorityWorkerItem.DebugText: String;
+begin
+  WriteStr(Result, FPriority);
+  Result := inherited DebugText + '[' + Result + ':' + IntToStr(ord(FPriority)) + ']';
+end;
+
+{ TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue }
+
+constructor TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.create(
+  AQueueDepth: Integer);
+var
+  a: TFpThreadWorkerPriority;
+begin
+  inherited create(0);
+  for a in TFpThreadWorkerPriority do
+    FQueues[a] := TFpDbgTypedFifoQueue2.create(AQueueDepth);
+end;
+
+destructor TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.Destroy;
+var
+  a: TFpThreadWorkerPriority;
+begin
+  TThread.RemoveQueuedEvents(FQueuedThread, FOnQueueIdle);
+  inherited Destroy;
+  for a in TFpThreadWorkerPriority do
+    FQueues[a].Free;
+end;
+
+function TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.PushItem(
+  const AItem: TFpThreadWorkerItem): Boolean;
+begin
+  TThread.RemoveQueuedEvents(FQueuedThread, FOnQueueIdle);
+  inc(FTotalItemsPushed);
+  if not (AItem is TFpThreadPriorityWorkerItem) then begin
+    Result := FQueues[twpDefault].PushItem(AItem);
+    if twpDefault < FLowestAvail then
+      FLowestAvail := twpDefault;
+  end
+  else begin
+    Result := FQueues[TFpThreadPriorityWorkerItem(AItem).FPriority].PushItem(AItem);
+    if TFpThreadPriorityWorkerItem(AItem).FPriority < FLowestAvail then
+      FLowestAvail := TFpThreadPriorityWorkerItem(AItem).FPriority;
+  end;
+end;
+
+function TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.PopItem(out
+  AItem: TFpThreadWorkerItem): Boolean;
+begin
+  Result := FQueues[FLowestAvail].PopItem(AItem);
+  while (not Result) and (FLowestAvail < high(FLowestAvail)) do begin
+    inc(FLowestAvail);
+    Result := FQueues[FLowestAvail].PopItem(AItem);
+  end;
+  if Result then begin
+    inc(FTotalItemsPopped)
+  end
+  else begin
+    // IDLE => there is only one worker thread, so no other items are running
+    FQueuedThread := TThread.CurrentThread;
+    TThread.Queue(FQueuedThread, FOnQueueIdle);
+  end;
+  assert(result or (TotalItemsPushed=TotalItemsPopped), 'TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.PopItem: result or (TotalItemsPushed=TotalItemsPopped)');
+end;
+
+{ TFpThreadPriorityWorkerQueue }
+
+function TFpThreadPriorityWorkerQueue.GetOnQueueIdle: TThreadMethod;
+begin
+  Result := TFpDbgPriorytyFifoQueue(FifoQueue).FOnQueueIdle;
+end;
+
+procedure TFpThreadPriorityWorkerQueue.SetOnQueueIdle(AValue: TThreadMethod);
+begin
+  TFpDbgPriorytyFifoQueue(FifoQueue).FOnQueueIdle := AValue;
+end;
+
+function TFpThreadPriorityWorkerQueue.CreateFifoQueue(AQueueDepth: Integer
+  ): TLazTypedFifoQueue;
+begin
+  Result := TFpDbgPriorytyFifoQueue.Create(AQueueDepth);
+end;
+
+constructor TFpThreadPriorityWorkerQueue.Create(AQueueDepth: Integer;
+  PushTimeout: cardinal; PopTimeout: cardinal);
+begin
+  inherited Create(AQueueDepth, PushTimeout, PopTimeout);
+  FLogGroup := FPDBG_QUEUE;
+end;
+
+procedure TFpThreadPriorityWorkerQueue.Lock;
+begin
+  inherited Lock;
+end;
+
+procedure TFpThreadPriorityWorkerQueue.Unlock;
+begin
+  inherited Unlock;
+end;
+
+function TFpThreadPriorityWorkerQueue.Count: Integer;
+begin
+  Result := TotalItemsPushed - TotalItemsPopped;
+end;
+
+initialization
+  FPDBG_QUEUE := DebugLogger.FindOrRegisterLogGroup('FPDBG_QUEUE' {$IFDEF FPDBG_QUEUE} , True {$ENDIF} );
+end.
+

components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.lpk

@@ -19,23 +19,27 @@
 "/>
     <License Value="GPLv2"/>
     <Version Minor="9"/>
-    <Files Count="1">
-      <Item1>
+    <Files>
+      <Item>
         <Filename Value="fpdebugdebugger.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="FpDebugDebugger"/>
-      </Item1>
+      </Item>
+      <Item>
+        <Filename Value="fpdebugdebuggerutils.pas"/>
+        <UnitName Value="FpDebugDebuggerUtils"/>
+      </Item>
     </Files>
-    <RequiredPkgs Count="3">
-      <Item1>
+    <RequiredPkgs>
+      <Item>
         <PackageName Value="fpdebug"/>
-      </Item1>
-      <Item2>
+      </Item>
+      <Item>
         <PackageName Value="DebuggerIntf"/>
-      </Item2>
-      <Item3>
+      </Item>
+      <Item>
         <PackageName Value="FCL"/>
-      </Item3>
+      </Item>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.pas

@@ -8,7 +8,7 @@ unit LazDebuggerFp;
 interface
 
 uses
-  FpDebugDebugger, LazarusPackageIntf;
+  FpDebugDebugger, FpDebugDebuggerUtils, LazarusPackageIntf;
 
 implementation