FpDebugServer: Moved handling of the console to a separate thread.

git-svn-id: trunk@49032 -

.gitattributes

@@ -1344,6 +1344,7 @@ components/fpdebug/app/fpd/fpdtype.pas svneol=native#text/pascal
 components/fpdebug/app/fpdd/fpdumpdwarf.lpi svneol=native#text/plain
 components/fpdebug/app/fpdd/fpdumpdwarf.lpr svneol=native#text/pascal
 components/fpdebug/app/fpdserver/Info.plist svneol=native#text/plain
+components/fpdebug/app/fpdserver/debugconsoleserver.pas svneol=native#text/plain
 components/fpdebug/app/fpdserver/debuginoutputprocessor.pas svneol=native#text/plain
 components/fpdebug/app/fpdserver/debugtcpserver.pas svneol=native#text/plain
 components/fpdebug/app/fpdserver/debugthread.pas svneol=native#text/plain

components/fpdebug/app/fpdserver/debugconsoleserver.pas

@@ -0,0 +1,104 @@
+unit DebugConsoleServer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  debugthread,
+  DebugInOutputProcessor,
+  lazCollections,
+  syncobjs,
+  pipes;
+
+type
+
+  TFpDebugEventQueue = specialize TLazThreadedQueue<TFpDebugEvent>;
+
+  { TFpDebugConsoleServer }
+
+  TFpDebugConsoleServer = class(TThread, IFpDebugListener)
+  private
+    FDebugThread: TFpDebugThread;
+    FConnectionIdentifier: integer;
+    FInOutputProcessor: TJSonInOutputProcessor;
+    FEventQueue: TFpDebugEventQueue;
+  protected
+    procedure Execute; override;
+  public
+    constructor create(ADebugThread: TFpDebugThread);
+    function GetOrigin: string;
+    procedure SendEvent(AnEvent: TFpDebugEvent);
+    destructor Destroy; override;
+  end;
+
+implementation
+
+{ TFpDebugConsoleServer }
+
+procedure TFpDebugConsoleServer.Execute;
+var
+  InputStream: TInputPipeStream;
+  DebugEvent: TFpDebugEvent;
+  CommandStr: string;
+  ACommand: TFpDebugThreadCommand;
+  b: char;
+begin
+  InputStream:=TInputPipeStream.Create(StdInputHandle);
+  FInOutputProcessor := TJSonInOutputProcessor.create(FConnectionIdentifier, @FDebugThread.SendLogMessage);
+  FConnectionIdentifier := FDebugThread.AddListener(self);
+  try
+    while not terminated do
+      begin
+      if FEventQueue.PopItem(DebugEvent) = wrSignaled then
+        begin
+        writeln(FInOutputProcessor.EventToText(DebugEvent));
+        end;
+      while InputStream.NumBytesAvailable>0 do
+        begin
+        InputStream.Read(b,sizeof(b));
+        if b <> #10 then
+          CommandStr:=CommandStr+b
+        else
+          begin
+          ACommand := FInOutputProcessor.TextToCommand(CommandStr);
+          if assigned(ACommand) then
+            FDebugThread.QueueCommand(ACommand);
+          CommandStr:='';
+          end;
+        end;
+      end;
+  finally
+    FDebugThread.RemoveListener(self);
+    FInOutputProcessor.Free;
+    InputStream.Free;
+  end;
+end;
+
+constructor TFpDebugConsoleServer.create(ADebugThread: TFpDebugThread);
+begin
+  FEventQueue:=TFpDebugEventQueue.Create(100, INFINITE, 100);
+  FDebugThread:=ADebugThread;
+  inherited Create(false);
+end;
+
+function TFpDebugConsoleServer.GetOrigin: string;
+begin
+  result := 'console'
+end;
+
+procedure TFpDebugConsoleServer.SendEvent(AnEvent: TFpDebugEvent);
+begin
+  FEventQueue.PushItem(AnEvent);
+end;
+
+destructor TFpDebugConsoleServer.Destroy;
+begin
+  FEventQueue.Free;
+  inherited Destroy;
+end;
+
+end.
+

components/fpdebug/app/fpdserver/fpdserver.lpi

@@ -37,7 +37,7 @@
         <PackageName Value="fpdebug"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="5">
+    <Units Count="6">
       <Unit0>
         <Filename Value="fpdserver.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -62,6 +62,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="DebugInOutputProcessor"/>
       </Unit4>
+      <Unit5>
+        <Filename Value="debugconsoleserver.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="DebugConsoleServer"/>
+      </Unit5>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

components/fpdebug/app/fpdserver/fpdserver.lpr

@@ -26,35 +26,22 @@ uses
   Classes,
   SysUtils,
   CustApp,
-  syncobjs,
-  pipes,
-  lazfglhash,
   debugthread,
   DebugThreadCommand,
-  lazCollections,
   DebugInOutputProcessor,
-  DebugTCPServer;
+  DebugTCPServer,
+  DebugConsoleServer;
 
 type
 
-  TFpDebugEventQueue = specialize TLazThreadedQueue<TFpDebugEvent>;
-
   { TFPDServerApplication }
 
-  TFPDServerApplication = class(TCustomApplication, IFpDebugListener)
+  TFPDServerApplication = class(TCustomApplication)
-  private
-    FEventQueue: TFpDebugEventQueue;
-    FInOutputProcessor: TCustomInOutputProcessor;
-    FConnectionIdentifier: integer;
   protected
     procedure DoRun; override;
   public
     constructor Create(TheOwner: TComponent); override;
-    destructor Destroy; override;
     procedure WriteHelp; virtual;
-    // IFpDebugListener
-    procedure SendEvent(AnEvent: TFpDebugEvent);
-    function GetOrigin: string;
   end;
 
 { TFPDServerApplication }
@@ -64,11 +51,10 @@ var
   ErrorMsg: String;
   DebugThread: TFpDebugThread;
   DebugEvent: TFpDebugEvent;
-  InputStream: TInputPipeStream;
-  CommandStr: string;
   TCPServerThread: TFpDebugTcpServer;
+  ConsoleServerThread: TFpDebugConsoleServer;
   ACommand: TFpDebugThreadCommand;
-  b: char;
+  CommandStr: string;
 begin
   // quick check parameters
   ErrorMsg:=CheckOptions('hf', ['help']);
@@ -88,7 +74,9 @@ begin
     end;
 
   DebugThread := TFpDebugThread.Instance;
+
   TCPServerThread := TFpDebugTcpServer.Create(DebugThread);
+  ConsoleServerThread := TFpDebugConsoleServer.Create(DebugThread);
 
   if HasOption('f') then
     begin
@@ -107,79 +95,35 @@ begin
     CommandStr:='';
     end;
 
-  InputStream:=TInputPipeStream.Create(StdInputHandle);
+  while not Terminated do
-
+    begin
-  FConnectionIdentifier := DebugThread.AddListener(self);
+    try
-  FInOutputProcessor := TJSonInOutputProcessor.create(FConnectionIdentifier, @DebugThread.SendLogMessage);
+      CheckSynchronize(100);
-  try
+    except
-
+      on e: exception do
-    while not terminated do
+        writeln(StdErr, 'Exception: '+e.Message);
-      begin
+    end;
-      if FEventQueue.PopItem(DebugEvent) = wrSignaled then
+    end;
-        begin
-        writeln(FInOutputProcessor.EventToText(DebugEvent));
-        end;
-      while InputStream.NumBytesAvailable>0 do
-        begin
-        InputStream.Read(b,sizeof(b));
-        if b <> #10 then
-          CommandStr:=CommandStr+b
-        else
-          begin
-          if CommandStr='q' then
-            Terminate
-          else
-            begin
-            ACommand := FInOutputProcessor.TextToCommand(CommandStr);
-            if assigned(ACommand) then
-              DebugThread.QueueCommand(ACommand);
-            end;
-          CommandStr:='';
-          end;
-        end;
-      CheckSynchronize;
-      end;
-
-    DebugThread.RemoveListener(self);
-
-  finally
-    FInOutputProcessor.Free;
-  end;
-
 
+  ConsoleServerThread.Terminate;
   TCPServerThread.StopListening;
+
+  ConsoleServerThread.WaitFor;
   TCPServerThread.WaitFor;
+
   TCPServerThread.Free;
+  ConsoleServerThread.Free;
+
   DebugThread.Terminate;
   DebugThread.WaitFor;
-  InputStream.Free;
-
-  terminate;
 end;
 
 constructor TFPDServerApplication.Create(TheOwner: TComponent);
 begin
   inherited Create(TheOwner);
-  FEventQueue:=TFpDebugEventQueue.Create(100, INFINITE, 100);
   StopOnException:=True;
 end;
 
-destructor TFPDServerApplication.Destroy;
-begin
-  FEventQueue.Free;
-  inherited Destroy;
-end;
-
-procedure TFPDServerApplication.SendEvent(AnEvent: TFpDebugEvent);
-begin
-  FEventQueue.PushItem(AnEvent);
-end;
-
-function TFPDServerApplication.GetOrigin: string;
-begin
-  result := 'console';
-end;
-
 procedure TFPDServerApplication.WriteHelp;
 begin
   { add your help code here }