LazDebuggerFp: Improve shutdown of thread queue.

git-svn-id: trunk@64535 -

components/fpdebug/fpdbgutil.pp

@@ -71,6 +71,7 @@ type
   protected
     procedure DoExecute; virtual;
     procedure DoFinished; virtual;
+    procedure DoUnQueued; virtual; // When queue shuts down / Not called when Item is Cancelled
 
     procedure ExecuteInThread(MyWorkerThread: TFpWorkerThread); // called by worker thread
     procedure WaitForFinish(AnMainWaitEvent: PRTLEvent; AWaitForExecInThread: Boolean); // called by main thread => calls DoExecute, if needed
@@ -133,6 +134,9 @@ type
     destructor Destroy; override; // Will not wait for the threads.
 
     procedure Clear; // Not thread safe // remove all none running items
+    procedure TerminateAllThreads(AWait: Boolean = False);
+    procedure DoProcessMessages; virtual;
+
     procedure PushItem(const AItem: TFpThreadWorkerItem);
     procedure PushItemIdleOrRun(const AItem: TFpThreadWorkerItem);
 
@@ -206,6 +210,9 @@ property FpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue read GetFpDbgGlobalW
 function dbgsThread: String;
 function dbgsWorkItemState(AState: Integer): String;
 
+var
+  ProcessMessagesProc: procedure of object; // Application.ProcessMessages, if needed. To be called while waiting.
+
 implementation
 
 
@@ -558,6 +565,11 @@ begin
     Destroy;
 end;
 
+procedure TFpThreadWorkerItem.DoUnQueued;
+begin
+  //
+end;
+
 procedure TFpThreadWorkerItem.ExecuteInThread(MyWorkerThread: TFpWorkerThread);
 var
   OldState: Cardinal;
@@ -706,7 +718,7 @@ var
   IsMarkedIdle: Boolean;
 begin
   IsMarkedIdle := False;
-  while not Terminated do begin
+  while not (Terminated or FQueue.ShutDown) do begin
     if (FQueue.PopItemTimeout(WorkItem, 0) <> wrSignaled) or
        (WorkItem = nil)
     then begin
@@ -869,40 +881,9 @@ begin
 end;
 
 destructor TFpThreadWorkerQueue.Destroy;
-var
-  WorkItem: TFpThreadWorkerItem;
-  i: Integer;
-  mt: Boolean;
 begin
-  Lock;
-  FThreadMonitor.Enter;
-  try
-    for i := 0 to FWorkerThreadList.Count - 1 do
-      FWorkerThreadList[i].Terminate; // also signals that the queue is no longer valid
-
-    while TryPopItemUnprotected(WorkItem) do begin
-      WorkItem.RequestStop;
-      WorkItem.DecRef;
-    end;
-  finally
-    FThreadMonitor.Leave;
-    Unlock;
-  end;
-
-  ThreadCount := 0;
-
-  // Wait for threads.
-  mt := MainThreadID = ThreadID;
-  while CurrentCount > 0 do begin
-    sleep(1);
-    if mt then
-      CheckSynchronize(1);
-    if TotalItemsPushed = TotalItemsPopped then
-      ThreadCount := 0; // Add more TFpThreadWorkerTerminateItem
-  end;
-
-  // Free any TFpThreadWorkerTerminateItem items that were not picked up
-  Clear;
+  DoShutDown;
+  TerminateAllThreads(True);
 
   inherited Destroy;
   FWorkerThreadList.Free;
@@ -914,8 +895,67 @@ procedure TFpThreadWorkerQueue.Clear;
 var
   WorkItem: TFpThreadWorkerItem;
 begin
-  while PopItemTimeout(WorkItem, 1) = wrSignaled do
-    WorkItem.DecRef;
+  Lock;
+  try
+    while TryPopItemUnprotected(WorkItem) do begin
+      WorkItem.DoUnQueued;
+      WorkItem.DecRef;
+    end;
+  finally
+    Unlock;
+  end;
+end;
+
+procedure TFpThreadWorkerQueue.TerminateAllThreads(AWait: Boolean);
+var
+  WorkItem: TFpThreadWorkerItem;
+  i: Integer;
+  mt: Boolean;
+begin
+  Lock;
+  FThreadMonitor.Enter;
+  try
+    ThreadCount := 0;
+
+    for i := 0 to FWorkerThreadList.Count - 1 do
+      FWorkerThreadList[i].Terminate; // also signals that the queue is no longer valid
+
+    while TryPopItemUnprotected(WorkItem) do begin
+      WorkItem.RequestStop;
+      WorkItem.DoUnQueued;
+      WorkItem.DecRef;
+    end;
+  finally
+    FThreadMonitor.Leave;
+    Unlock;
+  end;
+
+  ThreadCount := 0;
+
+  if AWait then begin
+    // Wait for threads.
+    i := 0;
+    mt := MainThreadID = ThreadID;
+    while CurrentCount > 0 do begin
+      sleep(1);
+      if mt then begin
+        CheckSynchronize(1);
+        if (i and 15) = 0 then
+          DoProcessMessages;
+      end;
+      if (not ShutDown) and (TotalItemsPushed = TotalItemsPopped) then
+        ThreadCount := 0; // Add more TFpThreadWorkerTerminateItem      inc(i);
+      inc(i);
+    end;
+    // Free any TFpThreadWorkerTerminateItem items that were not picked up
+    Clear;
+  end;
+end;
+
+procedure TFpThreadWorkerQueue.DoProcessMessages;
+begin
+  if ProcessMessagesProc <> nil then
+    ProcessMessagesProc();
 end;
 
 procedure TFpThreadWorkerQueue.PushItem(const AItem: TFpThreadWorkerItem);
@@ -923,6 +963,11 @@ begin
   DebugLn(FLogGroup and DBG_VERBOSE, '%s!%s PUSH WorkItem: "%s"', [dbgsThread, DbgSTime, AItem.DebugText]);
   AItem.FLogGroup := FLogGroup;
   AItem.AddRef;
+  if ShutDown or (ThreadCount = 0) then begin
+    AItem.DoUnQueued;
+    AItem.DecRef;
+    exit;
+  end;
   inherited PushItem(AItem);
 end;
 
@@ -934,6 +979,11 @@ begin
   DebugLn(FLogGroup and DBG_VERBOSE, '%s!%s PUSHorRUN WorkItem: "%s"', [dbgsThread, DbgSTime, AItem.DebugText]);
   AItem.FLogGroup := FLogGroup;
   AItem.AddRef;
+  if ShutDown or (ThreadCount = 0) then begin
+    AItem.DoUnQueued;
+    AItem.DecRef;
+    exit;
+  end;
   Lock;
   try
     q := IdleThreadCount > 0;

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -263,7 +263,6 @@ type
     (* Each thread must only lock max one item at a time.
        This ensures the locking will be dead-lock free.
     *)
-    FWorkThread: TThread; // for TThread.queue / 3.0.4 can only unqueue if there is a thread
     FWorkerThreadId: TThreadID;
     FEvalWorkItem: TFpThreadWorkerCmdEval;
     FQuickPause, FPauseForEvent, FSendingEvents: boolean;
@@ -580,9 +579,13 @@ end;
 { TFpThreadWorkerRunLoopUpdate }
 
 procedure TFpThreadWorkerRunLoopUpdate.LoopFinished_DecRef(Data: PtrInt);
+var
+  dbg: TFpDebugDebugger;
 begin
-  Application.QueueAsyncCall(@FpDebugger.DebugLoopFinished, 0);
+  dbg := FpDebugger;
   UnQueue_DecRef;
+  // self may now be invalid
+  dbg.DebugLoopFinished(0);
 end;
 
 { TFpThreadWorkerRunLoopAfterIdleUpdate }
@@ -2878,8 +2881,8 @@ end;
 
 procedure TFpDebugDebugger.FreeDebugThread;
 begin
-  FWorkQueue.ThreadCount := 0;
-  FWorkThread := nil;
+  FWorkQueue.TerminateAllThreads(True);
+  Application.ProcessMessages; // run the AsyncMethods
 end;
 
 procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(
@@ -3066,8 +3069,8 @@ begin
         Exit;
       end;
     end;
+    FWorkQueue.Clear;
     FWorkQueue.ThreadCount := 1;
-    FWorkThread := FWorkQueue.Threads[0];
     WorkItem := TFpThreadWorkerControllerRun.Create(Self);
     FWorkQueue.PushItem(WorkItem);
     FWorkQueue.WaitForItem(WorkItem, True);
@@ -3323,6 +3326,8 @@ end;
 procedure TFpDebugDebugger.DoRelease;
 begin
   DebugLn(DBG_VERBOSE, ['++++ dorelase  ', Dbgs(ptrint(FDbgController)), dbgs(state)]);
+  if FWorkQueue <> nil then
+    FWorkQueue.OnQueueIdle := nil;
 //  SetState(dsDestroying);
   if (State <> dsDestroying) and //assigned(FFpDebugThread) and //???
      (FDbgController <> nil) and (FDbgController.MainProcess <> nil)
@@ -3682,6 +3687,7 @@ begin
   if FEvalWorkItem <> nil then begin
     FEvalWorkItem.Abort;
     FEvalWorkItem.DecRef;
+    FEvalWorkItem := nil;
   end;
 end;
 
@@ -3697,6 +3703,7 @@ end;
 
 constructor TFpDebugDebugger.Create(const AExternalDebugger: String);
 begin
+  ProcessMessagesProc := @Application.ProcessMessages;
   inherited Create(AExternalDebugger);
   FLockList := TFpDbgLockList.Create;
   FWorkQueue := TFpThreadPriorityWorkerQueue.Create(100);
@@ -3726,14 +3733,18 @@ end;
 
 destructor TFpDebugDebugger.Destroy;
 begin
+  FWorkQueue.OnQueueIdle := nil;
+  FWorkQueue.DoShutDown;
   StopAllWorkers;
+  FWorkQueue.TerminateAllThreads(False);
 
   if state in [dsPause, dsInternalPause] then
     try
       SetState(dsStop);
     except
     end;
-  StopAllWorkers; // In case state change added workes
+  FWorkQueue.TerminateAllThreads(True);
+  Application.ProcessMessages; // run the AsyncMethods
 
   Application.RemoveAsyncCalls(Self);
   FreeAndNil(FDbgController);

components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas

@@ -306,7 +306,6 @@ procedure TFpDbgDebggerThreadWorkerItem.UnQueue_DecRef(ABlockQueuing: Boolean);
 var
   HasQ: THasQueued;
 begin
-  assert(system.ThreadID = Classes.MainThreadID, 'TFpDbgDebggerThreadWorkerItem.UnQueue_DecRef: system.ThreadID = classes.MainThreadID');
   FDebugger.FLockList.Lock;
   HasQ := FHasQueued;
   if ABlockQueuing then begin

components/lazutils/lazcollections.pas

@@ -275,7 +275,7 @@ begin
     RTLeventSetEvent(FHasItemEvent);
 
   RTLeventResetEvent(FHasRoomEvent);
-  if not FFifoQueue.IsFull then
+  if ShutDown or not FFifoQueue.IsFull then
     RTLeventSetEvent(FHasRoomEvent);
 end;
 
@@ -286,7 +286,7 @@ begin
     RTLeventSetEvent(FHasRoomEvent);
 
   RTLeventResetEvent(FHasItemEvent);
-  if not FFifoQueue.IsEmpty then
+  if ShutDown or not FFifoQueue.IsEmpty then
     RTLeventSetEvent(FHasItemEvent);
 end;