paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 11:29:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebugger (pure): Added logging, enable with define DBG_FPDEBUG_VERBOSE

Browse Source 
git-svn-id: trunk@46143 -
This commit is contained in:
joost 2014-09-06 18:40:30 +00:00
parent 379c2781cc
commit 9070ac0b2c
3 changed files with 39 additions and 1 deletions
components
fpdebug
fpdbgclasses.ppfpdbgcontroller.pas
lazdebuggers/lazdebuggerfp
fpdebugdebugger.pas

7
components/fpdebug/fpdbgclasses.pp
View File

@ -274,6 +274,7 @@ type
procedure RemoveThread(const AID: DWord);
procedure Log(const AString: string; const ALogLevel: TFPDLogLevel = dllDebug);
procedure Log(const AString: string; const Options: array of const; const ALogLevel: TFPDLogLevel = dllDebug);
function FormatAddress(const AAddress): String;
function Pause: boolean; virtual;
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; virtual;
@ -335,6 +336,7 @@ var
const
DBGPTRSIZE: array[TFPDMode] of Integer = (4, 8);
FPDEventNames: array[TFPDEvent] of string = ('deExitProcess', 'deBreakpoint', 'deException', 'deCreateProcess', 'deLoadLibrary', 'deInternalContinue');
function OSDbgClasses: TOSDbgClasses;
@ -929,6 +931,11 @@ begin
Log(Format(AString, Options), ALogLevel);
end;
function TDbgProcess.FormatAddress(const AAddress): String;
begin
Result := HexValue(AAddress, DBGPTRSIZE[Mode], [hvfIncludeHexchar]);
end;
function TDbgProcess.Pause: boolean;
begin
result := false;

29
components/fpdebug/fpdbgcontroller.pas
View File

@ -513,6 +513,9 @@ procedure TDbgController.InitializeCommand(ACommand: TDbgControllerCmd);
begin
if assigned(FCommand) then
raise exception.create('Prior command not finished yet.');
{$ifdef DBG_FPDEBUG_VERBOSE}
log('Initialized command '+ACommand.ClassName, dllDebug);
{$endif DBG_FPDEBUG_VERBOSE}
FCommand := ACommand;
end;
@ -601,9 +604,19 @@ begin
else
begin
if not assigned(FCommand) then
begin
{$ifdef DBG_FPDEBUG_VERBOSE}
log('Continue process without command.', dllDebug);
{$endif DBG_FPDEBUG_VERBOSE}
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False)
end
else
begin
{$ifdef DBG_FPDEBUG_VERBOSE}
log('Continue process with command '+FCommand.ClassName, dllDebug);
{$endif DBG_FPDEBUG_VERBOSE}
FCommand.DoContinue(FCurrentProcess, FCurrentThread);
end;
end;
if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then Continue;
@ -625,8 +638,22 @@ begin
FCurrentThread := FCurrentProcess.AddThread(AThreadIdentifier);
FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread);
{$ifdef DBG_FPDEBUG_VERBOSE}
log('Process stopped with event %s. IP=%s, SP=%s, BSP=%s.', [FPDEventNames[FPDEvent],
FCurrentProcess.FormatAddress(FCurrentProcess.GetInstructionPointerRegisterValue),
FCurrentProcess.FormatAddress(FCurrentProcess.GetStackPointerRegisterValue),
FCurrentProcess.FormatAddress(FCurrentProcess.GetStackBasePointerRegisterValue)], dllDebug);
{$endif DBG_FPDEBUG_VERBOSE}
if assigned(FCommand) then
FCommand.ResolveEvent(FPDEvent, IsHandled, IsFinished)
begin
FCommand.ResolveEvent(FPDEvent, IsHandled, IsFinished);
{$ifdef DBG_FPDEBUG_VERBOSE}
if IsFinished then
log('Command %s is finished. (IsHandled=%s)', [FCommand.ClassName, BoolToStr(IsHandled)], dllDebug)
else
log('Command %s is not finished. (IsHandled=%s)', [FCommand.ClassName, BoolToStr(IsHandled)], dllDebug);
{$endif DBG_FPDEBUG_VERBOSE}
end
else
begin
IsHandled:=false;

4
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -1556,7 +1556,9 @@ end;
procedure TFpDebugDebugger.StartDebugLoop;
begin
{$ifdef DBG_FPDEBUG_VERBOSE}
DebugLn('StartDebugLoop');
{$endif DBG_FPDEBUG_VERBOSE}
RTLeventSetEvent(FFpDebugThread.StartDebugLoopEvent);
end;
@ -1564,7 +1566,9 @@ procedure TFpDebugDebugger.DebugLoopFinished;
var
Cont: boolean;
begin
{$ifdef DBG_FPDEBUG_VERBOSE}
DebugLn('DebugLoopFinished');
{$endif DBG_FPDEBUG_VERBOSE}
FDbgController.SendEvents(Cont);