From 3864f9f3b6e41239a79e5fb9eb0aa62acb0cb656 Mon Sep 17 00:00:00 2001 From: martin Date: Mon, 19 Jul 2021 18:19:35 +0000 Subject: [PATCH] Merged revision(s) 65475 #b5bf7de6f9 from trunk: FpDebug, Windows: Forward OutputDebugString to IDE. ........ git-svn-id: branches/fixes_2_2@65476 - --- components/fpdebug/fpdbgclasses.pp | 4 +++ components/fpdebug/fpdbgcontroller.pas | 13 ++++++++ components/fpdebug/fpdbgwinclasses.pas | 2 ++ .../lazdebuggerfp/fpdebugdebugger.pas | 31 +++++++++++++++++-- 4 files changed, 48 insertions(+), 2 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index cc015f6b29..91fce19d81 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/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; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 7ae7a1524f..ee441d7f9a 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/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 diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index 73dc0c3737..e8301e7cbc 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/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 diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 51a666ffc3..3edf8c90ec 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/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); 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);