FpDebug, Windows: Forward OutputDebugString to IDE.

git-svn-id: trunk@65475 -

components/fpdebug/fpdbgclasses.pp

@@ -529,6 +529,8 @@ type
   end;
   TDbgDisassemblerClass = class of TDbgAsmDecoder;
 
+  TDebugOutputEvent = procedure(Sender: TObject; ProcessId, ThreadId: Integer; AMessage: String) of object;
+
   { TDbgProcess }
 
   TDbgProcess = class(TDbgInstance)
@@ -541,6 +543,7 @@ type
     FExitCode: DWord;
     FGotExitProcess: Boolean;
     FLastLibraryUnloaded: TDbgLibrary;
+    FOnDebugOutputEvent: TDebugOutputEvent;
     FOSDbgClasses: TOSDbgClasses;
     FProcessID: Integer;
     FThreadID: Integer;
@@ -676,6 +679,7 @@ public
     // Properties valid when last event was an deException
     property ExceptionMessage: string read FExceptionMessage write FExceptionMessage;
     property ExceptionClass: string read FExceptionClass write FExceptionClass;
+    property OnDebugOutputEvent: TDebugOutputEvent read FOnDebugOutputEvent write FOnDebugOutputEvent;
 
     property LastEventProcessIdentifier: THandle read GetLastEventProcessIdentifier;
     property MainThread: TDbgThread read FMainThread;

components/fpdebug/fpdbgcontroller.pas

@@ -259,6 +259,7 @@ type
     FOnLibraryLoadedEvent: TOnLibraryLoadedEvent;
     FOnLibraryUnloadedEvent: TOnLibraryUnloadedEvent;
     FOnThreadBeforeProcessLoop: TNotifyEvent;
+    FOnThreadDebugOutputEvent: TDebugOutputEvent;
     FOnThreadProcessLoopCycleEvent: TOnProcessLoopCycleEvent;
     FOsDbgClasses: TOSDbgClasses;
     FRunning, FPauseRequest: cardinal;
@@ -285,6 +286,7 @@ type
     procedure SetEnvironment(AValue: TStrings);
     procedure SetExecutableFilename(const AValue: string);
     procedure DoOnDebugInfoLoaded(Sender: TObject);
+    procedure SetOnThreadDebugOutputEvent(AValue: TDebugOutputEvent);
     procedure SetParams(AValue: TStringList);
 
     procedure CheckExecutableAndLoadClasses;
@@ -402,6 +404,7 @@ type
 
     property OnThreadBeforeProcessLoop: TNotifyEvent read FOnThreadBeforeProcessLoop write FOnThreadBeforeProcessLoop;
     property OnThreadProcessLoopCycleEvent: TOnProcessLoopCycleEvent read FOnThreadProcessLoopCycleEvent write FOnThreadProcessLoopCycleEvent;
+    property OnThreadDebugOutputEvent: TDebugOutputEvent read FOnThreadDebugOutputEvent write SetOnThreadDebugOutputEvent;
   end;
 
 implementation
@@ -1303,6 +1306,14 @@ begin
     FOnDebugInfoLoaded(Self);
 end;
 
+procedure TDbgController.SetOnThreadDebugOutputEvent(AValue: TDebugOutputEvent);
+begin
+  if FOnThreadDebugOutputEvent = AValue then Exit;
+  FOnThreadDebugOutputEvent := AValue;
+  if FMainProcess <> nil then
+    FMainProcess.OnDebugOutputEvent := AValue;
+end;
+
 procedure TDbgController.SetParams(AValue: TStringList);
 begin
   if FParams=AValue then Exit;
@@ -1577,6 +1588,8 @@ begin
       // IF there is a pause-request, we will hit a deCreateProcess.
       // No need to indicate FRunning
       FMainProcess:=FCurrentProcess;
+      if FMainProcess <> nil then
+        FMainProcess.OnDebugOutputEvent := FOnThreadDebugOutputEvent;
     end
     else
     begin

components/fpdebug/fpdbgwinclasses.pas

@@ -1191,6 +1191,8 @@ function TDbgWinProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
       then Exit;
     end;
     DebugLn(DBG_VERBOSE, '[%d:%d]: %s', [AEvent.dwProcessId, AEvent.dwThreadId, S]);
+    if OnDebugOutputEvent <> nil then
+      OnDebugOutputEvent(Self, AEvent.dwProcessId, AEvent.dwThreadId, S);
   end;
 
 var

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -33,8 +33,8 @@ interface
 
 uses
   Classes, SysUtils, fgl, math, process,
-  Forms, Dialogs,
-  Maps, LazLogger, LazUTF8,
+  Forms, Dialogs, syncobjs,
+  Maps, LazLogger, LazUTF8, lazCollections,
   DbgIntfBaseTypes, DbgIntfDebuggerBase,
   FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads,
   // FpDebug
@@ -287,6 +287,8 @@ type
   { TFpDebugDebugger }
 
   TFpDebugDebugger = class(TFpDebugDebuggerBase)
+  private type
+    TFpDebugStringQueue = class(specialize TLazThreadedQueue<string>);
   private
     FIsIdle: Boolean;
     FPrettyPrinter: TFpPascalPrettyPrinter;
@@ -311,7 +313,12 @@ type
     FCachePointer: pointer;
     FCacheThreadId, FCacheStackFrame: Integer;
     FCacheContext: TFpDbgSymbolScope;
+    FFpDebugOutputQueue: TFpDebugStringQueue;
+    FFpDebugOutputAsync: integer;
     //
+    procedure DoDebugOutput(Data: PtrInt);
+    procedure DoThreadDebugOutput(Sender: TObject; ProcessId,
+      ThreadId: Integer; AMessage: String);
     function GetClassInstanceName(AnAddr: TDBGPtr): string;
     function ReadAnsiString(AnAddr: TDbgPtr): string;
     procedure HandleSoftwareException(out AnExceptionLocation: TDBGLocationRec; var continue: boolean);
@@ -2823,6 +2830,23 @@ begin
       (AnAddr, FDbgController.DefaultContext, DBGPTRSIZE[FDbgController.CurrentProcess.Mode], Result, AnErr);
 end;
 
+procedure TFpDebugDebugger.DoThreadDebugOutput(Sender: TObject; ProcessId,
+  ThreadId: Integer; AMessage: String);
+begin
+  FFpDebugOutputQueue.PushItem(Format('%d: %s', [ThreadId, AMessage]));
+  if InterlockedExchange(FFpDebugOutputAsync, 1) <> 1 then
+    Application.QueueAsyncCall(@DoDebugOutput, 0);
+end;
+
+procedure TFpDebugDebugger.DoDebugOutput(Data: PtrInt);
+var
+  s: string;
+begin
+  InterlockedExchange(FFpDebugOutputAsync, 0);
+  while FFpDebugOutputQueue.PopItemTimeout(s, 50) = wrSignaled do
+    EventLogHandler.LogCustomEvent(ecOutput, etOutputDebugString, s);
+end;
+
 function TFpDebugDebugger.ReadAnsiString(AnAddr: TDbgPtr): string;
 var
   StrAddr: TDBGPtr;
@@ -3687,6 +3711,7 @@ begin
   FLockList := TFpDbgLockList.Create;
   FWorkQueue := TFpThreadPriorityWorkerQueue.Create(100);
   FWorkQueue.OnQueueIdle := @CheckAndRunIdle;
+  FFpDebugOutputQueue := TFpDebugStringQueue.create(100);
   FExceptionStepper := TFpDebugExceptionStepping.Create(Self);
   FPrettyPrinter := TFpPascalPrettyPrinter.Create(sizeof(pointer));
   FMemReader := TFpDbgMemReader.Create(self);
@@ -3704,6 +3729,7 @@ begin
   FDbgController.OnDebugInfoLoaded := @FDbgControllerDebugInfoLoaded;
   FDbgController.OnLibraryLoadedEvent := @FDbgControllerLibraryLoaded;
   FDbgController.OnLibraryUnloadedEvent := @FDbgControllerLibraryUnloaded;
+  FDbgController.OnThreadDebugOutputEvent  := @DoThreadDebugOutput;
   FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
 
   FDbgController.OnThreadProcessLoopCycleEvent:=@FExceptionStepper.ThreadProcessLoopCycle;
@@ -3727,6 +3753,7 @@ begin
   {$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF}
 
   Application.RemoveAsyncCalls(Self);
+  FreeAndNil(FFpDebugOutputQueue);
   FreeAndNil(FDbgController);
   FreeAndNil(FPrettyPrinter);
   FreeAndNil(FMemManager);