mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-09 17:32:47 +02:00
4335 lines
138 KiB
ObjectPascal
4335 lines
138 KiB
ObjectPascal
{
|
|
---------------------------------------------------------------------------
|
|
FpDebugDebugger
|
|
---------------------------------------------------------------------------
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
}
|
|
|
|
unit FpDebugDebugger;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$TYPEDADDRESS on}
|
|
{$ModeSwitch advancedrecords}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, {$IfDef WIN64}windows,{$EndIf} SysUtils, fgl, math, process,
|
|
Forms, Dialogs, syncobjs,
|
|
Maps, LazLoggerBase, LazUTF8, lazCollections,
|
|
DbgIntfBaseTypes, DbgIntfDebuggerBase,
|
|
FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads, LazDebuggerIntf,
|
|
// FpDebug
|
|
{$IFDEF FPDEBUG_THREAD_CHECK} FpDbgCommon, {$ENDIF}
|
|
FpDbgClasses, FpDbgInfo, FpErrorMessages, FpPascalBuilder, FpdMemoryTools,
|
|
FpPascalParser, FPDbgController, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal,
|
|
FpDbgDwarf, FpDbgUtil;
|
|
|
|
type
|
|
|
|
TFpDebugDebugger = class;
|
|
TFPBreakpoint = class;
|
|
|
|
(* WorkerThreads:
|
|
The below subclasses implement ONLY work that is done in the MAIN THREAD.
|
|
*)
|
|
|
|
{ TFpDbgDebggerThreadWorkerItemHelper }
|
|
|
|
TFpDbgDebggerThreadWorkerItemHelper = class helper for TFpDbgDebggerThreadWorkerItem
|
|
protected
|
|
function FpDebugger: TFpDebugDebugger; inline;
|
|
end;
|
|
|
|
{ TFpThreadWorkerRunLoopUpdate }
|
|
|
|
TFpThreadWorkerRunLoopUpdate = class(TFpThreadWorkerRunLoop)
|
|
protected
|
|
procedure LoopFinished_DecRef(Data: PtrInt = 0); override;
|
|
end;
|
|
|
|
{ TFpThreadWorkerRunLoopAfterIdleUpdate }
|
|
|
|
TFpThreadWorkerRunLoopAfterIdleUpdate = class(TFpThreadWorkerRunLoopAfterIdle)
|
|
protected
|
|
procedure CheckIdleOrRun_DecRef(Data: PtrInt = 0); override;
|
|
end;
|
|
|
|
{ TFpThreadWorkerCallStackCountUpdate }
|
|
|
|
TFpThreadWorkerCallStackCountUpdate = class(TFpThreadWorkerCallStackCount)
|
|
private
|
|
FCallstack: TCallStackBase;
|
|
procedure DoCallstackFreed_DecRef(Sender: TObject);
|
|
protected
|
|
procedure UpdateCallstack_DecRef(Data: PtrInt = 0); override;
|
|
procedure DoRemovedFromLinkedList; override;
|
|
public
|
|
constructor Create(ADebugger: TFpDebugDebugger; ACallstack: TCallStackBase; ARequiredMinCount: Integer);
|
|
//procedure RemoveCallStack_DecRef;
|
|
end;
|
|
|
|
{ TFpThreadWorkerCallEntryUpdate }
|
|
|
|
TFpThreadWorkerCallEntryUpdate = class(TFpThreadWorkerCallEntry)
|
|
private
|
|
FCallstack: TCallStackBase;
|
|
FCallstackEntry: TCallStackEntry;
|
|
procedure DoCallstackFreed_DecRef(Sender: TObject);
|
|
procedure DoCallstackEntryFreed_DecRef(Sender: TObject);
|
|
procedure DoRemovedFromLinkedList; override;
|
|
protected
|
|
procedure UpdateCallstackEntry_DecRef(Data: PtrInt = 0); override;
|
|
public
|
|
constructor Create(ADebugger: TFpDebugDebuggerBase; AThread: TDbgThread; ACallstackEntry: TCallStackEntry; ACallstack: TCallStackBase = nil);
|
|
//procedure RemoveCallStackEntry_DecRef;
|
|
end;
|
|
|
|
{ TFpThreadWorkerThreadsUpdate }
|
|
|
|
TFpThreadWorkerThreadsUpdate = class(TFpThreadWorkerThreads)
|
|
protected
|
|
procedure UpdateThreads_DecRef(Data: PtrInt = 0); override;
|
|
end;
|
|
|
|
{ TFpThreadWorkerLocalsUpdate }
|
|
|
|
TFpThreadWorkerLocalsUpdate = class(TFpThreadWorkerLocals)
|
|
private
|
|
FLocals: TLocals;
|
|
procedure DoLocalsFreed_DecRef(Sender: TObject);
|
|
protected
|
|
procedure UpdateLocals_DecRef(Data: PtrInt = 0); override;
|
|
procedure DoRemovedFromLinkedList; override; // _DecRef
|
|
public
|
|
constructor Create(ADebugger: TFpDebugDebuggerBase; ALocals: TLocals);
|
|
end;
|
|
|
|
{ TFpThreadWorkerModifyUpdate }
|
|
|
|
TFpThreadWorkerModifyUpdate = class(TFpThreadWorkerModify)
|
|
protected
|
|
procedure DoCallback_DecRef(Data: PtrInt = 0); override;
|
|
end;
|
|
|
|
{ TFpThreadWorkerWatchValueEvalUpdate }
|
|
|
|
TFpThreadWorkerWatchValueEvalUpdate = class(TFpThreadWorkerWatchValueEval)
|
|
private
|
|
procedure DoWachCanceled(Sender: TObject);
|
|
protected
|
|
procedure UpdateWatch_DecRef(Data: PtrInt = 0); override;
|
|
procedure DoRemovedFromLinkedList; override; // _DecRef
|
|
public
|
|
constructor Create(ADebugger: TFpDebugDebuggerBase; AWatchValue: TWatchValueIntf);
|
|
end;
|
|
|
|
{ TFpThreadWorkerBreakPointSetUpdate }
|
|
|
|
TFpThreadWorkerBreakPointSetUpdate = class(TFpThreadWorkerBreakPointSet)
|
|
private
|
|
FDbgBreakPoint: TFPBreakpoint;
|
|
protected
|
|
procedure UpdateBrkPoint_DecRef(Data: PtrInt = 0); override;
|
|
public
|
|
constructor Create(ADebugger: TFpDebugDebuggerBase; ADbgBreakPoint: TFPBreakpoint); overload;
|
|
procedure AbortSetBreak; override;
|
|
procedure RemoveBreakPoint_DecRef; override;
|
|
end;
|
|
|
|
{ TFpThreadWorkerBreakPointRemoveUpdate }
|
|
|
|
TFpThreadWorkerBreakPointRemoveUpdate = class(TFpThreadWorkerBreakPointRemove)
|
|
protected
|
|
procedure DoUnQueued; override;
|
|
public
|
|
constructor Create(ADebugger: TFpDebugDebuggerBase; ADbgBreakPoint: TFPBreakpoint); overload;
|
|
end;
|
|
|
|
{ TDbgControllerStepOverOrFinallyCmd
|
|
Step over with detection for finally blocks
|
|
}
|
|
|
|
TDbgControllerStepOverOrFinallyCmd = class(TDbgControllerStepOverLineCmd)
|
|
private
|
|
FFinState: (fsNone, fsMov, fsCall, fsInFin);
|
|
protected
|
|
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
|
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread;
|
|
out Finished: boolean); override;
|
|
end;
|
|
|
|
{ TDbgControllerStepOverFirstFinallyLineCmd }
|
|
|
|
TDbgControllerStepOverFirstFinallyLineCmd = class(TDbgControllerStepOverLineCmd)
|
|
protected
|
|
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread;
|
|
out Finished: boolean); override;
|
|
end;
|
|
|
|
{ TDbgControllerStepThroughFpcSpecialHandler }
|
|
|
|
TDbgControllerStepThroughFpcSpecialHandler = class(TDbgControllerStepOverInstructionCmd)
|
|
private
|
|
FAfterFinCallAddr: TDbgPtr;
|
|
FDone, FIsLeave: Boolean;
|
|
FInteralFinished: Boolean;
|
|
protected
|
|
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
|
|
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
|
procedure Init; override;
|
|
public
|
|
constructor Create(AController: TDbgController; AnAfterFinCallAddr: TDbgPtr; AnIsLeave: Boolean); reintroduce;
|
|
property InteralFinished: Boolean read FInteralFinished;
|
|
end;
|
|
|
|
{ TFpDebugExceptionStepping }
|
|
|
|
TFpDebugExceptionStepping = class
|
|
(* Methods in this class are either called:
|
|
- by the debug-thread / in the context of the debug-thread
|
|
- by the main-thread / But ONLY if the debug-thread is paused
|
|
Starting the debug-thread uses "RTLeventSetEvent" which triggers a
|
|
memory barrier. So memberfields can be used savely between all methods.
|
|
*)
|
|
private
|
|
type
|
|
TBreakPointLoc = (
|
|
bplRaise, bplReRaise, bplBreakError, bplRunError,
|
|
bplPopExcept, bplCatches,
|
|
{$IFDEF WIN64}
|
|
bplRtlUnwind, bplFpcSpecific, bplRtlRestoreContext,
|
|
bplSehW64Finally, bplSehW64Except, bplSehW64Unwound,
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS} // 32 bit or WOW
|
|
bplFpcExceptHandler,
|
|
bplFpcFinallyHandler,
|
|
bplFpcLeaveHandler,
|
|
bplSehW32Except,
|
|
bplSehW32Finally,
|
|
{$ENDIF}
|
|
|
|
bplStepOut // Step out of Pop/Catches
|
|
);
|
|
TBreakPointLocs = set of TBreakPointLoc;
|
|
TExceptStepState = (esNone,
|
|
esStoppedAtRaise, // Enter dsPause, next step is "stop to finally"
|
|
esIgnoredRaise, // Keep dsRun, stop at finally/except *IF* outside current stepping frame
|
|
esStepToFinally,
|
|
esStepSehFinallyProloque,
|
|
esSteppingFpcSpecialHandler,
|
|
esAtWSehExcept
|
|
);
|
|
|
|
{ TFrameList }
|
|
|
|
TFrameList = class(specialize TFPGList<TDbgPtr>)
|
|
public
|
|
procedure RemoveOutOfScopeFrames(const ACurFrame: TDbgPtr); inline;
|
|
end;
|
|
|
|
{ TAddressFrameList }
|
|
|
|
TAddressFrameList = class(specialize TFPGMapObject<TDbgPtr, TFrameList>)
|
|
FLastRemoveCheck: TDBGPtr;
|
|
procedure DoRemoveOutOfScopeFrames(const ACurFrame: TDbgPtr; ABreakPoint: TFpDbgBreakpoint);
|
|
public
|
|
function Add(const AnAddress: TDbgPtr): TFrameList; inline; overload;
|
|
function Add(const AnAddress, AFrame: TDbgPtr): boolean; inline; overload; // True if already exist
|
|
function Remove(const AnAddress, AFrame: TDbgPtr): boolean; inline; // True if last frame for address
|
|
procedure RemoveOutOfScopeFrames(const ACurFrame: TDbgPtr; ABreakPoint: TFpDbgBreakpoint); inline;
|
|
end;
|
|
const
|
|
DBGPTRSIZE: array[TFPDMode] of Integer = (4, 8);
|
|
private
|
|
FDebugger: TFpDebugDebugger;
|
|
FBreakPoints: array[TBreakPointLoc] of TFpDbgBreakpoint;
|
|
FBreakEnabled: TBreakPointLocs;
|
|
FBreakNewEnabled: TBreakPointLocs;
|
|
{$IFDEF WIN64}
|
|
FAddressFrameListSehW64Except,
|
|
FAddressFrameListSehW64Finally: TAddressFrameList;
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
FAddressFrameListSehW32Except: TAddressFrameList;
|
|
FAddressFrameListSehW32Finally: TAddressFrameList;
|
|
{$ENDIF}
|
|
FState: TExceptStepState;
|
|
function GetCurrentCommand: TDbgControllerCmd; inline;
|
|
function GetCurrentProcess: TDbgProcess; inline;
|
|
function GetCurrentThread: TDbgThread; inline;
|
|
function GetDbgController: TDbgController; inline;
|
|
function dbgs(st: TExceptStepState): string;
|
|
function dbgs(loc: TBreakPointLoc): string;
|
|
function dbgs(locs: TBreakPointLocs): string;
|
|
protected
|
|
property DbgController: TDbgController read GetDbgController;
|
|
property CurrentProcess: TDbgProcess read GetCurrentProcess;
|
|
property CurrentThread: TDbgThread read GetCurrentThread;
|
|
property CurrentCommand: TDbgControllerCmd read GetCurrentCommand;
|
|
|
|
procedure EnableBreaks(ALocs: TBreakPointLocs);
|
|
procedure EnableBreaksDirect(ALocs: TBreakPointLocs); // only in dbg thread
|
|
procedure DisableBreaks(ALocs: TBreakPointLocs);
|
|
procedure DisableBreaksDirect(ALocs: TBreakPointLocs); // only in dbg thread
|
|
procedure SetStepOutAddrDirect(AnAddr: TDBGPtr); // only in dbg thread
|
|
|
|
procedure DoExceptionRaised(var &continue: boolean);
|
|
//procedure DoPopExcptStack;
|
|
procedure DoRtlUnwindEx;
|
|
public
|
|
constructor Create(ADebugger: TFpDebugDebugger);
|
|
destructor Destroy; override;
|
|
|
|
procedure DoProcessLoaded;
|
|
procedure DoNtDllLoaded(ALib: TDbgLibrary);
|
|
//procedure DoLibraryLoaded(ALib: TDbgLibrary); // update breakpoints
|
|
procedure DoDbgStopped;
|
|
|
|
procedure ThreadBeforeLoop(Sender: TObject);
|
|
procedure ThreadProcessLoopCycle(var AFinishLoopAndSendEvents: boolean;
|
|
var AnEventType: TFPDEvent; var ACurCommand: TDbgControllerCmd; var AnIsFinished: boolean);
|
|
function BreakpointHit(var &continue: boolean; const Breakpoint: TFpDbgBreakpoint): boolean;
|
|
procedure UserCommandRequested(var ACommand: TDBGCommand);
|
|
|
|
// procedure ClearState;
|
|
end;
|
|
|
|
{ TFpDebugDebugger }
|
|
|
|
TFpDebugDebugger = class(TFpDebugDebuggerBase)
|
|
private type
|
|
TFpDebugStringQueue = class(specialize TLazThreadedQueue<string>);
|
|
private
|
|
FIsIdle: Boolean;
|
|
FPrettyPrinter: TFpPascalPrettyPrinter;
|
|
FStartupCommand: TDBGCommand;
|
|
FStartuRunToFile: string;
|
|
FStartuRunToLine: LongInt;
|
|
(* Each thread must only lock max one item at a time.
|
|
This ensures the locking will be dead-lock free.
|
|
*)
|
|
FWorkerThreadId: TThreadID;
|
|
FEvalWorkItem: TFpThreadWorkerCmdEval;
|
|
FQuickPause, FPauseForEvent, FSendingEvents: boolean;
|
|
FExceptionStepper: TFpDebugExceptionStepping;
|
|
FConsoleOutputThread: TThread;
|
|
// Helper vars to run in debug-thread
|
|
FCacheLine, FCacheBytesRead: cardinal;
|
|
FCacheFileName: string;
|
|
FCacheLib: TDbgLibrary;
|
|
FCacheBreakpoint: TFpDbgBreakpoint;
|
|
FCacheLocation, FCacheLocation2: TDBGPtr;
|
|
FCacheBoolean: boolean;
|
|
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);
|
|
// HandleBreakError: Default handler for range-check etc
|
|
procedure HandleBreakError(var continue: boolean);
|
|
// HandleRunError: Software called RuntimeError
|
|
procedure HandleRunError(var continue: boolean);
|
|
procedure FreeDebugThread;
|
|
procedure FDbgControllerHitBreakpointEvent(var continue: boolean;
|
|
const Breakpoint: TFpDbgBreakpoint; AnEventType: TFPDEvent; AMoreHitEventsPending: Boolean);
|
|
procedure EnterPause(ALocationAddr: TDBGLocationRec; AnInternalPause: Boolean = False);
|
|
procedure FDbgControllerCreateProcessEvent(var {%H-}continue: boolean);
|
|
procedure FDbgControllerProcessExitEvent(AExitCode: DWord);
|
|
procedure FDbgControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string);
|
|
procedure FDbgControllerDebugInfoLoaded(Sender: TObject);
|
|
procedure FDbgControllerLibraryLoaded(var continue: boolean; ALibraries: TDbgLibraryArr);
|
|
procedure FDbgControllerLibraryUnloaded(var continue: boolean; ALibraries: TDbgLibraryArr);
|
|
function GetDebugInfo: TDbgInfo;
|
|
protected
|
|
procedure GetCurrentThreadAndStackFrame(out AThreadId, AStackFrame: Integer);
|
|
function GetContextForEvaluate(const ThreadId, StackFrame: Integer): TFpDbgSymbolScope;
|
|
|
|
function CreateLineInfo: TDBGLineInfo; override;
|
|
function CreateWatches: TWatchesSupplier; override;
|
|
function CreateThreads: TThreadsSupplier; override;
|
|
function CreateLocals: TLocalsSupplier; override;
|
|
function CreateRegisters: TRegisterSupplier; override;
|
|
function CreateCallStack: TCallStackSupplier; override;
|
|
function CreateDisassembler: TDBGDisassembler; override;
|
|
function CreateBreakPoints: TDBGBreakPoints; override;
|
|
function RequestCommand(const ACommand: TDBGCommand;
|
|
const AParams: array of const;
|
|
const ACallback: TMethod): Boolean; override;
|
|
function ChangeFileName: Boolean; override;
|
|
|
|
// On Linux, communication with the debuggee is only allowed from within
|
|
// the thread that created the debuggee. So a method to execute functions
|
|
// within the debug-thread is necessary.
|
|
function ExecuteInDebugThread(AMethod: TFpDbgAsyncMethod): boolean;
|
|
procedure StartDebugLoop(AState: TDBGState = dsRun);
|
|
procedure DebugLoopFinished({%H-}Data: PtrInt);
|
|
(* Any item that requests a QuickPause must be called from RunQuickPauseTasks
|
|
A QuickPause may skip changing the debugger.State.
|
|
*)
|
|
procedure QuickPause;
|
|
procedure RunQuickPauseTasks(AForce: Boolean = False);
|
|
procedure DoRelease; override;
|
|
procedure CheckAndRunIdle;
|
|
procedure DoBeforeState(const OldState: TDBGState); override;
|
|
procedure DoState(const OldState: TDBGState); override;
|
|
function GetIsIdle: Boolean; override;
|
|
function GetCommands: TDBGCommands; override;
|
|
|
|
protected
|
|
// Helper vars to run in debug-thread
|
|
FCallStackEntryListThread: TDbgThread;
|
|
FCallStackEntryListFrameRequired: Integer;
|
|
procedure DoAddBreakFuncLib;
|
|
procedure DoAddBreakLocation;
|
|
procedure DoReadData;
|
|
procedure DoReadPartialData;
|
|
procedure DoFindContext;
|
|
procedure DoSetStackFrameForBasePtr;
|
|
//
|
|
function AddBreak(const ALocation: TDbgPtr; AnEnabled: Boolean = True): TFpDbgBreakpoint; overload;
|
|
function AddBreak(const AFuncName: String; ALib: TDbgLibrary = nil; AnEnabled: Boolean = True): TFpDbgBreakpoint; overload;
|
|
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; inline;
|
|
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData; out ABytesRead: Cardinal): Boolean; inline;
|
|
function ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean;
|
|
function SetStackFrameForBasePtr(ABasePtr: TDBGPtr; ASearchAssert: boolean = False;
|
|
CurAddr: TDBGPtr = 0): TDBGPtr;
|
|
function FindSymbolScope(AThreadId, AStackFrame: Integer): TFpDbgSymbolScope; inline;
|
|
procedure StopAllWorkers;
|
|
function IsPausedAndValid: boolean; // ready for eval watches/stack....
|
|
|
|
procedure DoProcessMessages;
|
|
property DebugInfo: TDbgInfo read GetDebugInfo;
|
|
public
|
|
constructor Create(const AExternalDebugger: String); override;
|
|
destructor Destroy; override;
|
|
procedure LockCommandProcessing; override;
|
|
procedure UnLockCommandProcessing; override;
|
|
function GetLocationRec(AnAddress: TDBGPtr=0; AnAddrOffset: Integer = 0): TDBGLocationRec;
|
|
function GetLocation: TDBGLocationRec; override;
|
|
class function Caption: String; override;
|
|
class function NeedsExePath: boolean; override;
|
|
class function RequiredCompilerOpts({%H-}ATargetCPU, {%H-}ATargetOS: String): TDebugCompilerRequirements; override;
|
|
class function CreateProperties: TDebuggerProperties; override;
|
|
class function GetSupportedCommands: TDBGCommands; override;
|
|
class function SupportedCommandsFor(AState: TDBGState): TDBGCommands; override;
|
|
class function SupportedFeatures: TDBGFeatures; override;
|
|
end;
|
|
|
|
{ TFpLineInfo }
|
|
|
|
TFpLineInfo = class(TDBGLineInfo) //class(TGDBMILineInfo)
|
|
private
|
|
FRequestedSources: TStringListUTF8Fast;
|
|
protected
|
|
function FpDebugger: TFpDebugDebugger;
|
|
procedure DoStateChange(const {%H-}AOldState: TDBGState); override;
|
|
procedure ClearSources;
|
|
procedure DebugInfoChanged;
|
|
public
|
|
constructor Create(const ADebugger: TDebuggerIntf);
|
|
destructor Destroy; override;
|
|
function Count: Integer; override;
|
|
function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; override;
|
|
function GetInfo({%H-}AAddress: TDbgPtr; out {%H-}ASource, {%H-}ALine, {%H-}AOffset: Integer): Boolean; override;
|
|
function IndexOf(const ASource: String): integer; override;
|
|
procedure Request(const ASource: String); override;
|
|
procedure Cancel(const {%H-}ASource: String); override;
|
|
end;
|
|
|
|
{ TFPWatches }
|
|
|
|
TFPWatches = class(TWatchesSupplier)
|
|
protected
|
|
FWatchEvalWorkers: TFpDbgDebggerThreadWorkerLinkedList;
|
|
function FpDebugger: TFpDebugDebugger;
|
|
procedure StopWorkes;
|
|
procedure DoStateLeavePause; override;
|
|
procedure InternalRequestData(AWatchValue: TWatchValueIntf); override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TFPCallStackSupplier }
|
|
|
|
TFPCallStackSupplier = class(TCallStackSupplier)
|
|
private
|
|
FPrettyPrinter: TFpPascalPrettyPrinter;
|
|
FInitialFrame: Integer;
|
|
FThreadForInitialFrame: Integer;
|
|
FCallStackWorkers: TFpDbgDebggerThreadWorkerLinkedList;
|
|
protected
|
|
function FpDebugger: TFpDebugDebugger;
|
|
procedure StopWorkes;
|
|
procedure DoStateLeavePause; override;
|
|
public
|
|
constructor Create(const ADebugger: TDebuggerIntf);
|
|
destructor Destroy; override;
|
|
procedure RequestCount(ACallstack: TCallStackBase); override;
|
|
procedure RequestAtLeastCount(ACallstack: TCallStackBase;
|
|
ARequiredMinCount: Integer); override;
|
|
procedure RequestEntries(ACallstack: TCallStackBase); override;
|
|
procedure RequestCurrent(ACallstack: TCallStackBase); override;
|
|
procedure UpdateCurrentIndex; override;
|
|
end;
|
|
|
|
{ TFPLocals }
|
|
|
|
TFPLocals = class(TLocalsSupplier)
|
|
protected
|
|
FLocalWorkers: TFpDbgDebggerThreadWorkerLinkedList;
|
|
function FpDebugger: TFpDebugDebugger;
|
|
procedure StopWorkes;
|
|
procedure DoStateLeavePause; override;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure RequestData(ALocals: TLocals); override;
|
|
end;
|
|
|
|
{ TFPRegisters }
|
|
|
|
TFPRegisters = class(TRegisterSupplier)
|
|
private
|
|
FThr: TDbgThread;
|
|
FRegisterList: TDbgRegisterValueList;
|
|
procedure GetRegisterValueList();
|
|
public
|
|
procedure RequestData(ARegisters: TRegisters); override;
|
|
end;
|
|
|
|
{ TFPThreads }
|
|
|
|
TFPThreads = class(TThreadsSupplier)
|
|
protected
|
|
FThreadWorkers: TFpDbgDebggerThreadWorkerLinkedList;
|
|
procedure DoStateEnterPause; override;
|
|
procedure DoStateChange(const AOldState: TDBGState); override;
|
|
procedure StopWorkes;
|
|
procedure DoStateLeavePause; override;
|
|
procedure RequestEntries; // Only fill the list, no data for entries yet
|
|
public
|
|
destructor Destroy; override;
|
|
procedure RequestMasterData; override;
|
|
procedure ChangeCurrentThread(ANewId: Integer); override;
|
|
end;
|
|
|
|
{ TFPDBGDisassembler }
|
|
|
|
TFPDBGDisassembler = class(TDBGDisassembler)
|
|
protected
|
|
function PrepareEntries(AnAddr: TDbgPtr; ALinesBefore, ALinesAfter: Integer): boolean; override;
|
|
end;
|
|
|
|
{ TFPBreakpoint }
|
|
|
|
TFPBreakpoint = class(TDBGBreakPoint)
|
|
private
|
|
FThreadWorker: TFpThreadWorkerBreakPoint;
|
|
FSetBreakFlag: boolean;
|
|
FResetBreakFlag: boolean;
|
|
FInternalBreakpoint: FpDbgClasses.TFpDbgBreakpoint;
|
|
FIsSet: boolean;
|
|
procedure SetBreak;
|
|
procedure ResetBreak;
|
|
protected
|
|
procedure DoStateChange(const AOldState: TDBGState); override;
|
|
procedure DoEnableChange; override;
|
|
procedure DoChanged; override;
|
|
property Validity: TValidState write SetValid;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TFPBreakpoints }
|
|
|
|
TFPBreakpoints = class(TDBGBreakPoints)
|
|
public
|
|
function Find(AIntBReakpoint: FpDbgClasses.TFpDbgBreakpoint): TDBGBreakPoint;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
uses
|
|
FpDbgDisasX86;
|
|
|
|
var
|
|
DBG_VERBOSE, DBG_WARNINGS, DBG_BREAKPOINTS, FPDBG_COMMANDS: PLazLoggerLogGroup;
|
|
|
|
type
|
|
|
|
{ TFpDbgMemReader }
|
|
|
|
TFpDbgMemReader = class(TDbgMemReader)
|
|
private
|
|
FFpDebugDebugger: TFpDebugDebugger;
|
|
FRegNum: Cardinal;
|
|
FRegValue: TDbgPtr;
|
|
FRegContext: TFpDbgLocationContext;
|
|
FRegResult: Boolean;
|
|
procedure DoReadRegister;
|
|
procedure DoRegisterSize;
|
|
protected
|
|
function GetDbgProcess: TDbgProcess; override;
|
|
function GetDbgThread(AContext: TFpDbgLocationContext): TDbgThread; override;
|
|
public
|
|
constructor create(AFpDebugDebuger: TFpDebugDebugger);
|
|
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override; overload;
|
|
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer;
|
|
out ABytesRead: Cardinal): Boolean; override; overload;
|
|
function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
|
|
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr;
|
|
AContext: TFpDbgLocationContext): Boolean; override;
|
|
function RegisterSize(ARegNum: Cardinal): Integer; override;
|
|
//WriteMemory is not overwritten. It must ONLY be called in the debug-thread
|
|
end;
|
|
|
|
{ TFpWaitForConsoleOutputThread }
|
|
|
|
TFpWaitForConsoleOutputThread = class(TThread)
|
|
private
|
|
FFpDebugDebugger: TFpDebugDebugger;
|
|
FHasConsoleOutputQueued: PRTLEvent;
|
|
procedure DoHasConsoleOutput(Data: PtrInt);
|
|
public
|
|
constructor Create(AFpDebugDebugger: TFpDebugDebugger);
|
|
destructor Destroy; override;
|
|
procedure Execute; override;
|
|
end;
|
|
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterDebugger(TFpDebugDebugger);
|
|
end;
|
|
|
|
{ TFpDebugExceptionStepping.TFrameList }
|
|
|
|
procedure TFpDebugExceptionStepping.TFrameList.RemoveOutOfScopeFrames(
|
|
const ACurFrame: TDbgPtr);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := Count - 1;
|
|
while i >= 0 do begin
|
|
if Items[i] < ACurFrame then
|
|
Delete(i);
|
|
dec(i);
|
|
end;
|
|
end;
|
|
|
|
{ TFpThreadWorkerModifyUpdate }
|
|
|
|
procedure TFpThreadWorkerModifyUpdate.DoCallback_DecRef(Data: PtrInt);
|
|
begin
|
|
//
|
|
FDebugger.Locals.TriggerInvalidateLocals;
|
|
FDebugger.Watches.TriggerInvalidateWatchValues;
|
|
FDebugger.CallStack.CurrentCallStackList.Clear;
|
|
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
{ TFpDbgDebggerThreadWorkerItemHelper }
|
|
|
|
function TFpDbgDebggerThreadWorkerItemHelper.FpDebugger: TFpDebugDebugger;
|
|
begin
|
|
Result := TFpDebugDebugger(FDebugger);
|
|
end;
|
|
|
|
{ TFpThreadWorkerRunLoopUpdate }
|
|
|
|
procedure TFpThreadWorkerRunLoopUpdate.LoopFinished_DecRef(Data: PtrInt);
|
|
var
|
|
dbg: TFpDebugDebugger;
|
|
begin
|
|
dbg := FpDebugger;
|
|
UnQueue_DecRef;
|
|
// self may now be invalid
|
|
dbg.DebugLoopFinished(0);
|
|
end;
|
|
|
|
{ TFpThreadWorkerRunLoopAfterIdleUpdate }
|
|
|
|
procedure TFpThreadWorkerRunLoopAfterIdleUpdate.CheckIdleOrRun_DecRef(
|
|
Data: PtrInt);
|
|
var
|
|
WorkItem: TFpThreadWorkerRunLoopAfterIdleUpdate;
|
|
c: LongInt;
|
|
begin
|
|
FpDebugger.FWorkQueue.Lock;
|
|
FpDebugger.DoProcessMessages;
|
|
FpDebugger.CheckAndRunIdle;
|
|
(* IdleThreadCount could (race condition) be to high.
|
|
Then DebugHistory may loose ONE item. (only one working thread.
|
|
Practically this is unlikely, since the thread had time to set
|
|
the count, since the Lock started.
|
|
*)
|
|
c := FpDebugger.FWorkQueue.Count + FpDebugger.FWorkQueue.ThreadCount - FpDebugger.FWorkQueue.IdleThreadCount;
|
|
FpDebugger.FWorkQueue.Unlock;
|
|
|
|
if c = 0 then begin
|
|
FPDebugger.DoProcessMessages;
|
|
FpDebugger.StartDebugLoop;
|
|
end
|
|
else begin
|
|
WorkItem := TFpThreadWorkerRunLoopAfterIdleUpdate.Create(FpDebugger);
|
|
FpDebugger.FWorkQueue.PushItem(WorkItem);
|
|
WorkItem.DecRef;
|
|
end;
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
{ TFpThreadWorkerCallStackCountUpdate }
|
|
|
|
procedure TFpThreadWorkerCallStackCountUpdate.UpdateCallstack_DecRef(
|
|
Data: PtrInt);
|
|
var
|
|
CList: TDbgCallstackEntryList;
|
|
dbg: TFpDebugDebugger;
|
|
begin
|
|
// Runs in IDE thread (TThread.Queue)
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallStackCount.UpdateCallstack_DecRef: system.ThreadID = classes.MainThreadID');
|
|
|
|
if (FCallstack <> nil) then begin
|
|
FCallstack.RemoveFreeNotification(@DoCallstackFreed_DecRef);
|
|
|
|
if (FThread = nil) then
|
|
CList := nil
|
|
else
|
|
CList := FThread.CallStackEntryList;
|
|
|
|
if CList <> nil then begin
|
|
if CList.HasReadAllAvailableFrames then begin
|
|
FCallstack.Count := CList.Count;
|
|
FCallstack.SetCountValidity(ddsValid);
|
|
end
|
|
else begin
|
|
FCallstack.SetHasAtLeastCountInfo(ddsValid, CList.Count);
|
|
end;
|
|
end
|
|
else begin
|
|
FCallstack.SetCountValidity(ddsInvalid);
|
|
FCallstack.SetHasAtLeastCountInfo(ddsInvalid);
|
|
end;
|
|
|
|
// save whatever we have to history // limit to reduce time
|
|
if StopRequested and (CList <> nil) then
|
|
FCallstack.PrepareRange(0, Min(CList.Count, 10));
|
|
|
|
FCallstack := nil;
|
|
end;
|
|
|
|
dbg := FpDebugger;
|
|
UnQueue_DecRef;
|
|
TFPCallStackSupplier(dbg.CallStack).FCallStackWorkers.ClearFinishedWorkers;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerCallStackCountUpdate.DoRemovedFromLinkedList;
|
|
begin
|
|
UpdateCallstack_DecRef; // This trigger PrepareRange => but that still needs to be exec in thread? (or wait for lock)
|
|
end;
|
|
|
|
procedure TFpThreadWorkerCallStackCountUpdate.DoCallstackFreed_DecRef(
|
|
Sender: TObject);
|
|
begin
|
|
// Runs in IDE thread (because it is called by FCallstack)
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallStackCount.DoCallstackFreed_DecRef: system.ThreadID = classes.MainThreadID');
|
|
FCallstack := nil;
|
|
RequestStop;
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
constructor TFpThreadWorkerCallStackCountUpdate.Create(
|
|
ADebugger: TFpDebugDebugger; ACallstack: TCallStackBase;
|
|
ARequiredMinCount: Integer);
|
|
var
|
|
AThread: TDbgThread;
|
|
begin
|
|
// Runs in IDE thread (TThread.Queue)
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallStackCount.Create: system.ThreadID = classes.MainThreadID');
|
|
FCallstack := ACallstack;
|
|
FCallstack.AddFreeNotification(@DoCallstackFreed_DecRef);
|
|
if not ADebugger.FDbgController.CurrentProcess.GetThread(FCallstack.ThreadId, AThread) then
|
|
ARequiredMinCount := -1; // error
|
|
inherited Create(ADebugger, ARequiredMinCount, AThread);
|
|
end;
|
|
|
|
//procedure TFpThreadWorkerCallStackCountUpdate.RemoveCallStack_DecRef;
|
|
//begin
|
|
// // Runs in IDE thread (TThread.Queue)
|
|
// assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallStackCount.RemoveCallStack_DecRef: system.ThreadID = classes.MainThreadID');
|
|
// RequestStop;
|
|
// if (FCallstack <> nil) then begin
|
|
// FCallstack.RemoveFreeNotification(@DoCallstackFreed_DecRef);
|
|
// FCallstack := nil;
|
|
// end;
|
|
// UnQueue_DecRef;
|
|
//end;
|
|
|
|
{ TFpThreadWorkerCallEntryUpdate }
|
|
|
|
procedure TFpThreadWorkerCallEntryUpdate.DoCallstackFreed_DecRef(Sender: TObject
|
|
);
|
|
begin
|
|
// Runs in IDE thread (because it is called by FCallstack)
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallEntry.DoCallstackFreed_DecRef: system.ThreadID = classes.MainThreadID');
|
|
FCallstack := nil;
|
|
DoCallstackEntryFreed_DecRef(nil);
|
|
end;
|
|
|
|
procedure TFpThreadWorkerCallEntryUpdate.DoCallstackEntryFreed_DecRef(
|
|
Sender: TObject);
|
|
begin
|
|
// Runs in IDE thread (because it is called by FCallstack)
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallEntry.DoCallstackEntryFreed_DecRef: system.ThreadID = classes.MainThreadID');
|
|
FCallstackEntry := nil;
|
|
RequestStop;
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerCallEntryUpdate.DoRemovedFromLinkedList;
|
|
begin
|
|
UpdateCallstackEntry_DecRef;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerCallEntryUpdate.UpdateCallstackEntry_DecRef(
|
|
Data: PtrInt);
|
|
var
|
|
dbg: TFpDebugDebugger;
|
|
c: String;
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallEntry.UpdateCallstackEntry_DecRef: system.ThreadID = classes.MainThreadID');
|
|
|
|
if FCallstack <> nil then
|
|
FCallstack.RemoveFreeNotification(@DoCallstackFreed_DecRef);
|
|
|
|
if FCallstackEntry <> nil then begin
|
|
FCallstackEntry.RemoveFreeNotification(@DoCallstackEntryFreed_DecRef);
|
|
|
|
if FCallstackEntry.Validity = ddsRequested then begin
|
|
if FDbgCallStack = nil then
|
|
FCallstackEntry.Validity := ddsInvalid
|
|
else begin
|
|
c := FDbgCallStack.SrcClassName;
|
|
if c <> '' then
|
|
c := c + '.';
|
|
FCallstackEntry.Init(FDbgCallStack.AnAddress, nil,
|
|
c + FDbgCallStack.FunctionName + FParamAsString,
|
|
FDbgCallStack.SourceFile, '', FDbgCallStack.Line, ddsValid);
|
|
end;
|
|
end;
|
|
|
|
if FCallstack <> nil then
|
|
FCallstack.DoEntriesUpdated;
|
|
end;
|
|
FCallstack := nil;
|
|
FCallstackEntry := nil;
|
|
|
|
dbg := FpDebugger;
|
|
UnQueue_DecRef;
|
|
TFPCallStackSupplier(dbg.CallStack).FCallStackWorkers.ClearFinishedWorkers;
|
|
end;
|
|
|
|
constructor TFpThreadWorkerCallEntryUpdate.Create(
|
|
ADebugger: TFpDebugDebuggerBase; AThread: TDbgThread;
|
|
ACallstackEntry: TCallStackEntry; ACallstack: TCallStackBase);
|
|
begin
|
|
// Runs in IDE thread (TThread.Queue)
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallEntry.Create: system.ThreadID = classes.MainThreadID');
|
|
FCallstack := ACallstack;
|
|
if FCallstack <> nil then
|
|
FCallstack.AddFreeNotification(@DoCallstackFreed_DecRef);
|
|
|
|
FCallstackEntry := ACallstackEntry;
|
|
FCallstackEntry.AddFreeNotification(@DoCallstackEntryFreed_DecRef);
|
|
FCallstackIndex := FCallstackEntry.Index;
|
|
|
|
inherited Create(ADebugger, ACallstackEntry.Index+1, AThread);
|
|
end;
|
|
|
|
//procedure TFpThreadWorkerCallEntryUpdate.RemoveCallStackEntry_DecRef;
|
|
//begin
|
|
// // Runs in IDE thread (TThread.Queue)
|
|
// assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallEntry.RemoveCallStackEntry_DecRef: system.ThreadID = classes.MainThreadID');
|
|
// RequestStop;
|
|
// if FCallstack <> nil then begin
|
|
// FCallstack.RemoveFreeNotification(@DoCallstackFreed_DecRef);
|
|
// FCallstack := nil;
|
|
// end;
|
|
// if (FCallstackEntry <> nil) then begin
|
|
// FCallstackEntry.RemoveFreeNotification(@DoCallstackEntryFreed_DecRef);
|
|
// FCallstackEntry := nil;
|
|
// end;
|
|
// UnQueue_DecRef;
|
|
//end;
|
|
|
|
{ TFpThreadWorkerThreadsUpdate }
|
|
|
|
procedure TFpThreadWorkerThreadsUpdate.UpdateThreads_DecRef(Data: PtrInt);
|
|
var
|
|
Threads: TThreadsSupplier;
|
|
ThreadArray: TFPDThreadArray;
|
|
i: Integer;
|
|
CallStack: TDbgCallstackEntryList;
|
|
t, n: TThreadEntry;
|
|
FpThr: TDbgThread;
|
|
c: TDbgCallstackEntry;
|
|
dbg: TFpDebugDebuggerBase;
|
|
begin
|
|
Threads := FDebugger.Threads;
|
|
|
|
if (Threads.CurrentThreads <> nil) then begin
|
|
ThreadArray := FpDebugger.FDbgController.CurrentProcess.GetThreadArray;
|
|
for i := 0 to high(ThreadArray) do begin
|
|
FpThr := ThreadArray[i];
|
|
CallStack := FpThr.CallStackEntryList;
|
|
t := Threads.CurrentThreads.EntryById[FpThr.ID];
|
|
if Assigned(CallStack) and (CallStack.Count > 0) then begin
|
|
c := CallStack.Items[0];
|
|
if t = nil then begin
|
|
n := Threads.CurrentThreads.CreateEntry(c.AnAddress, nil, c.FunctionName, c.SourceFile, '', c.Line, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused');
|
|
Threads.CurrentThreads.Add(n);
|
|
n.Free;
|
|
end
|
|
else
|
|
t.Init(c.AnAddress, nil, c.FunctionName, c.SourceFile, '', c.Line, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused');
|
|
end
|
|
else begin
|
|
if t = nil then begin
|
|
n := Threads.CurrentThreads.CreateEntry(0, nil, '', '', '', 0, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused');
|
|
Threads.CurrentThreads.Add(n);
|
|
n.Free;
|
|
end
|
|
else
|
|
t.Init(0, nil, '', '', '', 0, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused');
|
|
end;
|
|
end;
|
|
|
|
Threads.CurrentThreads.SetValidity(ddsValid);
|
|
end;
|
|
|
|
dbg := FDebugger;
|
|
UnQueue_DecRef;
|
|
TFPThreads(dbg.Threads).FThreadWorkers.ClearFinishedWorkers;
|
|
end;
|
|
|
|
{ TFpThreadWorkerLocalsUpdate }
|
|
|
|
procedure TFpThreadWorkerLocalsUpdate.DoLocalsFreed_DecRef(Sender: TObject);
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerLocals.DoLocalsFreed_DecRef: system.ThreadID = classes.MainThreadID');
|
|
FLocals := nil;
|
|
RequestStop;
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerLocalsUpdate.UpdateLocals_DecRef(Data: PtrInt);
|
|
var
|
|
i: Integer;
|
|
r: TResultEntry;
|
|
dbg: TFpDebugDebugger;
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerLocals.UpdateLocals_DecRef: system.ThreadID = classes.MainThreadID');
|
|
|
|
if FLocals <> nil then begin
|
|
FLocals.RemoveFreeNotification(@DoLocalsFreed_DecRef);
|
|
FLocals.Clear;
|
|
if FResults = nil then begin
|
|
FLocals.SetDataValidity(ddsInvalid);
|
|
FLocals := nil;
|
|
UnQueue_DecRef;
|
|
exit;
|
|
end;
|
|
|
|
for i := 0 to FResults.Count - 1 do begin
|
|
r := FResults[i];
|
|
FLocals.Add(r.Name, r.Value);
|
|
end;
|
|
FLocals.SetDataValidity(ddsValid);
|
|
|
|
FLocals := nil;
|
|
end;
|
|
|
|
dbg := FpDebugger;
|
|
UnQueue_DecRef;
|
|
TFPLocals(dbg.Locals).FLocalWorkers.ClearFinishedWorkers;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerLocalsUpdate.DoRemovedFromLinkedList;
|
|
begin
|
|
if FLocals <> nil then begin
|
|
if FHasQueued = hqQueued then begin
|
|
UpdateLocals_DecRef;
|
|
exit;
|
|
end
|
|
else begin
|
|
FLocals.RemoveFreeNotification(@DoLocalsFreed_DecRef);
|
|
FLocals.SetDataValidity(ddsInvalid);
|
|
end;
|
|
FLocals := nil;
|
|
end;
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
constructor TFpThreadWorkerLocalsUpdate.Create(ADebugger: TFpDebugDebuggerBase;
|
|
ALocals: TLocals);
|
|
begin
|
|
// Runs in IDE thread (TThread.Queue)
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerLocals.Create: system.ThreadID = classes.MainThreadID');
|
|
FLocals := ALocals;
|
|
FLocals.AddFreeNotification(@DoLocalsFreed_DecRef);
|
|
FThreadId := ALocals.ThreadId;
|
|
FStackFrame := ALocals.StackFrame;
|
|
inherited Create(ADebugger, twpLocal);
|
|
end;
|
|
|
|
{ TFpThreadWorkerWatchValueEvalUpdate }
|
|
|
|
procedure TFpThreadWorkerWatchValueEvalUpdate.DoWachCanceled(Sender: TObject);
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerWatchValueEvalUpdate.DoWachCanceled: system.ThreadID = classes.MainThreadID');
|
|
RequestStop;
|
|
UnQueue_DecRef;
|
|
if IsCancelled then begin
|
|
///
|
|
end;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerWatchValueEvalUpdate.UpdateWatch_DecRef(Data: PtrInt);
|
|
var
|
|
dbg: TFpDebugDebuggerBase;
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerWatchValueEval.UpdateWatch_DecRef: system.ThreadID = classes.MainThreadID');
|
|
|
|
if FWatchValue <> nil then begin
|
|
FWatchValue.RemoveNotification(weeCancel, @DoWachCanceled);
|
|
FWatchValue.EndUpdate;
|
|
FWatchValue := nil;
|
|
end;
|
|
|
|
dbg := FDebugger;
|
|
UnQueue_DecRef;
|
|
TFPWatches(dbg.Watches).FWatchEvalWorkers.ClearFinishedWorkers;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerWatchValueEvalUpdate.DoRemovedFromLinkedList;
|
|
begin
|
|
if FWatchValue <> nil then begin
|
|
FWatchValue.RemoveNotification(weeCancel, @DoWachCanceled);
|
|
if FWatchValue.Validity = ddsRequested then
|
|
FWatchValue.Validity := ddsInvalid;
|
|
FWatchValue.EndUpdate;
|
|
FWatchValue := nil;
|
|
end;
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
constructor TFpThreadWorkerWatchValueEvalUpdate.Create(
|
|
ADebugger: TFpDebugDebuggerBase; AWatchValue: TWatchValueIntf);
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerWatchValueEval.Create: system.ThreadID = classes.MainThreadID');
|
|
FWatchValue := AWatchValue;
|
|
FWatchValue.BeginUpdate;
|
|
FWatchValue.AddNotification(weeCancel, @DoWachCanceled);
|
|
|
|
inherited Create(ADebugger, twpWatch, FWatchValue.Expression, FWatchValue.StackFrame, FWatchValue.ThreadId,
|
|
FWatchValue.DisplayFormat, FWatchValue.RepeatCount, FWatchValue.EvaluateFlags);
|
|
end;
|
|
|
|
{ TFpThreadWorkerBreakPointSetUpdate }
|
|
|
|
procedure TFpThreadWorkerBreakPointSetUpdate.UpdateBrkPoint_DecRef(Data: PtrInt
|
|
);
|
|
var
|
|
WorkItem: TFpThreadWorkerBreakPointRemoveUpdate;
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerBreakPointSetUpdate.UpdateBrkPoint_DecRef: system.ThreadID = classes.MainThreadID');
|
|
|
|
if FDbgBreakPoint <> nil then begin
|
|
assert(FDbgBreakPoint.FThreadWorker = Self, 'TFpThreadWorkerBreakPointSetUpdate.UpdateBrkPoint_DecRef: FDbgBreakPoint.FThreadWorker = Self');
|
|
FDbgBreakPoint.FThreadWorker := nil;
|
|
DecRef;
|
|
end
|
|
else
|
|
FResetBreakPoint := True;
|
|
|
|
if FResetBreakPoint then begin
|
|
if InternalBreakpoint <> nil then begin
|
|
WorkItem := TFpThreadWorkerBreakPointRemoveUpdate.Create(FDebugger, InternalBreakpoint);
|
|
FpDebugger.FWorkQueue.PushItem(WorkItem);
|
|
WorkItem.DecRef;
|
|
end;
|
|
end
|
|
else
|
|
if FDbgBreakPoint <> nil then begin
|
|
assert(FDbgBreakPoint.FInternalBreakpoint = nil, 'TFpThreadWorkerBreakPointSetUpdate.UpdateBrkPoint_DecRef: FDbgBreakPoint.FInternalBreakpoint = nil');
|
|
FDbgBreakPoint.FInternalBreakpoint := InternalBreakpoint;
|
|
if not assigned(InternalBreakpoint) then
|
|
FDbgBreakPoint.Validity := vsInvalid // pending?
|
|
else
|
|
FDbgBreakPoint.Validity := vsValid;
|
|
end;
|
|
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
constructor TFpThreadWorkerBreakPointSetUpdate.Create(
|
|
ADebugger: TFpDebugDebuggerBase; ADbgBreakPoint: TFPBreakpoint);
|
|
var
|
|
CurThreadId, CurStackFrame: Integer;
|
|
begin
|
|
FDbgBreakPoint := ADbgBreakPoint;
|
|
case ADbgBreakPoint.Kind of
|
|
bpkAddress: inherited Create(ADebugger, ADbgBreakPoint.Address);
|
|
bpkSource: inherited Create(ADebugger, ADbgBreakPoint.Source, ADbgBreakPoint.Line);
|
|
bpkData: begin
|
|
TFpDebugDebugger(ADebugger).GetCurrentThreadAndStackFrame(CurThreadId, CurStackFrame);
|
|
inherited Create(ADebugger, ADbgBreakPoint.WatchData, ADbgBreakPoint.WatchScope,
|
|
ADbgBreakPoint.WatchKind, CurStackFrame, CurThreadId);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerBreakPointSetUpdate.AbortSetBreak;
|
|
begin
|
|
FResetBreakPoint := True;
|
|
RequestStop;
|
|
end;
|
|
|
|
procedure TFpThreadWorkerBreakPointSetUpdate.RemoveBreakPoint_DecRef;
|
|
begin
|
|
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerBreakPointSetUpdate.RemoveBreakPoint_DecRef: system.ThreadID = classes.MainThreadID');
|
|
FDbgBreakPoint := nil;
|
|
UnQueue_DecRef;
|
|
end;
|
|
|
|
{ TFpThreadWorkerBreakPointRemoveUpdate }
|
|
|
|
procedure TFpThreadWorkerBreakPointRemoveUpdate.DoUnQueued;
|
|
begin
|
|
if FInternalBreakpoint = nil then
|
|
exit;
|
|
FInternalBreakpoint.FreeByDbgProcess := True;
|
|
inherited DoUnQueued;
|
|
end;
|
|
|
|
constructor TFpThreadWorkerBreakPointRemoveUpdate.Create(
|
|
ADebugger: TFpDebugDebuggerBase; ADbgBreakPoint: TFPBreakpoint);
|
|
begin
|
|
inherited Create(ADebugger, ADbgBreakPoint.FInternalBreakpoint);
|
|
end;
|
|
|
|
{ TDbgControllerStepOverFirstFinallyLineCmd }
|
|
|
|
procedure TDbgControllerStepOverFirstFinallyLineCmd.DoResolveEvent(
|
|
var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean);
|
|
begin
|
|
Finished := (FThread.CompareStepInfo(0, True) <> dcsiSameLine) or
|
|
(NextInstruction.IsReturnInstruction) or IsSteppedOut;
|
|
|
|
if Finished then
|
|
AnEvent := deFinishedStep
|
|
else
|
|
if AnEvent in [deFinishedStep] then
|
|
AnEvent:=deInternalContinue;
|
|
end;
|
|
|
|
{ TDbgControllerStepOverOrFinallyCmd }
|
|
|
|
procedure TDbgControllerStepOverOrFinallyCmd.InternalContinue(
|
|
AProcess: TDbgProcess; AThread: TDbgThread);
|
|
var
|
|
Instr: TDbgAsmInstruction;
|
|
begin
|
|
{
|
|
32bit
|
|
00000000004321D3 89E8 mov eax,ebp
|
|
00000000004321D5 E866FEFFFF call -$0000019A
|
|
|
|
64bit
|
|
00000001000374AE 4889C1 mov rcx,rax
|
|
00000001000374B1 488D15D3FFFFFF lea rdx,[rip-$0000002D]
|
|
00000001000374B8 4989E8 mov rax,rbp
|
|
00000001000374BB E89022FEFF call -$0001DD70
|
|
}
|
|
if (AThread = FThread) then begin
|
|
Instr := NextInstruction;
|
|
if Instr is TX86AsmInstruction then begin
|
|
case TX86AsmInstruction(Instr).X86OpCode of
|
|
OPmov:
|
|
if FProcess.Mode = dm32 then begin
|
|
if CompareText(TX86AsmInstruction(Instr).X86Instruction.Operand[2].Value, 'EBP') = 0 then
|
|
FFinState := fsMov;
|
|
end
|
|
else begin
|
|
if CompareText(TX86AsmInstruction(Instr).X86Instruction.Operand[2].Value, 'RBP') = 0 then
|
|
FFinState := fsMov;
|
|
end;
|
|
OPcall:
|
|
if FFinState = fsMov then begin
|
|
CheckForCallAndSetBreak;
|
|
FProcess.Continue(FProcess, FThread, True); // Step into
|
|
FFinState := fsCall;
|
|
exit;
|
|
end;
|
|
else
|
|
FFinState := fsNone;
|
|
end;
|
|
end;
|
|
end;
|
|
inherited InternalContinue(AProcess, AThread);
|
|
end;
|
|
|
|
procedure TDbgControllerStepOverOrFinallyCmd.DoResolveEvent(
|
|
var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean);
|
|
var
|
|
sym: TFpSymbol;
|
|
begin
|
|
if FFinState = fsCall then begin
|
|
sym := FProcess.FindProcSymbol(FThread.GetInstructionPointerRegisterValue);
|
|
if pos('fin$', sym.Name) > 0 then
|
|
FFinState := fsInFin
|
|
else
|
|
FFinState := fsNone;
|
|
sym.ReleaseReference;
|
|
|
|
if FFinState = fsInFin then begin
|
|
FThread.StoreStepInfo;
|
|
Finished := False;
|
|
RemoveHiddenBreak;
|
|
if AnEvent = deFinishedStep then
|
|
AnEvent := deInternalContinue;
|
|
exit;
|
|
end;
|
|
end;
|
|
inherited DoResolveEvent(AnEvent, AnEventThread, Finished);
|
|
end;
|
|
|
|
{ TDbgControllerStepThroughFpcSpecialHandler }
|
|
|
|
procedure TDbgControllerStepThroughFpcSpecialHandler.DoResolveEvent(
|
|
var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean);
|
|
begin
|
|
AnEvent := deInternalContinue;
|
|
Finished := False;
|
|
if FInteralFinished then
|
|
exit;
|
|
|
|
if IsAtOrOutOfHiddenBreakFrame then
|
|
RemoveHiddenBreak;
|
|
|
|
FInteralFinished := IsSteppedOut or FDone or ((not HasHiddenBreak) and (NextInstruction.IsReturnInstruction));
|
|
if FInteralFinished then begin
|
|
RemoveHiddenBreak;
|
|
Finished := FIsLeave;
|
|
if Finished then
|
|
AnEvent := deFinishedStep;
|
|
end;
|
|
end;
|
|
|
|
procedure TDbgControllerStepThroughFpcSpecialHandler.InternalContinue(
|
|
AProcess: TDbgProcess; AThread: TDbgThread);
|
|
begin
|
|
if FInteralFinished then begin
|
|
CallProcessContinue(False);
|
|
exit;
|
|
end;
|
|
|
|
{$PUSH}{$Q-}{$R-}
|
|
if (AThread = FThread) and
|
|
(NextInstruction.IsCallInstruction) and
|
|
(FThread.GetInstructionPointerRegisterValue + NextInstruction.InstructionLength = FAfterFinCallAddr)
|
|
then begin
|
|
RemoveHiddenBreak;
|
|
FProcess.Continue(FProcess, FThread, True);
|
|
FDone := True;
|
|
// TODO: last step => then single line step
|
|
exit;
|
|
end;
|
|
{$POP}
|
|
inherited InternalContinue(AProcess, AThread);
|
|
end;
|
|
|
|
procedure TDbgControllerStepThroughFpcSpecialHandler.Init;
|
|
begin
|
|
InitStackFrameInfo;
|
|
inherited Init;
|
|
end;
|
|
|
|
constructor TDbgControllerStepThroughFpcSpecialHandler.Create(
|
|
AController: TDbgController; AnAfterFinCallAddr: TDbgPtr; AnIsLeave: Boolean);
|
|
begin
|
|
FAfterFinCallAddr := AnAfterFinCallAddr;
|
|
FIsLeave := AnIsLeave;
|
|
inherited Create(AController);
|
|
end;
|
|
|
|
{ TFpDebugExceptionStepping.TAddressFrameList }
|
|
|
|
function TFpDebugExceptionStepping.TAddressFrameList.Add(
|
|
const AnAddress: TDbgPtr): TFrameList;
|
|
begin
|
|
Result := TFrameList.Create;
|
|
inherited Add(AnAddress, Result);
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.TAddressFrameList.Add(const AnAddress,
|
|
AFrame: TDbgPtr): boolean;
|
|
var
|
|
i: Integer;
|
|
Frames: TFrameList;
|
|
begin
|
|
if AFrame < FLastRemoveCheck then
|
|
FLastRemoveCheck := 0;
|
|
Result := False;
|
|
i := IndexOf(AnAddress);
|
|
|
|
if i >= 0 then
|
|
Frames := Data[i]
|
|
else
|
|
Frames := Add(AnAddress);
|
|
|
|
Result := IndexOf(AFrame) >= 0;
|
|
if Result then
|
|
exit;
|
|
Frames.Add(AFrame);
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.TAddressFrameList.Remove(const AnAddress,
|
|
AFrame: TDbgPtr): boolean;
|
|
var
|
|
i: Integer;
|
|
Frames: TFrameList;
|
|
begin
|
|
i := IndexOf(AnAddress);
|
|
Result := i < 0;
|
|
if Result then
|
|
exit;
|
|
|
|
Frames := Data[i];
|
|
Frames.Remove(AFrame);
|
|
Result := Frames.Count = 0;
|
|
if Result then
|
|
Delete(i);
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.TAddressFrameList.RemoveOutOfScopeFrames(
|
|
const ACurFrame: TDbgPtr; ABreakPoint: TFpDbgBreakpoint);
|
|
begin
|
|
if ACurFrame = FLastRemoveCheck then
|
|
exit;
|
|
DoRemoveOutOfScopeFrames(ACurFrame, ABreakPoint);
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.TAddressFrameList.DoRemoveOutOfScopeFrames(
|
|
const ACurFrame: TDbgPtr; ABreakPoint: TFpDbgBreakpoint);
|
|
var
|
|
i: Integer;
|
|
f: TFrameList;
|
|
begin
|
|
FLastRemoveCheck := ACurFrame;
|
|
|
|
i := Count - 1;
|
|
while i >= 0 do begin
|
|
f := Data[i];
|
|
f.RemoveOutOfScopeFrames(ACurFrame);
|
|
if f.Count = 0 then begin
|
|
ABreakPoint.RemoveAddress(Keys[i]);
|
|
Delete(i);
|
|
end;
|
|
dec(i);
|
|
end;
|
|
end;
|
|
|
|
{ TFPThreads }
|
|
|
|
procedure TFPThreads.DoStateEnterPause;
|
|
begin
|
|
inherited DoStateEnterPause;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TFPThreads.DoStateChange(const AOldState: TDBGState);
|
|
begin
|
|
inherited DoStateChange(AOldState);
|
|
if (Debugger.State in [dsPause, dsInternalPause]) then // Make sure we have threads first // this can be removed, once threads are KEPT between pauses
|
|
RequestEntries;
|
|
end;
|
|
|
|
procedure TFPThreads.StopWorkes;
|
|
begin
|
|
FThreadWorkers.RequestStopForWorkers;
|
|
end;
|
|
|
|
procedure TFPThreads.DoStateLeavePause;
|
|
begin
|
|
inherited DoStateLeavePause;
|
|
FThreadWorkers.WaitForWorkers(True);
|
|
end;
|
|
|
|
procedure TFPThreads.RequestEntries;
|
|
var
|
|
ThreadArray: TFPDThreadArray;
|
|
i: Integer;
|
|
ThreadEntry: TThreadEntry;
|
|
begin
|
|
if CurrentThreads = nil then exit;
|
|
if Debugger = nil then Exit;
|
|
if not TFpDebugDebugger(Debugger).IsPausedAndValid then exit;
|
|
|
|
CurrentThreads.Clear;
|
|
|
|
ThreadArray := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.GetThreadArray;
|
|
for i := 0 to high(ThreadArray) do begin
|
|
// TODO: Maybe get the address. If FpDebug has already read the ThreadState.
|
|
ThreadEntry := CurrentThreads.CreateEntry(0, nil, '', '', '', 0, ThreadArray[i].ID, 'Thread ' + IntToStr(ThreadArray[i].ID), 'paused');
|
|
try
|
|
CurrentThreads.Add(ThreadEntry);
|
|
finally
|
|
ThreadEntry.Free;
|
|
end;
|
|
end;
|
|
|
|
if TFpDebugDebugger(Debugger).FDbgController.CurrentThread = nil then
|
|
CurrentThreads.CurrentThreadId := 0 // TODO: only until controller is guranteed to have a currentthread
|
|
else
|
|
CurrentThreads.CurrentThreadId := TFpDebugDebugger(Debugger).FDbgController.CurrentThread.ID;
|
|
// Do NOT set validity // keep ddsUnknown;
|
|
end;
|
|
|
|
destructor TFPThreads.Destroy;
|
|
begin
|
|
FThreadWorkers.WaitForWorkers(True);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFPThreads.RequestMasterData;
|
|
var
|
|
WorkItem: TFpThreadWorkerThreadsUpdate;
|
|
begin
|
|
if CurrentThreads = nil then exit;
|
|
if Debugger = nil then Exit;
|
|
|
|
if not (Debugger.State in [dsPause, dsInternalPause {, dsRun}]) then begin // Make sure we have threads first // this can be removed, once threads are KEPT between pauses
|
|
CurrentThreads.Clear;
|
|
Exit;
|
|
end;
|
|
|
|
WorkItem := TFpThreadWorkerThreadsUpdate.Create(TFpDebugDebugger(Debugger));
|
|
TFpDebugDebugger(Debugger).FWorkQueue.PushItem(WorkItem);
|
|
FThreadWorkers.Add(WorkItem);
|
|
end;
|
|
|
|
procedure TFPThreads.ChangeCurrentThread(ANewId: Integer);
|
|
begin
|
|
inherited ChangeCurrentThread(ANewId);
|
|
if not(Debugger.State in [dsPause, dsInternalPause]) then exit;
|
|
|
|
TFpDebugDebugger(Debugger).FDbgController.CurrentThreadId := ANewId;
|
|
if CurrentThreads <> nil then
|
|
CurrentThreads.CurrentThreadId := ANewId;
|
|
Changed;
|
|
end;
|
|
|
|
{ TFpWaitForConsoleOutputThread }
|
|
|
|
procedure TFpWaitForConsoleOutputThread.DoHasConsoleOutput(Data: PtrInt);
|
|
var
|
|
s: string;
|
|
begin
|
|
if (Data=0) or assigned(TFpDebugDebugger(Data).FConsoleOutputThread) then
|
|
begin
|
|
s := FFpDebugDebugger.FDbgController.CurrentProcess.GetConsoleOutput;
|
|
RTLeventSetEvent(FHasConsoleOutputQueued);
|
|
if Assigned(FFpDebugDebugger.OnConsoleOutput) then
|
|
FFpDebugDebugger.OnConsoleOutput(self, s);
|
|
end;
|
|
end;
|
|
|
|
constructor TFpWaitForConsoleOutputThread.Create(AFpDebugDebugger: TFpDebugDebugger);
|
|
begin
|
|
Inherited create(false);
|
|
FHasConsoleOutputQueued := RTLEventCreate;
|
|
FFpDebugDebugger := AFpDebugDebugger;
|
|
end;
|
|
|
|
destructor TFpWaitForConsoleOutputThread.Destroy;
|
|
begin
|
|
Application.RemoveAsyncCalls(Self);
|
|
RTLeventdestroy(FHasConsoleOutputQueued);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFpWaitForConsoleOutputThread.Execute;
|
|
var
|
|
res: integer;
|
|
begin
|
|
while not terminated do
|
|
begin
|
|
res := FFpDebugDebugger.FDbgController.CurrentProcess.CheckForConsoleOutput(100);
|
|
if res<0 then
|
|
Terminate
|
|
else if res>0 then
|
|
begin
|
|
RTLeventResetEvent(FHasConsoleOutputQueued);
|
|
Application.QueueAsyncCall(@DoHasConsoleOutput, PtrInt(FFpDebugDebugger));
|
|
RTLeventWaitFor(FHasConsoleOutputQueued);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TFpDbgMemReader }
|
|
|
|
function TFpDbgMemReader.GetDbgProcess: TDbgProcess;
|
|
begin
|
|
result := FFpDebugDebugger.FDbgController.CurrentProcess;
|
|
end;
|
|
|
|
function TFpDbgMemReader.GetDbgThread(AContext: TFpDbgLocationContext): TDbgThread;
|
|
var
|
|
Process: TDbgProcess;
|
|
begin
|
|
Process := GetDbgProcess;
|
|
if not Process.GetThread(AContext.ThreadId, Result) then
|
|
Result := FFpDebugDebugger.FDbgController.CurrentThread;
|
|
end;
|
|
|
|
procedure TFpDbgMemReader.DoReadRegister;
|
|
begin
|
|
FRegResult := inherited ReadRegister(FRegNum, FRegValue, FRegContext);
|
|
end;
|
|
|
|
procedure TFpDbgMemReader.DoRegisterSize;
|
|
begin
|
|
FRegValue := inherited RegisterSize(FRegNum);
|
|
end;
|
|
|
|
constructor TFpDbgMemReader.create(AFpDebugDebuger: TFpDebugDebugger);
|
|
begin
|
|
FFpDebugDebugger := AFpDebugDebuger;
|
|
end;
|
|
|
|
function TFpDbgMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
|
|
begin
|
|
result := FFpDebugDebugger.ReadData(AnAddress, ASize, ADest^);
|
|
end;
|
|
|
|
function TFpDbgMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
|
|
ADest: Pointer; out ABytesRead: Cardinal): Boolean;
|
|
begin
|
|
result := FFpDebugDebugger.ReadData(AnAddress, ASize, ADest^, ABytesRead);
|
|
end;
|
|
|
|
function TFpDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
|
|
begin
|
|
Assert(AnAddressSpace>0,'TFpDbgMemReader.ReadMemoryEx ignores AddressSpace');
|
|
result := FFpDebugDebugger.ReadData(AnAddress, ASize, ADest^);
|
|
end;
|
|
|
|
function TFpDbgMemReader.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr;
|
|
AContext: TFpDbgLocationContext): Boolean;
|
|
begin
|
|
// Shortcut, if in debug-thread / do not use Self.F*
|
|
if ThreadID = FFpDebugDebugger.FWorkerThreadId then
|
|
exit(inherited ReadRegister(ARegNum, AValue, AContext));
|
|
|
|
FRegNum := ARegNum;
|
|
FRegContext := AContext;
|
|
FRegValue := 0; // TODO: error detection
|
|
FFpDebugDebugger.ExecuteInDebugThread(@DoReadRegister);
|
|
AValue := FRegValue;
|
|
result := FRegResult;
|
|
end;
|
|
|
|
function TFpDbgMemReader.RegisterSize(ARegNum: Cardinal): Integer;
|
|
begin
|
|
// Shortcut, if in debug-thread / do not use Self.F*
|
|
if ThreadID = FFpDebugDebugger.FWorkerThreadId then
|
|
exit(inherited RegisterSize(ARegNum));
|
|
|
|
FRegNum := ARegNum;
|
|
FFpDebugDebugger.ExecuteInDebugThread(@DoRegisterSize);
|
|
result := FRegValue;
|
|
end;
|
|
|
|
{ TFPCallStackSupplier }
|
|
|
|
function TFPCallStackSupplier.FpDebugger: TFpDebugDebugger;
|
|
begin
|
|
Result := TFpDebugDebugger(Debugger);
|
|
end;
|
|
|
|
procedure TFPCallStackSupplier.StopWorkes;
|
|
begin
|
|
FCallStackWorkers.RequestStopForWorkers;
|
|
end;
|
|
|
|
procedure TFPCallStackSupplier.DoStateLeavePause;
|
|
begin
|
|
FCallStackWorkers.WaitForWorkers(True);
|
|
FInitialFrame := 0;
|
|
FThreadForInitialFrame := 0;
|
|
if (TFpDebugDebugger(Debugger).FDbgController <> nil) and
|
|
(TFpDebugDebugger(Debugger).FDbgController.CurrentProcess <> nil)
|
|
then
|
|
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.ThreadsClearCallStack;
|
|
inherited DoStateLeavePause;
|
|
end;
|
|
|
|
constructor TFPCallStackSupplier.Create(const ADebugger: TDebuggerIntf);
|
|
begin
|
|
inherited Create(ADebugger);
|
|
FPrettyPrinter := TFpPascalPrettyPrinter.Create(sizeof(pointer));
|
|
end;
|
|
|
|
destructor TFPCallStackSupplier.Destroy;
|
|
begin
|
|
FCallStackWorkers.WaitForWorkers(True);
|
|
inherited Destroy;
|
|
FPrettyPrinter.Free;
|
|
end;
|
|
|
|
procedure TFPCallStackSupplier.RequestCount(ACallstack: TCallStackBase);
|
|
begin
|
|
RequestAtLeastCount(ACallstack, -1);
|
|
end;
|
|
|
|
procedure TFPCallStackSupplier.RequestAtLeastCount(ACallstack: TCallStackBase;
|
|
ARequiredMinCount: Integer);
|
|
var
|
|
WorkItem: TFpThreadWorkerCallStackCountUpdate;
|
|
begin
|
|
if not FpDebugger.IsPausedAndValid then begin
|
|
ACallstack.SetCountValidity(ddsInvalid);
|
|
exit;
|
|
end;
|
|
|
|
WorkItem := TFpThreadWorkerCallStackCountUpdate.Create(FpDebugger, ACallstack, ARequiredMinCount);
|
|
FpDebugger.FWorkQueue.PushItem(WorkItem);
|
|
FCallStackWorkers.Add(WorkItem);
|
|
end;
|
|
|
|
procedure TFPCallStackSupplier.RequestEntries(ACallstack: TCallStackBase);
|
|
var
|
|
e: TCallStackEntry;
|
|
It: TMapIterator;
|
|
t: TDbgThread;
|
|
WorkItem: TFpThreadWorkerCallEntryUpdate;
|
|
i: Integer;
|
|
begin
|
|
It := TMapIterator.Create(ACallstack.RawEntries);
|
|
if not It.Locate(ACallstack.LowestUnknown )
|
|
then if not It.EOM
|
|
then It.Next;
|
|
|
|
if not FpDebugger.IsPausedAndValid then begin
|
|
while (not IT.EOM) and (TCallStackEntry(It.DataPtr^).Index <= ACallstack.HighestUnknown) do begin
|
|
TCallStackEntry(It.DataPtr^).Validity := ddsInvalid;
|
|
IT.Next;
|
|
end;
|
|
It.Free;
|
|
exit;
|
|
end;
|
|
|
|
if not FpDebugger.FDbgController.CurrentProcess.GetThread(ACallstack.ThreadId, t) then
|
|
t := nil;
|
|
|
|
i := 0;
|
|
while (not IT.EOM) and (TCallStackEntry(It.DataPtr^).Index <= ACallstack.HighestUnknown)
|
|
do begin
|
|
e := TCallStackEntry(It.DataPtr^);
|
|
It.Next;
|
|
inc(i);
|
|
if e.Validity = ddsRequested then
|
|
begin
|
|
if t = nil then
|
|
e.Validity := ddsInvalid
|
|
else
|
|
begin
|
|
if IT.EOM or ((i and 7) = 0) then
|
|
WorkItem := TFpThreadWorkerCallEntryUpdate.Create(FpDebugger, t, e, ACallstack)
|
|
else
|
|
WorkItem := TFpThreadWorkerCallEntryUpdate.Create(FpDebugger, t, e);
|
|
FpDebugger.FWorkQueue.PushItem(WorkItem);
|
|
FCallStackWorkers.Add(WorkItem);
|
|
end;
|
|
end;
|
|
end;
|
|
It.Free;
|
|
end;
|
|
|
|
procedure TFPCallStackSupplier.RequestCurrent(ACallstack: TCallStackBase);
|
|
begin
|
|
if (FThreadForInitialFrame <> 0) and (FThreadForInitialFrame = ACallstack.ThreadId) then begin
|
|
ACallstack.CurrentIndex := FInitialFrame;
|
|
FInitialFrame := 0;
|
|
FThreadForInitialFrame := 0;
|
|
end
|
|
else
|
|
ACallstack.CurrentIndex := 0;
|
|
ACallstack.SetCurrentValidity(ddsValid);
|
|
end;
|
|
|
|
procedure TFPCallStackSupplier.UpdateCurrentIndex;
|
|
var
|
|
tid, idx: Integer;
|
|
cs: TCallStackBase;
|
|
begin
|
|
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
|
|
exit;
|
|
end;
|
|
|
|
tid := Debugger.Threads.CurrentThreads.CurrentThreadId;
|
|
cs := TCallStackBase(CurrentCallStackList.EntriesForThreads[tid]);
|
|
idx := cs.NewCurrentIndex; // NEW-CURRENT
|
|
|
|
if cs <> nil then begin
|
|
cs.CurrentIndex := idx;
|
|
cs.SetCurrentValidity(ddsValid);
|
|
end;
|
|
end;
|
|
|
|
{ TFPLocals }
|
|
|
|
function TFPLocals.FpDebugger: TFpDebugDebugger;
|
|
begin
|
|
Result := TFpDebugDebugger(Debugger);
|
|
end;
|
|
|
|
procedure TFPLocals.StopWorkes;
|
|
begin
|
|
FLocalWorkers.RequestStopForWorkers;
|
|
end;
|
|
|
|
procedure TFPLocals.DoStateLeavePause;
|
|
begin
|
|
inherited DoStateLeavePause;
|
|
FLocalWorkers.WaitForWorkers(True);
|
|
end;
|
|
|
|
destructor TFPLocals.Destroy;
|
|
begin
|
|
FLocalWorkers.WaitForWorkers(True);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFPLocals.RequestData(ALocals: TLocals);
|
|
var
|
|
WorkItem: TFpThreadWorkerLocalsUpdate;
|
|
begin
|
|
if not FpDebugger.IsPausedAndValid then begin
|
|
ALocals.SetDataValidity(ddsInvalid);
|
|
exit;
|
|
end;
|
|
|
|
WorkItem := TFpThreadWorkerLocalsUpdate.Create(FpDebugger, ALocals);
|
|
FLocalWorkers.Add(WorkItem);
|
|
FpDebugger.FWorkQueue.PushItem(WorkItem);
|
|
end;
|
|
|
|
{ TFPBreakpoints }
|
|
|
|
function TFPBreakpoints.Find(AIntBReakpoint: FpDbgClasses.TFpDbgBreakpoint): TDBGBreakPoint;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to count-1 do
|
|
if TFPBreakpoint(Items[i]).FInternalBreakpoint=AIntBReakpoint then
|
|
begin
|
|
result := TFPBreakpoint(Items[i]);
|
|
Exit;
|
|
end;
|
|
result := nil;
|
|
end;
|
|
|
|
procedure TFPBreakpoint.SetBreak;
|
|
begin
|
|
debuglnEnter(DBG_BREAKPOINTS, ['>> TFPBreakpoint.SetBreak ADD ',FSource,':',FLine,'/',dbghex(Address),' ' ]);
|
|
assert(FThreadWorker = nil, 'TFPBreakpoint.SetBreak: FThreadWorker = nil');
|
|
assert(FInternalBreakpoint=nil);
|
|
|
|
FThreadWorker := TFpThreadWorkerBreakPointSetUpdate.Create(TFpDebugDebugger(Debugger), Self);
|
|
TFpDebugDebugger(Debugger).FWorkQueue.PushItem(FThreadWorker);
|
|
|
|
FValid := vsUnknown;
|
|
FIsSet:=true;
|
|
debuglnExit(DBG_BREAKPOINTS, ['<< TFPBreakpoint.SetBreak ' ]);
|
|
end;
|
|
|
|
procedure TFPBreakpoint.ResetBreak;
|
|
var
|
|
WorkItem: TFpThreadWorkerBreakPointRemoveUpdate;
|
|
begin
|
|
FIsSet:=false;
|
|
if FThreadWorker <> nil then begin
|
|
debugln(DBG_BREAKPOINTS, ['>> TFPBreakpoint.ResetBreak CANCEL / REMOVE ',FSource,':',FLine,'/',dbghex(Address),' ' ]);
|
|
assert(FThreadWorker is TFpThreadWorkerBreakPointSetUpdate, 'TFPBreakpoint.ResetBreak: FThreadWorker is TFpThreadWorkerBreakPointSetUpdate');
|
|
assert(FInternalBreakpoint = nil, 'TFPBreakpoint.ResetBreak: FInternalBreakpoint = nil');
|
|
FThreadWorker.AbortSetBreak;
|
|
FThreadWorker.RemoveBreakPoint_DecRef;
|
|
FThreadWorker.DecRef;
|
|
FThreadWorker := nil;
|
|
exit;
|
|
end;
|
|
|
|
// If Debugger is not assigned, the Controller's currentprocess is already
|
|
// freed. And so are the corresponding InternalBreakpoint's.
|
|
if assigned(Debugger) and assigned(FInternalBreakpoint) then
|
|
begin
|
|
debuglnEnter(DBG_BREAKPOINTS, ['>> TFPBreakpoint.ResetBreak REMOVE ',FSource,':',FLine,'/',dbghex(Address),' ' ]);
|
|
WorkItem := TFpThreadWorkerBreakPointRemoveUpdate.Create(TFpDebugDebugger(Debugger), Self);
|
|
TFpDebugDebugger(Debugger).FWorkQueue.PushItem(WorkItem);
|
|
WorkItem.DecRef;
|
|
FInternalBreakpoint := nil;
|
|
debuglnExit(DBG_BREAKPOINTS, ['<< TFPBreakpoint.ResetBreak ' ]);
|
|
end;
|
|
end;
|
|
|
|
destructor TFPBreakpoint.Destroy;
|
|
begin
|
|
(* No need to request a pause. This will run, as soon as the debugger gets to the next pause.
|
|
If the next pause is a hit on this breakpoint, then it will be ignored
|
|
*)
|
|
ResetBreak;
|
|
|
|
if FThreadWorker <> nil then begin
|
|
FThreadWorker.AbortSetBreak;
|
|
FThreadWorker.RemoveBreakPoint_DecRef;
|
|
FThreadWorker.DecRef;
|
|
FThreadWorker := nil;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFPBreakpoint.DoStateChange(const AOldState: TDBGState);
|
|
begin
|
|
if (Debugger.State in [dsPause, dsInternalPause]) or
|
|
(TFpDebugDebugger(Debugger).FSendingEvents and (Debugger.State in [dsRun, dsInit]))
|
|
then
|
|
begin
|
|
if Enabled and not FIsSet then
|
|
begin
|
|
FSetBreakFlag:=true;
|
|
Changed;
|
|
end
|
|
else if not enabled and FIsSet then
|
|
begin
|
|
FResetBreakFlag:=true;
|
|
Changed;
|
|
end;
|
|
end
|
|
else if Debugger.State = dsStop then
|
|
begin
|
|
ResetBreak;
|
|
end;
|
|
inherited DoStateChange(AOldState);
|
|
end;
|
|
|
|
procedure TFPBreakpoint.DoEnableChange;
|
|
var
|
|
ADebugger: TFpDebugDebugger;
|
|
begin
|
|
ADebugger := TFpDebugDebugger(Debugger);
|
|
if (ADebugger.State in [dsPause, dsInternalPause, dsInit]) or TFpDebugDebugger(Debugger).FSendingEvents then
|
|
begin
|
|
if Enabled and not FIsSet then
|
|
FSetBreakFlag := True
|
|
else if not Enabled and FIsSet then
|
|
FResetBreakFlag := True;
|
|
end
|
|
else if (ADebugger.State = dsRun) and (Enabled and not FIsSet) then
|
|
ADebugger.QuickPause;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TFPBreakpoint.DoChanged;
|
|
begin
|
|
if FResetBreakFlag and not FSetBreakFlag then
|
|
ResetBreak
|
|
else if FSetBreakFlag then
|
|
SetBreak;
|
|
|
|
FSetBreakFlag := false;
|
|
FResetBreakFlag := false;
|
|
|
|
inherited DoChanged;
|
|
end;
|
|
|
|
{ TFPDBGDisassembler }
|
|
|
|
function TFPDBGDisassembler.PrepareEntries(AnAddr: TDbgPtr; ALinesBefore, ALinesAfter: Integer): boolean;
|
|
var
|
|
ARange, AReversedRange: TDBGDisassemblerEntryRange;
|
|
AnEntry: TDisassemblerEntry;
|
|
CodeBin: TBytes;
|
|
p: pointer;
|
|
ADump,
|
|
AStatement,
|
|
ASrcFileName,
|
|
AFuncName: string;
|
|
ASrcFileLine: integer;
|
|
i,j, sz, bytesDisassembled, bufOffset: Integer;
|
|
Sym: TFpSymbol;
|
|
StatIndex: integer;
|
|
FirstIndex: integer;
|
|
ALastAddr, tmpAddr, tmpPointer, prevInstructionSize: TDBGPtr;
|
|
ADisassembler: TDbgAsmDecoder;
|
|
AOffset: longint;
|
|
begin
|
|
Result := False;
|
|
if (Debugger = nil) or not(Debugger.State = dsPause) then
|
|
exit;
|
|
|
|
ADisassembler := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.Disassembler;
|
|
Sym:=nil;
|
|
ASrcFileLine:=0;
|
|
ASrcFileName:='';
|
|
StatIndex:=0;
|
|
FirstIndex:=0;
|
|
ARange := TDBGDisassemblerEntryRange.Create;
|
|
ARange.RangeStartAddr:=AnAddr;
|
|
ALastAddr:=0;
|
|
|
|
if (ALinesBefore > 0) and
|
|
ADisassembler.CanReverseDisassemble then
|
|
begin
|
|
AReversedRange := TDBGDisassemblerEntryRange.Create;
|
|
tmpAddr := AnAddr; // do not modify AnAddr in this loop
|
|
// Large enough block of memory for whole loop
|
|
sz := ADisassembler.MaxInstructionSize * ALinesBefore;
|
|
SetLength(CodeBin, sz);
|
|
|
|
// TODO: Check if AnAddr is at lower address than length(CodeBin)
|
|
// and ensure ReadData size doesn't exceed available target memory.
|
|
// Fill out of bounds memory in buffer with "safe" value e.g. 0
|
|
if sz > AnAddr then
|
|
begin
|
|
FillByte(CodeBin[0], sz, 0);
|
|
// offset into buffer where active memory should start
|
|
bufOffset := sz - AnAddr;
|
|
// size of active memory to read
|
|
sz := integer(AnAddr);
|
|
end
|
|
else
|
|
begin
|
|
bufOffset := 0;
|
|
end;
|
|
|
|
// Everything now counts back from starting address...
|
|
bytesDisassembled := 0;
|
|
// Only read up to byte before this address
|
|
if not TFpDebugDebugger(Debugger).ReadData(tmpAddr-sz, sz, CodeBin[bufOffset]) then
|
|
DebugLn(Format('Reverse disassemble: Failed to read memory at %s.', [FormatAddress(tmpAddr)]))
|
|
else
|
|
for i := 0 to ALinesBefore-1 do
|
|
begin
|
|
if bytesDisassembled >= sz then
|
|
break;
|
|
|
|
tmpPointer := TDBGPtr(@CodeBin[bufOffset]) + TDBGPtr(sz) - TDBGPtr(bytesDisassembled);
|
|
p := pointer(tmpPointer);
|
|
ADisassembler.ReverseDisassemble(p, ADump, AStatement); // give statement before pointer p, pointer p points to decoded instruction on return
|
|
prevInstructionSize := tmpPointer - PtrUInt(p);
|
|
bytesDisassembled := bytesDisassembled + prevInstructionSize;
|
|
DebugLn(DBG_VERBOSE, format('Disassembled: [%.8X: %s] %s',[tmpAddr, ADump, Astatement]));
|
|
|
|
Dec(tmpAddr, prevInstructionSize);
|
|
Sym := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.FindProcSymbol(tmpAddr);
|
|
// If this is the last statement for this source-code-line, fill the
|
|
// SrcStatementCount from the prior statements.
|
|
if (assigned(sym) and ((ASrcFileName<>sym.FileName) or (ASrcFileLine<>sym.Line))) or
|
|
(not assigned(sym) and ((ASrcFileLine<>0) or (ASrcFileName<>''))) then
|
|
begin
|
|
for j := 0 to StatIndex-1 do
|
|
begin
|
|
with AReversedRange.EntriesPtr[FirstIndex+j]^ do
|
|
SrcStatementCount := StatIndex;
|
|
end;
|
|
StatIndex := 0;
|
|
FirstIndex := i;
|
|
end;
|
|
|
|
if assigned(sym) then
|
|
begin
|
|
ASrcFileName:=sym.FileName;
|
|
ASrcFileLine:=sym.Line;
|
|
AFuncName := sym.Name;
|
|
AOffset := int32(int64(tmpAddr) - int64(Sym.Address.Address));
|
|
sym.ReleaseReference;
|
|
end
|
|
else
|
|
begin
|
|
ASrcFileName:='';
|
|
AFuncName := '';
|
|
ASrcFileLine:=0;
|
|
AOffset := -1;
|
|
end;
|
|
AnEntry.Addr := tmpAddr;
|
|
AnEntry.Dump := ADump;
|
|
AnEntry.Statement := AStatement;
|
|
AnEntry.SrcFileLine:=ASrcFileLine;
|
|
AnEntry.SrcFileName:=ASrcFileName;
|
|
AnEntry.FuncName := AFuncName;
|
|
AnEntry.SrcStatementIndex:=StatIndex; // should be inverted for reverse parsing
|
|
AnEntry.Offset := AOffset;
|
|
AReversedRange.Append(@AnEntry);
|
|
inc(StatIndex);
|
|
end;
|
|
|
|
if AReversedRange.Count>0 then
|
|
begin
|
|
// Update start of range
|
|
ARange.RangeStartAddr := tmpAddr;
|
|
// Copy range in revese order of entries
|
|
for i := 0 to AReversedRange.Count-1 do
|
|
begin
|
|
// Reverse order of statements
|
|
with AReversedRange.Entries[AReversedRange.Count-1 - i] do
|
|
begin
|
|
for j := 0 to SrcStatementCount-1 do
|
|
SrcStatementIndex := SrcStatementCount - 1 - j;
|
|
end;
|
|
|
|
ARange.Append(AReversedRange.EntriesPtr[AReversedRange.Count-1 - i]);
|
|
end;
|
|
end;
|
|
// Entries are all pointers, don't free entries
|
|
FreeAndNil(AReversedRange);
|
|
end;
|
|
|
|
if ALinesAfter > 0 then
|
|
begin
|
|
sz := ALinesAfter * ADisassembler.MaxInstructionSize;
|
|
SetLength(CodeBin, sz);
|
|
bytesDisassembled := 0;
|
|
if not TFpDebugDebugger(Debugger).ReadData(AnAddr, sz, CodeBin[0]) then
|
|
begin
|
|
DebugLn(Format('Disassemble: Failed to read memory at %s.', [FormatAddress(AnAddr)]));
|
|
inc(AnAddr);
|
|
end
|
|
else
|
|
for i := 0 to ALinesAfter-1 do
|
|
begin
|
|
p := @CodeBin[bytesDisassembled];
|
|
ADisassembler.Disassemble(p, ADump, AStatement);
|
|
|
|
prevInstructionSize := p - @CodeBin[bytesDisassembled];
|
|
bytesDisassembled := bytesDisassembled + prevInstructionSize;
|
|
Sym := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.FindProcSymbol(AnAddr);
|
|
// If this is the last statement for this source-code-line, fill the
|
|
// SrcStatementCount from the prior statements.
|
|
if (assigned(sym) and ((ASrcFileName<>sym.FileName) or (ASrcFileLine<>sym.Line))) or
|
|
(not assigned(sym) and ((ASrcFileLine<>0) or (ASrcFileName<>''))) then
|
|
begin
|
|
for j := 0 to StatIndex-1 do
|
|
ARange.EntriesPtr[FirstIndex+j]^.SrcStatementCount:=StatIndex;
|
|
StatIndex:=0;
|
|
FirstIndex:=i;
|
|
end;
|
|
|
|
if assigned(sym) then
|
|
begin
|
|
ASrcFileName:=sym.FileName;
|
|
ASrcFileLine:=sym.Line;
|
|
AFuncName := sym.Name;
|
|
AOffset := int32(int64(AnAddr) - int64(Sym.Address.Address));
|
|
sym.ReleaseReference;
|
|
end
|
|
else
|
|
begin
|
|
ASrcFileName:='';
|
|
AFuncName := '';
|
|
ASrcFileLine:=0;
|
|
AOffset := -1;
|
|
end;
|
|
AnEntry.Addr := AnAddr;
|
|
AnEntry.Dump := ADump;
|
|
AnEntry.Statement := AStatement;
|
|
AnEntry.SrcFileLine:=ASrcFileLine;
|
|
AnEntry.SrcFileName:=ASrcFileName;
|
|
AnEntry.FuncName := AFuncName;
|
|
AnEntry.SrcStatementIndex:=StatIndex;
|
|
AnEntry.Offset := AOffset;
|
|
ARange.Append(@AnEntry);
|
|
ALastAddr:=AnAddr;
|
|
inc(StatIndex);
|
|
Inc(AnAddr, prevInstructionSize);
|
|
end;
|
|
end
|
|
else
|
|
ALastAddr := AnAddr;
|
|
|
|
if ARange.Count>0 then
|
|
begin
|
|
ARange.RangeEndAddr:=ALastAddr;
|
|
ARange.LastEntryEndAddr:={%H-}TDBGPtr(p);
|
|
EntryRanges.AddRange(ARange);
|
|
result := true;
|
|
end
|
|
else
|
|
begin
|
|
result := false;
|
|
ARange.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TFPRegisters }
|
|
|
|
procedure TFPRegisters.GetRegisterValueList();
|
|
begin
|
|
FRegisterList := FThr.RegisterValueList;
|
|
end;
|
|
|
|
procedure TFPRegisters.RequestData(ARegisters: TRegisters);
|
|
var
|
|
ARegisterList: TDbgRegisterValueList;
|
|
i: Integer;
|
|
ARegisterValue: TRegisterValue;
|
|
thr: TDbgThread;
|
|
frm: TDbgCallstackEntry;
|
|
begin
|
|
if not TFpDebugDebugger(Debugger).IsPausedAndValid then begin
|
|
ARegisters.DataValidity:=ddsInvalid;
|
|
exit;
|
|
end;
|
|
|
|
if not TFpDebugDebugger(Debugger).FDbgController.MainProcess.GetThread(ARegisters.ThreadId, thr) then begin
|
|
ARegisters.DataValidity:=ddsError;
|
|
exit;
|
|
end;
|
|
|
|
ARegisterList := nil;
|
|
if ARegisters.StackFrame = 0 then begin
|
|
FThr := thr;
|
|
TFpDebugDebugger(Debugger).ExecuteInDebugThread(@GetRegisterValueList);
|
|
ARegisterList := FRegisterList;
|
|
end
|
|
else begin
|
|
frm := thr.CallStackEntryList[ARegisters.StackFrame];
|
|
if frm <> nil then
|
|
ARegisterList := frm.RegisterValueList;
|
|
end;
|
|
|
|
if ARegisterList = nil then begin
|
|
ARegisters.DataValidity:=ddsError;
|
|
exit;
|
|
end;
|
|
|
|
for i := 0 to ARegisterList.Count-1 do
|
|
begin
|
|
ARegisterValue := ARegisters.EntriesByName[ARegisterList[i].Name];
|
|
ARegisterValue.ValueObj.SetAsNum(ARegisterList[i].NumValue, ARegisterList[i].Size);
|
|
ARegisterValue.ValueObj.SetAsText(ARegisterList[i].StrValue);
|
|
ARegisterValue.DataValidity:=ddsValid;
|
|
end;
|
|
ARegisters.DataValidity:=ddsValid;
|
|
end;
|
|
|
|
{ TFpLineInfo }
|
|
|
|
function TFpLineInfo.FpDebugger: TFpDebugDebugger;
|
|
begin
|
|
Result := TFpDebugDebugger(Debugger);
|
|
end;
|
|
|
|
procedure TFpLineInfo.DoStateChange(const AOldState: TDBGState);
|
|
begin
|
|
//inherited DoStateChange(AOldState);
|
|
if not (Debugger.State in [dsPause, dsInternalPause, dsRun]) then
|
|
ClearSources;
|
|
end;
|
|
|
|
procedure TFpLineInfo.ClearSources;
|
|
begin
|
|
FRequestedSources.Clear;
|
|
end;
|
|
|
|
procedure TFpLineInfo.DebugInfoChanged;
|
|
var
|
|
i: Integer;
|
|
Src: String;
|
|
begin
|
|
if (FpDebugger.DebugInfo = nil) or not(FpDebugger.DebugInfo is TFpDwarfInfo) then
|
|
exit;
|
|
|
|
for i := 0 to FRequestedSources.Count - 1 do begin
|
|
if FRequestedSources.Objects[i] = nil then begin
|
|
Src := FRequestedSources[i];
|
|
FRequestedSources.Objects[i] := TObject(TFpDwarfInfo(FpDebugger.DebugInfo).GetLineAddressMap(Src));
|
|
if FRequestedSources.Objects[i] <> nil then
|
|
DoChange(Src);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TFpLineInfo.Create(const ADebugger: TDebuggerIntf);
|
|
begin
|
|
FRequestedSources := TStringListUTF8Fast.Create;
|
|
inherited Create(ADebugger);
|
|
end;
|
|
|
|
destructor TFpLineInfo.Destroy;
|
|
begin
|
|
FreeAndNil(FRequestedSources);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TFpLineInfo.Count: Integer;
|
|
begin
|
|
Result := FRequestedSources.Count;
|
|
end;
|
|
|
|
function TFpLineInfo.HasAddress(const AIndex: Integer; const ALine: Integer
|
|
): Boolean;
|
|
var
|
|
Map: PDWarfLineMap;
|
|
dummy: TDBGPtrArray;
|
|
begin
|
|
Result := False;
|
|
if not((FpDebugger.DebugInfo <> nil) and (FpDebugger.DebugInfo is TFpDwarfInfo)) then
|
|
exit;
|
|
Map := PDWarfLineMap(FRequestedSources.Objects[AIndex]);
|
|
if Map <> nil then
|
|
begin
|
|
dummy:=nil;
|
|
Result := Map^.GetAddressesForLine(ALine, dummy, True);
|
|
end;
|
|
end;
|
|
|
|
function TFpLineInfo.GetInfo(AAddress: TDbgPtr; out ASource, ALine,
|
|
AOffset: Integer): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TFpLineInfo.IndexOf(const ASource: String): integer;
|
|
begin
|
|
Result := FRequestedSources.IndexOf(ASource);
|
|
end;
|
|
|
|
procedure TFpLineInfo.Request(const ASource: String);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (FpDebugger.DebugInfo = nil) or not(FpDebugger.DebugInfo is TFpDwarfInfo) then begin
|
|
FRequestedSources.AddObject(ASource, nil);
|
|
exit;
|
|
end;
|
|
i := FRequestedSources.AddObject(ASource, TObject(TFpDwarfInfo(FpDebugger.DebugInfo).GetLineAddressMap(ASource)));
|
|
if FRequestedSources.Objects[i] <> nil then
|
|
DoChange(ASource);
|
|
end;
|
|
|
|
procedure TFpLineInfo.Cancel(const ASource: String);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
{ TFPWatches }
|
|
|
|
function TFPWatches.FpDebugger: TFpDebugDebugger;
|
|
begin
|
|
Result := TFpDebugDebugger(Debugger);
|
|
end;
|
|
|
|
procedure TFPWatches.StopWorkes;
|
|
begin
|
|
FWatchEvalWorkers.RequestStopForWorkers;
|
|
end;
|
|
|
|
procedure TFPWatches.DoStateLeavePause;
|
|
begin
|
|
inherited DoStateLeavePause;
|
|
FWatchEvalWorkers.WaitForWorkers(True);
|
|
end;
|
|
|
|
procedure TFPWatches.InternalRequestData(AWatchValue: TWatchValueIntf);
|
|
var
|
|
WorkItem: TFpThreadWorkerWatchValueEvalUpdate;
|
|
begin
|
|
if not FpDebugger.IsPausedAndValid then begin
|
|
AWatchValue.Validity := ddsInvalid;
|
|
exit;
|
|
end;
|
|
|
|
WorkItem := TFpThreadWorkerWatchValueEvalUpdate.Create(FpDebugger, AWatchValue);
|
|
FpDebugger.FWorkQueue.PushItem(WorkItem);
|
|
FWatchEvalWorkers.Add(WorkItem);
|
|
end;
|
|
|
|
destructor TFPWatches.Destroy;
|
|
begin
|
|
FWatchEvalWorkers.WaitForWorkers(True);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TFpDebugExceptionStepping }
|
|
|
|
function TFpDebugExceptionStepping.GetDbgController: TDbgController;
|
|
begin
|
|
Result := FDebugger.FDbgController;
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.dbgs(st: TExceptStepState): string;
|
|
begin
|
|
writestr(Result, st);
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.dbgs(loc: TBreakPointLoc): string;
|
|
begin
|
|
writestr(Result, loc);
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.dbgs(locs: TBreakPointLocs): string;
|
|
var
|
|
a: TBreakPointLoc;
|
|
begin
|
|
Result := '';
|
|
for a in locs do Result := Result + dbgs(a) +',';
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.GetCurrentProcess: TDbgProcess;
|
|
begin
|
|
Result := FDebugger.FDbgController.CurrentProcess;
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.GetCurrentCommand: TDbgControllerCmd;
|
|
begin
|
|
Result := FDebugger.FDbgController.CurrentCommand;
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.GetCurrentThread: TDbgThread;
|
|
begin
|
|
Result := FDebugger.FDbgController.CurrentThread;
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.EnableBreaks(ALocs: TBreakPointLocs);
|
|
var
|
|
a: TBreakPointLoc;
|
|
begin
|
|
// Not in thread => only flag desired changes
|
|
for a in ALocs do
|
|
Include(FBreakNewEnabled, a);
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.EnableBreaksDirect(ALocs: TBreakPointLocs);
|
|
var
|
|
a: TBreakPointLoc;
|
|
begin
|
|
// Running in debug thread
|
|
//debugln(['EnableBreaksDirect ', dbgs(ALocs)]);
|
|
for a in ALocs do
|
|
if FBreakPoints[a] <> nil then begin
|
|
if not(a in FBreakEnabled) then
|
|
FBreakPoints[a].SetBreak;
|
|
Include(FBreakEnabled, a);
|
|
Include(FBreakNewEnabled, a);
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.DisableBreaks(ALocs: TBreakPointLocs);
|
|
var
|
|
a: TBreakPointLoc;
|
|
begin
|
|
// Not in thread => only flag desired changes
|
|
//debugln(['DisableBreaks ', dbgs(ALocs)]);
|
|
for a in ALocs do
|
|
Exclude(FBreakNewEnabled, a);
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.DisableBreaksDirect(ALocs: TBreakPointLocs);
|
|
var
|
|
a: TBreakPointLoc;
|
|
begin
|
|
// Running in debug thread
|
|
//debugln(['DisableBreaksDirect ', dbgs(ALocs)]);
|
|
for a in ALocs do
|
|
if FBreakPoints[a] <> nil then begin
|
|
if (a in FBreakEnabled) then
|
|
FBreakPoints[a].ResetBreak;
|
|
Exclude(FBreakEnabled, a);
|
|
Exclude(FBreakNewEnabled, a);
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.SetStepOutAddrDirect(AnAddr: TDBGPtr);
|
|
begin
|
|
FreeAndNil(FBreakPoints[bplStepOut]);
|
|
FBreakPoints[bplStepOut] := CurrentProcess.AddBreak(AnAddr);
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.DoExceptionRaised(var &continue: boolean);
|
|
var
|
|
AnExceptionLocation: TDBGLocationRec;
|
|
begin
|
|
FDebugger.HandleSoftwareException(AnExceptionLocation, &continue);
|
|
|
|
case &continue of
|
|
True: begin
|
|
if (CurrentCommand <> nil) and not(CurrentCommand is TDbgControllerContinueCmd) and
|
|
(CurrentCommand.Thread = CurrentThread)
|
|
then begin
|
|
EnableBreaks([bplPopExcept, bplCatches{$IFDEF WIN64} , bplFpcSpecific {$ENDIF}]);
|
|
FState := esIgnoredRaise; // currently stepping
|
|
end;
|
|
end;
|
|
False:
|
|
begin
|
|
FDebugger.EnterPause(AnExceptionLocation);
|
|
FState := esStoppedAtRaise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//procedure TFpDebugExceptionStepping.DoPopExcptStack;
|
|
//begin
|
|
// // check if step over??
|
|
// // clear breaks
|
|
// DbgController.AbortCurrentCommand;
|
|
// DbgController.StepOut;
|
|
// FState := esNone;
|
|
//
|
|
// DisableBreaks([bplPopExcept, bplCatches{$IFDEF WIN64} , bplFpcSpecific {$ENDIF}]);
|
|
//end;
|
|
|
|
procedure TFpDebugExceptionStepping.DoRtlUnwindEx;
|
|
begin
|
|
|
|
end;
|
|
|
|
constructor TFpDebugExceptionStepping.Create(ADebugger: TFpDebugDebugger);
|
|
begin
|
|
FDebugger := ADebugger;
|
|
{$IFDEF WIN64}
|
|
FAddressFrameListSehW64Except := TAddressFrameList.Create(True);
|
|
FAddressFrameListSehW64Finally := TAddressFrameList.Create(True);
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
FAddressFrameListSehW32Except:= TAddressFrameList.Create(True);
|
|
FAddressFrameListSehW32Finally:= TAddressFrameList.Create(True);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TFpDebugExceptionStepping.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
{$IFDEF WIN64}
|
|
FAddressFrameListSehW64Except.Destroy;
|
|
FAddressFrameListSehW64Finally.Destroy;
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
FAddressFrameListSehW32Except.Destroy;
|
|
FAddressFrameListSehW32Finally.Destroy;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.DoProcessLoaded;
|
|
begin
|
|
FBreakEnabled := [];
|
|
FBreakNewEnabled := [];
|
|
debuglnEnter(DBG_BREAKPOINTS, ['>> TFpDebugDebugger.SetSoftwareExceptionBreakpoint FPC_RAISEEXCEPTION' ]);
|
|
FBreakPoints[bplRaise] := FDebugger.AddBreak('FPC_RAISEEXCEPTION');
|
|
FBreakPoints[bplBreakError] := FDebugger.AddBreak('FPC_BREAK_ERROR');
|
|
FBreakPoints[bplRunError] := FDebugger.AddBreak('FPC_RUNERROR');
|
|
FBreakPoints[bplReRaise] := FDebugger.AddBreak('FPC_RERAISE', nil, False);
|
|
FBreakPoints[bplPopExcept] := FDebugger.AddBreak('FPC_POPADDRSTACK', nil, False);
|
|
FBreakPoints[bplCatches] := FDebugger.AddBreak('FPC_CATCHES', nil, False);
|
|
{$IFDEF MSWINDOWS}
|
|
if CurrentProcess.Mode = dm32 then begin
|
|
FBreakPoints[bplFpcExceptHandler] := FDebugger.AddBreak('__FPC_except_handler', nil, False);
|
|
FBreakPoints[bplFpcFinallyHandler] := FDebugger.AddBreak('__FPC_finally_handler', nil, False);
|
|
FBreakPoints[bplFpcLeaveHandler] := FDebugger.AddBreak('_FPC_leave', nil, False);
|
|
FBreakPoints[bplSehW32Except] := FDebugger.AddBreak(0, False);
|
|
FBreakPoints[bplSehW32Finally] := FDebugger.AddBreak(0, False);
|
|
{$IfDef WIN64}
|
|
end
|
|
else
|
|
if CurrentProcess.Mode = dm64 then begin
|
|
FBreakPoints[bplFpcSpecific] := FDebugger.AddBreak('__FPC_specific_handler', nil, False);
|
|
FBreakPoints[bplSehW64Except] := FDebugger.AddBreak(0, False);
|
|
FBreakPoints[bplSehW64Finally] := FDebugger.AddBreak(0, False);
|
|
FBreakPoints[bplSehW64Unwound] := FDebugger.AddBreak(0, False);
|
|
{$EndIf}
|
|
end;
|
|
{$ENDIF}
|
|
debuglnExit(DBG_BREAKPOINTS, ['<< TFpDebugDebugger.SetSoftwareExceptionBreakpoint ' ]);
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.DoNtDllLoaded(ALib: TDbgLibrary);
|
|
begin
|
|
{$IFDEF WIN64}
|
|
if CurrentProcess.Mode = dm64 then begin
|
|
debugln(DBG_BREAKPOINTS, ['SetSoftwareExceptionBreakpoint RtlUnwind']);
|
|
DisableBreaksDirect([bplRtlUnwind, bplRtlRestoreContext]);
|
|
FreeAndNil(FBreakPoints[bplRtlRestoreContext]);
|
|
FBreakPoints[bplRtlRestoreContext] := FDebugger.AddBreak('RtlRestoreContext', ALib, False);
|
|
FBreakPoints[bplRtlUnwind].Free;
|
|
FBreakPoints[bplRtlUnwind] := FDebugger.AddBreak('RtlUnwindEx', ALib, False);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.DoDbgStopped;
|
|
var
|
|
a: TBreakPointLoc;
|
|
begin
|
|
debuglnEnter(DBG_BREAKPOINTS, ['>> TFpDebugDebugger.FDbgControllerProcessExitEvent fpc_Raiseexception' ]);
|
|
for a in TBreakPointLoc do
|
|
FreeAndNil(FBreakPoints[a]);
|
|
debuglnExit(DBG_BREAKPOINTS, ['<< TFpDebugDebugger.FDbgControllerProcessExitEvent ' ]);
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.ThreadBeforeLoop(Sender: TObject);
|
|
begin
|
|
// Running in debug thread
|
|
EnableBreaksDirect(FBreakNewEnabled - FBreakEnabled);
|
|
DisableBreaksDirect(FBreakEnabled - FBreakNewEnabled);
|
|
{$IFDEF WIN64}
|
|
if assigned(FBreakPoints[bplSehW64Unwound]) then
|
|
FBreakPoints[bplSehW64Unwound].RemoveAllAddresses;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.ThreadProcessLoopCycle(
|
|
var AFinishLoopAndSendEvents: boolean; var AnEventType: TFPDEvent;
|
|
var ACurCommand: TDbgControllerCmd; var AnIsFinished: boolean);
|
|
|
|
function CheckCommandFinishesInFrame(AFrameAddr: TDBGPtr): Boolean;
|
|
begin
|
|
Result := (ACurCommand is TDbgControllerHiddenBreakStepBaseCmd) and
|
|
(TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrameInfo <> nil);
|
|
if not Result then
|
|
exit; // none stepping command, does not stop
|
|
if ACurCommand is TDbgControllerStepOutCmd then
|
|
Result := TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrameInfo.StoredStackFrame < AFrameAddr
|
|
else
|
|
Result := TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrameInfo.StoredStackFrame <= AFrameAddr;
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
procedure CheckSteppedOutFromW64SehFinally;
|
|
var
|
|
sym: TFpSymbol;
|
|
r, IsLeave: Boolean;
|
|
begin
|
|
if (FState <> esNone) or (not(ACurCommand is TDbgControllerLineStepBaseCmd)) then
|
|
exit;
|
|
|
|
if (pos('fin$', TDbgControllerLineStepBaseCmd(ACurCommand).StartedInFuncName) < 1) then
|
|
exit;
|
|
|
|
if (not TDbgControllerLineStepBaseCmd(ACurCommand).IsSteppedOut) then begin
|
|
{$IFDEF WIN64}
|
|
EnableBreaksDirect([bplFpcSpecific]);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
|
|
IsLeave := False;
|
|
sym := CurrentProcess.FindProcSymbol(CurrentThread.GetInstructionPointerRegisterValue);
|
|
if CurrentProcess.Mode = dm32 then begin
|
|
IsLeave := (CompareText(sym.Name, '_FPC_LEAVE') = 0);
|
|
r := (sym <> nil) and (sym.FileName <> '') and
|
|
(not IsLeave) and
|
|
(CompareText(sym.Name, '__FPC_FINALLY_HANDLER') <> 0);
|
|
end
|
|
else
|
|
r := (sym <> nil) and (CompareText(sym.Name, '__FPC_SPECIFIC_HANDLER') <> 0) and
|
|
(sym.FileName <> '');
|
|
sym.ReleaseReference;
|
|
if r then
|
|
exit;
|
|
|
|
FState := esSteppingFpcSpecialHandler;
|
|
AFinishLoopAndSendEvents := False;
|
|
ACurCommand := TDbgControllerStepThroughFpcSpecialHandler.Create(DbgController, CurrentThread.GetInstructionPointerRegisterValue, IsLeave);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure StepOutFromPopCatches;
|
|
begin
|
|
ACurCommand := TDbgControllerStepOutCmd.Create(DbgController);
|
|
TDbgControllerStepOutCmd(ACurCommand).SetReturnAdressBreakpoint(CurrentProcess, True);
|
|
end;
|
|
|
|
const
|
|
MaxFinallyHandlerCnt = 256; // more finally in a single proc is not probable....
|
|
var
|
|
StepOutStackPos, ReturnAddress, PC: TDBGPtr;
|
|
{$IFDEF WIN64}
|
|
Rdx, Rcx, R8, R9, TargetSp, HData, ImgBase: TDBGPtr;
|
|
i: Integer;
|
|
EFlags, Cnt: Cardinal;
|
|
FinallyData: Array of array [0..3] of DWORD; //TScopeRec
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
Base, Addr, SP: TDBGPtr;
|
|
Eax: TDBGPtr;
|
|
{$ENDIF}
|
|
o: Integer;
|
|
n: String;
|
|
begin
|
|
case AnEventType of
|
|
deExitProcess: begin
|
|
FDebugger.FExceptionStepper.DoDbgStopped;
|
|
exit;
|
|
end;
|
|
deLoadLibrary: begin
|
|
if (CurrentProcess <> nil) and (Length(CurrentProcess.LastLibrariesLoaded) > 0) then begin
|
|
// On Windows there is always only one library loaded at a deLoadLibrary
|
|
// event, so it is safe to only check the first item of LastLibrariesLoaded
|
|
n := ExtractFileName(CurrentProcess.LastLibrariesLoaded[0].Name);
|
|
if n = 'ntdll.dll' then
|
|
FDebugger.FExceptionStepper.DoNtDllLoaded(CurrentProcess.LastLibrariesLoaded[0]);
|
|
end;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if (CurrentThread <> nil) then
|
|
FDebugger.FDbgController.DefaultContext; // Make sure it is avail and cached / so it can be called outside the thread
|
|
|
|
// Needs to be correct thread, do not interfer with other threads
|
|
if (CurrentThread = nil) or
|
|
(CurrentCommand = nil) or (CurrentCommand.Thread <> CurrentThread)
|
|
then
|
|
exit;
|
|
|
|
PC := CurrentThread.GetInstructionPointerRegisterValue;
|
|
{$IFDEF WIN64}
|
|
if Assigned(FBreakPoints[bplSehW64Unwound]) and FBreakPoints[bplSehW64Unwound].HasLocation(PC)
|
|
then begin
|
|
FBreakPoints[bplSehW64Unwound].RemoveAllAddresses;
|
|
AFinishLoopAndSendEvents := AnIsFinished or (FState = esStepToFinally);
|
|
if AFinishLoopAndSendEvents then begin
|
|
AnEventType := deFinishedStep; // only step commands can end up here
|
|
exit;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
if (FState = esSteppingFpcSpecialHandler) and
|
|
(ACurCommand is TDbgControllerStepThroughFpcSpecialHandler) and
|
|
(TDbgControllerStepThroughFpcSpecialHandler(ACurCommand).InteralFinished)
|
|
then begin
|
|
if AnIsFinished then begin
|
|
exit; // stepped out of _FPC_LEAVE;
|
|
end
|
|
else
|
|
if TDbgControllerStepThroughFpcSpecialHandler(ACurCommand).FDone then begin
|
|
FState := esNone;
|
|
if ACurCommand.Thread = CurrentThread then
|
|
ACurCommand := TDbgControllerStepOverFirstFinallyLineCmd.Create(DbgController);
|
|
// else thread has gone => finish old command
|
|
end
|
|
else begin
|
|
FState := esStepToFinally;
|
|
{$IFDEF WIN64}
|
|
EnableBreaksDirect([bplFpcSpecific]);
|
|
{$ENDIF}
|
|
end;
|
|
AFinishLoopAndSendEvents := False;
|
|
exit;
|
|
end
|
|
else
|
|
if CurrentProcess.CurrentBreakpoint = nil then begin
|
|
{$IFDEF MSWINDOWS}
|
|
CheckSteppedOutFromW64SehFinally;
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
{$IFDEF WIN64}
|
|
DisableBreaksDirect([bplRtlUnwind, bplSehW64Finally]); // bplRtlUnwind must always be unset;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
SP := CurrentThread.GetStackPointerRegisterValue;
|
|
{$ENDIF}
|
|
{$IFDEF WIN64}
|
|
FAddressFrameListSehW64Except.RemoveOutOfScopeFrames(SP, FBreakPoints[bplSehW64Except]);
|
|
if ACurCommand is TDbgControllerStepOutCmd then
|
|
FAddressFrameListSehW64Finally.RemoveOutOfScopeFrames(SP+1, FBreakPoints[bplSehW64Finally]) // include current frame
|
|
else
|
|
FAddressFrameListSehW64Finally.RemoveOutOfScopeFrames(SP, FBreakPoints[bplSehW64Finally]);
|
|
{$ENDIF}
|
|
|
|
// bplPopExcept / bplCatches
|
|
if (assigned(FBreakPoints[bplPopExcept]) and FBreakPoints[bplPopExcept].HasLocation(PC)) or
|
|
(assigned(FBreakPoints[bplCatches]) and FBreakPoints[bplCatches].HasLocation(PC))
|
|
then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplPop/bplCatches ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
|
|
//DebugLn(['THreadProcLoop ', dbgs(FState), ' ', DbgSName(CurrentCommand)]);
|
|
DisableBreaksDirect([bplPopExcept, bplCatches{$IFDEF WIN64} , bplFpcSpecific {$ENDIF}]); // FpcSpecific was not needed -> not SEH based code
|
|
case FState of
|
|
esIgnoredRaise: begin
|
|
// bplReRaise may set them again
|
|
if not (CurrentCommand is TDbgControllerHiddenBreakStepBaseCmd) then
|
|
exit; // wrong command type // should not happen
|
|
|
|
if AnIsFinished then begin
|
|
// FORCE the breakpoint WITHoUT FRAME => known to be without frame // optimized fpc may not have expected asm
|
|
StepOutFromPopCatches;
|
|
end
|
|
else begin
|
|
o := 0;
|
|
if (CurrentCommand is TDbgControllerStepOutCmd) then
|
|
o := 1; // frame must be less, not equal
|
|
|
|
{$PUSH}{$Q-}{$R-}
|
|
// GetStackBasePointerRegisterValue is still on parent frame
|
|
if CheckCommandFinishesInFrame(CurrentThread.GetStackBasePointerRegisterValue - o)
|
|
then begin
|
|
// Insert a "step out" breakpoint, but leave control to the running command.
|
|
StepOutStackPos := CurrentThread.GetStackPointerRegisterValue;
|
|
if CurrentProcess.ReadAddress(StepOutStackPos, ReturnAddress) then
|
|
SetStepOutAddrDirect(ReturnAddress)
|
|
else
|
|
StepOutFromPopCatches; // error reading mem
|
|
end;
|
|
{$POP}
|
|
end;
|
|
end;
|
|
esStepToFinally: begin
|
|
StepOutFromPopCatches;
|
|
end;
|
|
end;
|
|
FState := esNone;
|
|
end
|
|
else
|
|
// bplStepOut => part of esIgnoredRaise
|
|
if assigned(FBreakPoints[bplStepOut]) and FBreakPoints[bplStepOut].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplStepOut ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := AnIsFinished;
|
|
AnEventType := deFinishedStep;
|
|
CurrentProcess.RemoveBreak(FBreakPoints[bplStepOut]);
|
|
FreeAndNil(FBreakPoints[bplStepOut]);
|
|
end
|
|
else
|
|
// bplReRaise
|
|
if assigned(FBreakPoints[bplReRaise]) and FBreakPoints[bplReRaise].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplReRaise ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
EnableBreaksDirect([bplPopExcept, bplCatches{$IFDEF WIN64} , bplFpcSpecific {$ENDIF}]);
|
|
// if not(FState = esStepToFinally) then
|
|
FState := esIgnoredRaise;
|
|
end
|
|
{$IFDEF MSWINDOWS}
|
|
(* ***** Win32 SEH Except ***** *)
|
|
else
|
|
if assigned(FBreakPoints[bplSehW32Except]) and FBreakPoints[bplSehW32Except].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplSehW32Except ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
|
|
//if (not (FState in [esStepToFinally])) and
|
|
// not(CurrentCommand is TDbgControllerHiddenBreakStepBaseCmd)
|
|
//then
|
|
// exit; // wrong command type / should not happen
|
|
if (FState = esIgnoredRaise) and
|
|
(not CheckCommandFinishesInFrame(CurrentThread.GetStackBasePointerRegisterValue))
|
|
then
|
|
exit;
|
|
|
|
AFinishLoopAndSendEvents := True; // Stop at this address
|
|
FState := esAtWSehExcept;
|
|
AnIsFinished := True;
|
|
AnEventType := deFinishedStep;
|
|
|
|
|
|
end
|
|
(* ***** Win32 SEH Finally ***** *)
|
|
else
|
|
if assigned(FBreakPoints[bplSehW32Finally]) and FBreakPoints[bplSehW32Finally].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplSehW32Finally ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
|
|
// At the start of a finally the BasePointer is in EAX // reg 0
|
|
Eax := CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(0).NumValue;
|
|
FAddressFrameListSehW32Finally.RemoveOutOfScopeFrames(EAX, FBreakPoints[bplSehW32Finally]);
|
|
|
|
if (ACurCommand is TDbgControllerLineStepBaseCmd) and
|
|
not CheckCommandFinishesInFrame(Eax)
|
|
then
|
|
exit;
|
|
|
|
// step over proloque
|
|
ACurCommand := TDbgControllerStepOverFirstFinallyLineCmd.Create(DbgController);
|
|
FState := esStepSehFinallyProloque;
|
|
end
|
|
else
|
|
(* ***** Win32 SEH ExceptHandler ***** *)
|
|
if assigned(FBreakPoints[bplFpcExceptHandler]) and FBreakPoints[bplFpcExceptHandler].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplFpcExceptHandler ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
AnIsFinished := False;
|
|
|
|
(* TSEHFrame=record
|
|
Next: PSEHFrame;
|
|
Addr: Pointer;
|
|
_EBP: PtrUint;
|
|
HandlerArg: Pointer;
|
|
end;
|
|
*)
|
|
{$PUSH}{$Q-}{$R-}
|
|
if (not CurrentProcess.ReadAddress(SP + 8, Addr)) or (Addr = 0) then
|
|
exit;
|
|
if (not CurrentProcess.ReadAddress(Addr + 12, Addr)) or (Addr = 0) then
|
|
exit;
|
|
CurrentProcess.ReadAddress(Addr + 8, Base);
|
|
{$POP}
|
|
|
|
if Base <> 0 then
|
|
FAddressFrameListSehW32Except.Add(Addr, Base);
|
|
FBreakPoints[bplSehW32Except].AddAddress(Addr);
|
|
FBreakPoints[bplSehW32Except].SetBreak;
|
|
end
|
|
else
|
|
(* ***** Win32 SEH FinallyHandler ***** *)
|
|
if assigned(FBreakPoints[bplFpcFinallyHandler]) and FBreakPoints[bplFpcFinallyHandler].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplFpcFinallyHandler ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
AnIsFinished := False;
|
|
|
|
{$PUSH}{$Q-}{$R-}
|
|
if (not CurrentProcess.ReadAddress(SP + 8, Addr)) or (Addr = 0) then
|
|
exit;
|
|
if (not CurrentProcess.ReadAddress(Addr + 12, Addr)) or (Addr = 0) then
|
|
exit;
|
|
CurrentProcess.ReadAddress(Addr + 8, Base);
|
|
{$POP}
|
|
|
|
if Base <> 0 then
|
|
FAddressFrameListSehW32Finally.Add(Addr, Base);
|
|
FBreakPoints[bplSehW32Finally].AddAddress(Addr);
|
|
FBreakPoints[bplSehW32Finally].SetBreak;
|
|
end
|
|
else
|
|
(* ***** Win32 SEH LeaveHandler ***** *)
|
|
if assigned(FBreakPoints[bplFpcLeaveHandler]) and FBreakPoints[bplFpcLeaveHandler].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplFpcLeaveHandler ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
AnIsFinished := False;
|
|
|
|
{$PUSH}{$Q-}{$R-}
|
|
if (not CurrentProcess.ReadAddress(SP + 16, Addr)) or (Addr = 0) then
|
|
exit;
|
|
CurrentProcess.ReadAddress(Addr + 4, Base);
|
|
{$POP}
|
|
|
|
if Base <> 0 then
|
|
FAddressFrameListSehW32Finally.Add(Addr, Base);
|
|
FBreakPoints[bplSehW32Finally].AddAddress(Addr);
|
|
FBreakPoints[bplSehW32Finally].SetBreak;
|
|
end
|
|
{$ENDIF}
|
|
{$IFDEF WIN64}
|
|
else
|
|
(* ***** Win64 SEH ***** *)
|
|
// bplFpcSpecific
|
|
if assigned(FBreakPoints[bplFpcSpecific]) and FBreakPoints[bplFpcSpecific].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplFpcSpecific ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
AnIsFinished := False;
|
|
EnableBreaksDirect([bplRtlUnwind]);
|
|
|
|
if (FState = esIgnoredRaise) and not(CurrentCommand is TDbgControllerHiddenBreakStepBaseCmd) then
|
|
exit; // wrong command type // should not happen
|
|
|
|
(* TODO: Look at using DW_TAG_try_block https://bugs.freepascal.org/view.php?id=34881 *)
|
|
|
|
(* Get parm in RCX:
|
|
EXCEPTION_RECORD = record
|
|
ExceptionCode : DWORD;
|
|
ExceptionFlags : DWORD;
|
|
ExceptionRecord : ^_EXCEPTION_RECORD;
|
|
ExceptionAddress : PVOID;
|
|
NumberParameters : DWORD;
|
|
ExceptionInformation : array[0..(EXCEPTION_MAXIMUM_PARAMETERS)-1] of ULONG_PTR;
|
|
end; *)
|
|
Rcx := CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(2).NumValue; // rec: TExceptionRecord
|
|
{$PUSH}{$Q-}{$R-}
|
|
if (not CurrentProcess.ReadData(Rcx + 4, 4, EFlags)) or
|
|
((EFlags and 66) = 0) // rec.ExceptionFlags and EXCEPTION_UNWIND)=0
|
|
then
|
|
exit;
|
|
|
|
(* Get FrameBasePointe (RPB) for finally block (passed in R8) *)
|
|
R8 := CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(8).NumValue;
|
|
if (not CurrentProcess.ReadAddress(R8 + 160, Base)) or (Base = 0) then // RPB at finally
|
|
exit;
|
|
|
|
if ( (FState = esIgnoredRaise) or (ACurCommand is TDbgControllerLineStepBaseCmd) ) and
|
|
not CheckCommandFinishesInFrame(Base)
|
|
then
|
|
exit;
|
|
|
|
if (not CurrentProcess.ReadAddress(R8 + 152, TargetSp)) then
|
|
TargetSp := 0;
|
|
|
|
// R9 = dispatch: TDispatcherContext
|
|
R9 := CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(9).NumValue;
|
|
//dispatch.HandlerData
|
|
if (not CurrentProcess.ReadAddress(R9 + 56, HData)) or (HData = 0) then
|
|
exit;
|
|
(* HandlerData = MaxScope: DWord, array of ^TScopeRec
|
|
TScopeRec=record
|
|
Typ: DWord; { SCOPE_FINALLY: finally code in RvaHandler
|
|
SCOPE_CATCHALL: unwinds to RvaEnd, RvaHandler is the end of except block
|
|
SCOPE_IMPLICIT: finally code in RvaHandler, unwinds to RvaEnd
|
|
otherwise: except with 'on' stmts, value is RVA of filter data }
|
|
RvaStart: DWord;
|
|
RvaEnd: DWord;
|
|
RvaHandler: DWord; *)
|
|
if (not CurrentProcess.ReadData(HData, 4, Cnt)) or (Cnt = 0) or (Cnt > MaxFinallyHandlerCnt) then
|
|
exit;
|
|
|
|
if (not CurrentProcess.ReadAddress(R9 + 8, ImgBase)) or (ImgBase = 0) then
|
|
exit;
|
|
|
|
SetLength(FinallyData, Cnt);
|
|
if (not CurrentProcess.ReadData(HData + 4, 16 * Cnt, FinallyData[0])) then
|
|
exit;
|
|
for i := 0 to Cnt - 1 do begin
|
|
Addr := FinallyData[i][3];
|
|
if (FinallyData[i][0] <> 0) or // scope^.Typ=SCOPE_FINALLY
|
|
(Addr = 0)
|
|
then
|
|
Continue;
|
|
if TargetSp <> 0 then
|
|
FAddressFrameListSehW64Finally.Add(ImgBase + Addr, TargetSp);
|
|
FBreakPoints[bplSehW64Finally].AddAddress(ImgBase + Addr);
|
|
end;
|
|
{$POP}
|
|
FBreakPoints[bplSehW64Finally].SetBreak;
|
|
end
|
|
else
|
|
// bplRtlRestoreContext
|
|
if assigned(FBreakPoints[bplRtlRestoreContext]) and FBreakPoints[bplRtlRestoreContext].HasLocation(PC) then begin
|
|
AFinishLoopAndSendEvents := False;
|
|
AnIsFinished := False;
|
|
|
|
if (CurrentCommand <> nil) and (CurrentCommand.Thread <> CurrentThread) then
|
|
exit;
|
|
debugln(FPDBG_COMMANDS, ['@ bplRtlRestoreContext ', DbgSName(CurrentCommand)]);
|
|
// RCX = TContext
|
|
Rcx := CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(2).NumValue; // rsp at target
|
|
if (Rcx <> 0) then begin
|
|
if (not CurrentProcess.ReadAddress(Rcx + PtrUInt(@PCONTEXT(nil)^.Rip), Addr)) or (Addr = 0) then
|
|
exit;
|
|
|
|
FBreakPoints[bplSehW64Unwound].AddAddress(Addr);
|
|
FBreakPoints[bplSehW64Unwound].SetBreak;
|
|
end;
|
|
end
|
|
else
|
|
// bplRtlUnwind
|
|
if assigned(FBreakPoints[bplRtlUnwind]) and FBreakPoints[bplRtlUnwind].HasLocation(PC) then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplRtlUnwind ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
AnIsFinished := False;
|
|
|
|
// This is Win64 bit only
|
|
// Must run for any thread => the thread may stop at a break in a finally block, and then attempt to step to except
|
|
// maybe store the thread-id with each breakpoint // though SP register values should be unique
|
|
Rcx := CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(2).NumValue; // rsp at target
|
|
Rdx := CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(1).NumValue;
|
|
if (Rcx <> 0) and (Rdx <> 0) then begin
|
|
FAddressFrameListSehW64Except.Add(Rdx, Rcx);
|
|
FBreakPoints[bplSehW64Except].AddAddress(Rdx);
|
|
FBreakPoints[bplSehW64Except].SetBreak;
|
|
end;
|
|
end
|
|
else
|
|
// bplSehW64Except
|
|
if assigned(FBreakPoints[bplSehW64Except]) and FBreakPoints[bplSehW64Except].HasLocation(PC) then begin // always assigned
|
|
debugln(FPDBG_COMMANDS, ['@ bplSehW64Except ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
if FAddressFrameListSehW64Except.Remove(PC, SP) then
|
|
FBreakPoints[bplSehW64Except].RemoveAddress(PC);
|
|
|
|
if (not (FState in [esStepToFinally, esSteppingFpcSpecialHandler])) and
|
|
not(CurrentCommand is TDbgControllerHiddenBreakStepBaseCmd)
|
|
then
|
|
exit; // wrong command type / should not happen
|
|
if (FState = esIgnoredRaise) and
|
|
(not CheckCommandFinishesInFrame(CurrentThread.GetStackBasePointerRegisterValue))
|
|
then
|
|
exit;
|
|
|
|
AFinishLoopAndSendEvents := True; // Stop at this address
|
|
FState := esAtWSehExcept;
|
|
AnIsFinished := True;
|
|
AnEventType := deFinishedStep;
|
|
end
|
|
else
|
|
// bplSehW64Finally
|
|
if assigned(FBreakPoints[bplSehW64Finally]) and FBreakPoints[bplSehW64Finally].HasLocation(PC) then begin // always assigned
|
|
debugln(FPDBG_COMMANDS, ['@ bplSehW64Finally ', DbgSName(CurrentCommand)]);
|
|
AFinishLoopAndSendEvents := False;
|
|
if FAddressFrameListSehW64Finally.Remove(PC, SP) then
|
|
FBreakPoints[bplSehW64Finally].RemoveAddress(PC);
|
|
|
|
// At the start of a finally the BasePointer is in RCX // reg 2
|
|
if (ACurCommand is TDbgControllerLineStepBaseCmd) and
|
|
not CheckCommandFinishesInFrame(CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(2).NumValue)
|
|
then
|
|
exit;
|
|
|
|
// step over proloque
|
|
ACurCommand := TDbgControllerStepOverFirstFinallyLineCmd.Create(DbgController);
|
|
FState := esStepSehFinallyProloque;
|
|
end
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
else
|
|
CheckSteppedOutFromW64SehFinally
|
|
{$ENDIF}
|
|
;
|
|
|
|
end;
|
|
|
|
function TFpDebugExceptionStepping.BreakpointHit(var &continue: boolean;
|
|
const Breakpoint: TFpDbgBreakpoint): boolean;
|
|
begin
|
|
if FState in [esAtWSehExcept] then begin
|
|
FDebugger.EnterPause(FDebugger.GetLocation);
|
|
FState := esNone;
|
|
exit(True);
|
|
end;
|
|
|
|
Result := Assigned(Breakpoint);
|
|
if not Result then begin
|
|
exit;
|
|
end;
|
|
|
|
if BreakPoint = FBreakPoints[bplRaise] then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplRaise']);
|
|
DoExceptionRaised(&continue);
|
|
end
|
|
else
|
|
if BreakPoint = FBreakPoints[bplBreakError] then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplBreakError']);
|
|
FDebugger.HandleBreakError(&continue);
|
|
if not &continue then
|
|
FState := esNone;
|
|
end
|
|
else
|
|
if BreakPoint = FBreakPoints[bplRunError] then begin
|
|
debugln(FPDBG_COMMANDS, ['@ bplRunError']);
|
|
FDebugger.HandleRunError(&continue);
|
|
if not &continue then
|
|
FState := esNone;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TFpDebugExceptionStepping.UserCommandRequested(
|
|
var ACommand: TDBGCommand);
|
|
var
|
|
st: TExceptStepState;
|
|
begin
|
|
// This only runs if the debugloop is paused
|
|
st := FState;
|
|
FState := esNone;
|
|
DisableBreaks([bplPopExcept, bplCatches, bplReRaise,
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF WIN64}
|
|
bplFpcSpecific, bplRtlRestoreContext, bplRtlUnwind,
|
|
{$ENDIF}
|
|
bplFpcExceptHandler ,bplFpcFinallyHandler, bplFpcLeaveHandler,
|
|
bplSehW32Except, bplSehW32Finally,
|
|
{$ENDIF}
|
|
bplStepOut]);
|
|
|
|
if ACommand in [dcStepInto, dcStepOver, dcStepOut, dcStepTo, dcRunTo, dcStepOverInstr{, dcStepIntoInstr}] then
|
|
EnableBreaks([bplReRaise
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF WIN64} , bplRtlRestoreContext, bplFpcSpecific {$ENDIF}
|
|
, bplFpcExceptHandler ,bplFpcFinallyHandler, bplFpcLeaveHandler
|
|
, bplSehW32Except, bplSehW32Finally
|
|
{$ENDIF}
|
|
]);
|
|
|
|
case st of
|
|
esStoppedAtRaise: begin
|
|
if ACommand in [dcStepInto, dcStepOver, dcStepOut, dcStepTo, dcRunTo] then begin
|
|
FState := esStepToFinally;
|
|
ACommand := dcRun;
|
|
FDebugger.FDbgController.&ContinueRun;
|
|
EnableBreaks([bplPopExcept, bplCatches
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF WIN64} , bplFpcSpecific {$ENDIF}
|
|
, bplFpcExceptHandler ,bplFpcFinallyHandler, bplFpcLeaveHandler
|
|
, bplSehW32Except, bplSehW32Finally
|
|
{$ENDIF}
|
|
]);
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TFpDebugDebugger }
|
|
|
|
procedure TFpDebugDebugger.FDbgControllerProcessExitEvent(AExitCode: DWord);
|
|
var
|
|
AThread: TFpWaitForConsoleOutputThread;
|
|
begin
|
|
if assigned(FConsoleOutputThread) then
|
|
begin
|
|
AThread := TFpWaitForConsoleOutputThread(FConsoleOutputThread);
|
|
FConsoleOutputThread := nil;
|
|
AThread.Terminate;
|
|
AThread.DoHasConsoleOutput(0);
|
|
AThread.WaitFor;
|
|
AThread.Free;
|
|
end;
|
|
|
|
SetExitCode(Integer(AExitCode));
|
|
{$PUSH}{$R-}
|
|
DoDbgEvent(ecProcess, etProcessExit, Format('Process exited with exit-code %u',[AExitCode]));
|
|
{$POP}
|
|
LockRelease;
|
|
try
|
|
SetState(dsStop);
|
|
StopAllWorkers;
|
|
FreeDebugThread;
|
|
finally
|
|
UnlockRelease;
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.FDbgControllerExceptionEvent(var continue: boolean;
|
|
const ExceptionClass, ExceptionMessage: string);
|
|
begin
|
|
DoException(deExternal, ExceptionClass, GetLocation, ExceptionMessage, continue);
|
|
if not continue then
|
|
begin
|
|
SetState(dsPause);
|
|
DoCurrent(GetLocation);
|
|
end;
|
|
end;
|
|
|
|
function TFpDebugDebugger.GetDebugInfo: TDbgInfo;
|
|
begin
|
|
Result := nil;
|
|
if (FDbgController <> nil) and (FDbgController.CurrentProcess<> nil) then
|
|
Result := FDbgController.CurrentProcess.DbgInfo;
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateLineInfo: TDBGLineInfo;
|
|
begin
|
|
Result := TFpLineInfo.Create(Self);
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateWatches: TWatchesSupplier;
|
|
begin
|
|
Result := TFPWatches.Create(Self);
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateThreads: TThreadsSupplier;
|
|
begin
|
|
Result := TFPThreads.Create(Self);
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateLocals: TLocalsSupplier;
|
|
begin
|
|
Result := TFPLocals.Create(Self);
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateRegisters: TRegisterSupplier;
|
|
begin
|
|
Result := TFPRegisters.Create(Self);
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateCallStack: TCallStackSupplier;
|
|
begin
|
|
Result:=TFPCallStackSupplier.Create(Self);
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateDisassembler: TDBGDisassembler;
|
|
begin
|
|
Result:=TFPDBGDisassembler.Create(Self);
|
|
end;
|
|
|
|
function TFpDebugDebugger.CreateBreakPoints: TDBGBreakPoints;
|
|
begin
|
|
Result := TFPBreakPoints.Create(Self, TFPBreakpoint);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.FDbgControllerDebugInfoLoaded(Sender: TObject);
|
|
begin
|
|
if LineInfo <> nil then begin
|
|
TFpLineInfo(LineInfo).DebugInfoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.FDbgControllerLibraryLoaded(var continue: boolean; ALibraries: TDbgLibraryArr);
|
|
var
|
|
n: String;
|
|
i: Integer;
|
|
ALib: TDbgLibrary;
|
|
begin
|
|
for i := 0 to High(ALibraries) do
|
|
begin
|
|
ALib := ALibraries[i];
|
|
n := ExtractFileName(ALib.Name);
|
|
DoDbgEvent(ecModule, etModuleLoad, 'Loaded: ' + n + ' (' + ALib.Name +')');
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.FDbgControllerLibraryUnloaded(var continue: boolean; ALibraries: TDbgLibraryArr);
|
|
var
|
|
n: String;
|
|
i: Integer;
|
|
ALib: TDbgLibrary;
|
|
begin
|
|
for i := 0 to High(ALibraries) do
|
|
begin
|
|
ALib := ALibraries[i];
|
|
n := ExtractFileName(ALib.Name);
|
|
DoDbgEvent(ecModule, etModuleUnload, 'Unloaded: ' + n + ' (' + ALib.Name +')');
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.GetCurrentThreadAndStackFrame(out AThreadId,
|
|
AStackFrame: Integer);
|
|
var
|
|
CurStackList: TCallStackBase;
|
|
begin
|
|
AThreadId := Threads.CurrentThreads.CurrentThreadId;
|
|
CurStackList := CallStack.CurrentCallStackList.EntriesForThreads[AThreadId];
|
|
if CurStackList <> nil then begin
|
|
AStackFrame := CurStackList.CurrentIndex;
|
|
if AStackFrame < 0 then
|
|
AStackFrame := 0;
|
|
end
|
|
else
|
|
AStackFrame := 0;
|
|
end;
|
|
|
|
function TFpDebugDebugger.GetContextForEvaluate(const ThreadId,
|
|
StackFrame: Integer): TFpDbgSymbolScope;
|
|
begin
|
|
Result := FindSymbolScope(ThreadId, StackFrame);
|
|
end;
|
|
|
|
function TFpDebugDebugger.GetClassInstanceName(AnAddr: TDBGPtr): string;
|
|
var
|
|
AnErr: TFpError;
|
|
begin
|
|
Result := '';
|
|
if (FDbgController.CurrentProcess <> nil) then
|
|
TFpDwarfFreePascalSymbolClassMap.GetInstanceForDbgInfo(FDbgController.CurrentProcess.DbgInfo)
|
|
.GetInstanceClassNameFromPVmt
|
|
(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;
|
|
len: TDBGPtr;
|
|
begin
|
|
result := '';
|
|
if not ReadAddress(AnAddr, StrAddr) then
|
|
Exit;
|
|
if StrAddr = 0 then
|
|
exit;
|
|
ReadAddress(StrAddr-DBGPTRSIZE[FDbgController.CurrentProcess.Mode], len);
|
|
setlength(result, len);
|
|
if not ReadData(StrAddr, len, result[1]) then
|
|
result := '';
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.HandleSoftwareException(out
|
|
AnExceptionLocation: TDBGLocationRec; var continue: boolean);
|
|
var
|
|
AnExceptionObjectLocation, ExceptIP, ExceptFramePtr: TDBGPtr;
|
|
ExceptionClass: string;
|
|
ExceptionMessage: string;
|
|
ExceptItem: TBaseException;
|
|
begin
|
|
if not FDbgController.DefaultContext.ReadUnsignedInt(FDbgController.CurrentProcess.CallParamDefaultLocation(1),
|
|
SizeVal(SizeOf(ExceptIP)), ExceptIP)
|
|
then
|
|
ExceptIP := 0;
|
|
AnExceptionLocation:=GetLocationRec(ExceptIP, -1);
|
|
|
|
if not FDbgController.DefaultContext.ReadUnsignedInt(FDbgController.CurrentProcess.CallParamDefaultLocation(0),
|
|
SizeVal(SizeOf(AnExceptionObjectLocation)), AnExceptionObjectLocation)
|
|
then
|
|
AnExceptionObjectLocation := 0;
|
|
ExceptionClass := '';
|
|
ExceptionMessage := '';
|
|
if AnExceptionObjectLocation <> 0 then begin
|
|
ExceptionClass := GetClassInstanceName(AnExceptionObjectLocation);
|
|
ExceptionMessage := ReadAnsiString(AnExceptionObjectLocation+DBGPTRSIZE[FDbgController.CurrentProcess.Mode]);
|
|
end;
|
|
|
|
ExceptItem := Exceptions.Find(ExceptionClass);
|
|
if (ExceptItem <> nil) and (ExceptItem.Enabled)
|
|
then begin
|
|
continue := True;
|
|
exit;
|
|
end;
|
|
|
|
DoException(deInternal, ExceptionClass, AnExceptionLocation, ExceptionMessage, continue);
|
|
|
|
if not &continue then begin
|
|
if FDbgController.DefaultContext.ReadUnsignedInt(FDbgController.CurrentProcess.CallParamDefaultLocation(2),
|
|
SizeVal(SizeOf(ExceptFramePtr)), ExceptFramePtr)
|
|
then
|
|
ExceptIP := SetStackFrameForBasePtr(ExceptFramePtr, True, ExceptIP);
|
|
if ExceptIP <> 0 then
|
|
AnExceptionLocation:=GetLocationRec(ExceptIP); // Assert was corrected
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.HandleBreakError(var continue: boolean);
|
|
var
|
|
ErrNo: QWord;
|
|
ExceptIP, ExceptFramePtr: TDBGPtr;
|
|
ExceptName: string;
|
|
ExceptItem: TBaseException;
|
|
ExceptionLocation: TDBGLocationRec;
|
|
begin
|
|
if not FDbgController.DefaultContext.ReadUnsignedInt(FDbgController.CurrentProcess.CallParamDefaultLocation(1),
|
|
SizeVal(SizeOf(ExceptIP)), ExceptIP)
|
|
then
|
|
ExceptIP := 0;
|
|
ExceptionLocation:=GetLocationRec(ExceptIP, -1);
|
|
|
|
if FDbgController.DefaultContext.ReadUnsignedInt(FDbgController.CurrentProcess.CallParamDefaultLocation(0),
|
|
SizeVal(SizeOf(LongInt)), ErrNo)
|
|
then
|
|
ExceptName := Format('RunError(%d)', [ErrNo])
|
|
else
|
|
ExceptName := 'RunError(unknown)';
|
|
|
|
ExceptItem := Exceptions.Find(ExceptName);
|
|
if (ExceptItem <> nil) and (ExceptItem.Enabled)
|
|
then begin
|
|
continue := True;
|
|
exit;
|
|
end;
|
|
|
|
DoException(deRunError, ExceptName, ExceptionLocation, RunErrorText[ErrNo], continue);
|
|
|
|
if not &continue then begin
|
|
if FDbgController.DefaultContext.ReadUnsignedInt(FDbgController.CurrentProcess.CallParamDefaultLocation(2),
|
|
SizeVal(SizeOf(ExceptFramePtr)), ExceptFramePtr)
|
|
then
|
|
SetStackFrameForBasePtr(ExceptFramePtr);
|
|
|
|
EnterPause(ExceptionLocation);
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.HandleRunError(var continue: boolean);
|
|
var
|
|
ErrNo: QWord;
|
|
ExceptName: string;
|
|
ExceptItem: TBaseException;
|
|
ExceptionLocation: TDBGLocationRec;
|
|
begin
|
|
// NO Addr / No Frame
|
|
ExceptionLocation:=GetLocationRec;
|
|
|
|
if FDbgController.DefaultContext.ReadUnsignedInt(FDbgController.CurrentProcess.CallParamDefaultLocation(0),
|
|
SizeVal(SizeOf(Word)), ErrNo)
|
|
then
|
|
ExceptName := Format('RunError(%d)', [ErrNo])
|
|
else
|
|
ExceptName := 'RunError(unknown)';
|
|
|
|
ExceptItem := Exceptions.Find(ExceptName);
|
|
if (ExceptItem <> nil) and (ExceptItem.Enabled)
|
|
then begin
|
|
continue := True;
|
|
exit;
|
|
end;
|
|
|
|
DoException(deRunError, ExceptName, ExceptionLocation, RunErrorText[ErrNo], continue);
|
|
|
|
if not &continue then begin
|
|
EnterPause(ExceptionLocation);
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.FreeDebugThread;
|
|
begin
|
|
FWorkQueue.TerminateAllThreads(True);
|
|
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF}
|
|
DoProcessMessages // run the AsyncMethods
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(
|
|
var continue: boolean; const Breakpoint: TFpDbgBreakpoint;
|
|
AnEventType: TFPDEvent; AMoreHitEventsPending: Boolean);
|
|
var
|
|
ABreakPoint: TDBGBreakPoint;
|
|
ALocationAddr: TDBGLocationRec;
|
|
Context: TFpDbgSymbolScope;
|
|
PasExpr: TFpPascalExpression;
|
|
Opts: TFpInt3DebugBreakOptions;
|
|
begin
|
|
// If a user single steps to an excepiton handler, do not open the dialog (there is no continue possible)
|
|
if AnEventType = deBreakpoint then
|
|
if FExceptionStepper.BreakpointHit(&continue, Breakpoint) then
|
|
exit;
|
|
|
|
if assigned(Breakpoint) then begin
|
|
ABreakPoint := TFPBreakpoints(BreakPoints).Find(Breakpoint);
|
|
if (ABreakPoint <> nil) and (ABreakPoint.Enabled) then begin
|
|
|
|
// TODO: parse expression when breakpoin is created / so invalid expressions do not need to be handled here
|
|
if ABreakPoint.Expression <> '' then begin
|
|
Context := GetContextForEvaluate(FDbgController.CurrentThreadId, 0);
|
|
if Context <> nil then begin
|
|
PasExpr := nil;
|
|
try
|
|
PasExpr := TFpPascalExpression.Create(ABreakPoint.Expression, Context);
|
|
PasExpr.ResultValue; // trigger full validation
|
|
if PasExpr.Valid and (svfBoolean in PasExpr.ResultValue.FieldFlags) and
|
|
(not PasExpr.ResultValue.AsBool) // false => do not pause
|
|
then
|
|
&continue := True;
|
|
finally
|
|
PasExpr.Free;
|
|
Context.ReleaseReference;
|
|
end;
|
|
|
|
if &continue then
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
ALocationAddr := GetLocation;
|
|
if Assigned(EventLogHandler) then
|
|
EventLogHandler.LogEventBreakPointHit(ABreakpoint, ALocationAddr);
|
|
|
|
if assigned(ABreakPoint) then
|
|
ABreakPoint.Hit(&continue);
|
|
|
|
if (not &continue) and (ABreakPoint.Kind = bpkData) and (OnFeedback <> nil) then begin
|
|
// For message use location(Address - 1)
|
|
OnFeedback(self,
|
|
Format('The Watchpoint for "%1:s" was triggered.%0:s%0:s', // 'Old value: %2:s%0:sNew value: %3:s',
|
|
[LineEnding, ABreakPoint.WatchData{, AOldVal, ANewVal}]),
|
|
'', ftInformation, [frOk]);
|
|
end;
|
|
end
|
|
else
|
|
continue := True; // removed or disabled breakpoint
|
|
end
|
|
else
|
|
if (AnEventType = deHardCodedBreakpoint) and (FDbgController.CurrentThread <> nil) then begin
|
|
&continue:=true;
|
|
Opts := TFpDebugDebuggerProperties(GetProperties).HandleDebugBreakInstruction;
|
|
if not (dboIgnoreAll in Opts) then begin
|
|
&continue:=False;
|
|
if not AMoreHitEventsPending then
|
|
ALocationAddr := GetLocation;
|
|
end;
|
|
if continue then
|
|
exit;
|
|
end
|
|
else if (AnEventType = deInternalContinue) and FQuickPause then
|
|
begin
|
|
&continue:=true;
|
|
exit;
|
|
end
|
|
else
|
|
// Debugger returned after a step/next/step-out etc..
|
|
if not AMoreHitEventsPending then
|
|
ALocationAddr := GetLocation;
|
|
|
|
|
|
if not continue then
|
|
FPauseForEvent := True;
|
|
|
|
if not AMoreHitEventsPending then begin
|
|
FQuickPause := False; // Ok, because we will SetState => RunQuickPauseTasks is not needed
|
|
if FPauseForEvent then
|
|
&continue := False; // Only continue, if ALL events did say to continue
|
|
|
|
EnterPause(ALocationAddr, &continue);
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.EnterPause(ALocationAddr: TDBGLocationRec;
|
|
AnInternalPause: Boolean);
|
|
begin
|
|
if AnInternalPause then begin
|
|
if not (State in [dsPause, dsInternalPause]) then begin
|
|
SetState(dsInternalPause);
|
|
end;
|
|
end
|
|
else begin
|
|
if State <> dsPause then begin
|
|
SetState(dsPause);
|
|
DoCurrent(ALocationAddr);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.FDbgControllerCreateProcessEvent(var continue: boolean);
|
|
var
|
|
addr: TDBGPtrArray;
|
|
begin
|
|
// This will trigger setting the breakpoints,
|
|
// may also trigger the evaluation of the callstack or disassembler.
|
|
FSendingEvents := True; // Let DoStateChange know that the debugger is paused
|
|
RunQuickPauseTasks(True);
|
|
FSendingEvents := False;
|
|
|
|
FExceptionStepper.DoProcessLoaded;
|
|
|
|
if assigned(OnConsoleOutput) then
|
|
FConsoleOutputThread := TFpWaitForConsoleOutputThread.Create(self);
|
|
|
|
case FStartupCommand of
|
|
dcRunTo: begin
|
|
&continue := False;
|
|
if FDbgController.CurrentProcess.DbgInfo.HasInfo then begin
|
|
addr:=nil;
|
|
if FDbgController.CurrentProcess.DbgInfo.GetLineAddresses(FStartuRunToFile, FStartuRunToLine, addr, fsNext)
|
|
then begin
|
|
&continue := true;
|
|
FDbgController.InitializeCommand(TDbgControllerRunToCmd.Create(FDbgController, addr));
|
|
end;
|
|
end;
|
|
if not &continue then
|
|
EnterPause(GetLocation);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFpDebugDebugger.RequestCommand(const ACommand: TDBGCommand;
|
|
const AParams: array of const; const ACallback: TMethod): Boolean;
|
|
var
|
|
EvalFlags: TWatcheEvaluateFlags;
|
|
AConsoleTty, ResText: string;
|
|
addr: TDBGPtrArray;
|
|
Cmd: TDBGCommand;
|
|
WorkItem: TFpThreadWorkerControllerRun;
|
|
AThreadId, AStackFrame: Integer;
|
|
EvalWorkItem: TFpThreadWorkerCmdEval;
|
|
WorkItemModify: TFpThreadWorkerModifyUpdate;
|
|
begin
|
|
result := False;
|
|
if assigned(FDbgController) then
|
|
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
|
|
|
|
if (ACommand in [dcRun, dcStepOver, dcStepInto, dcStepOut, dcStepTo, dcRunTo, dcJumpto,
|
|
dcStepOverInstr, dcStepIntoInstr, dcAttach]) and
|
|
not assigned(FDbgController.MainProcess)
|
|
then
|
|
begin
|
|
FDbgController.ExecutableFilename:=FileName;
|
|
AConsoleTty:=TFpDebugDebuggerProperties(GetProperties).ConsoleTty;
|
|
FDbgController.ConsoleTty:=AConsoleTty;
|
|
FDbgController.RedirectConsoleOutput:=AConsoleTty='';
|
|
FDbgController.Params.Clear;
|
|
if Arguments<>'' then
|
|
CommandToList(Arguments, FDbgController.Params);
|
|
FDbgController.WorkingDirectory:=WorkingDir;
|
|
FDbgController.Environment:=Environment;
|
|
{$ifdef windows}
|
|
FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole;
|
|
{$endif windows}
|
|
FDbgController.AttachToPid := 0;
|
|
if ACommand = dcAttach then begin
|
|
FDbgController.AttachToPid := StrToIntDef(String(AParams[0].VAnsiString), 0);
|
|
Result := FDbgController.AttachToPid <> 0;
|
|
if not Result then begin
|
|
FileName := '';
|
|
Exit;
|
|
end;
|
|
end;
|
|
FWorkQueue.Clear;
|
|
FWorkQueue.ThreadCount := 1;
|
|
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := FWorkQueue.Threads[0].ThreadID;{$ENDIF}
|
|
WorkItem := TFpThreadWorkerControllerRun.Create(Self);
|
|
FWorkQueue.PushItem(WorkItem);
|
|
FWorkQueue.WaitForItem(WorkItem, True);
|
|
Result := WorkItem.StartSuccesfull;
|
|
FWorkerThreadId := WorkItem.WorkerThreadId;
|
|
WorkItem.DecRef;
|
|
if not result then begin
|
|
// TDebuggerIntf.SetFileName has set the state to dsStop, to make sure
|
|
// that dcRun could be requested. Reset the filename so that the state
|
|
// is set to dsIdle again and is set to dsStop on the next try
|
|
// to run.
|
|
FileName := '';
|
|
FreeDebugThread;
|
|
|
|
if not IsError(FDbgController.LastError) then
|
|
ResText := 'Error starting process in debugger'
|
|
else
|
|
ResText := GetFpErrorHandler.ErrorAsString(FDbgController.LastError);
|
|
DoDbgEvent(ecProcess, etProcessExit, ResText); // or ecDebugger?
|
|
if Assigned(OnFeedback) then
|
|
OnFeedback(self, ResText, '', ftError, [frOk]);
|
|
Exit;
|
|
end;
|
|
// TODO: any step commond should run to "main" or "pascalmain"
|
|
// Currently disabled in TFpDebugDebugger.GetSupportedCommands
|
|
FStartupCommand := ACommand;
|
|
if ACommand = dcRunTo then begin
|
|
FStartuRunToFile := AnsiString(AParams[0].VAnsiString);
|
|
FStartuRunToLine := AParams[1].VInteger;
|
|
end;
|
|
StartDebugLoop(dsInit);
|
|
exit;
|
|
end;
|
|
|
|
Cmd := ACommand;
|
|
FExceptionStepper.UserCommandRequested(Cmd);
|
|
case Cmd of
|
|
dcRun:
|
|
begin
|
|
Result := True;
|
|
StartDebugLoop;
|
|
end;
|
|
dcStop:
|
|
begin
|
|
FDbgController.Stop;
|
|
if state=dsPause then
|
|
begin
|
|
StartDebugLoop;
|
|
end;
|
|
result := true;
|
|
end;
|
|
dcStepIntoInstr:
|
|
begin
|
|
FDbgController.StepIntoInstr;
|
|
StartDebugLoop;
|
|
result := true;
|
|
end;
|
|
dcStepOverInstr:
|
|
begin
|
|
FDbgController.StepOverInstr;
|
|
StartDebugLoop;
|
|
result := true;
|
|
end;
|
|
dcPause:
|
|
begin
|
|
Result := FDbgController.Pause;
|
|
end;
|
|
dcStepTo:
|
|
begin
|
|
result := false;
|
|
if FDbgController.CurrentProcess.DbgInfo.HasInfo then
|
|
begin
|
|
addr:=nil;
|
|
if FDbgController.CurrentProcess.DbgInfo.GetLineAddresses(AnsiString(AParams[0].VAnsiString), AParams[1].VInteger, addr{, fsNext})
|
|
then begin
|
|
result := true;
|
|
FDbgController.InitializeCommand(TDbgControllerStepToCmd.Create(FDbgController, AnsiString(AParams[0].VAnsiString), AParams[1].VInteger));
|
|
StartDebugLoop;
|
|
end;
|
|
end;
|
|
end;
|
|
dcRunTo:
|
|
begin
|
|
result := false;
|
|
if FDbgController.CurrentProcess.DbgInfo.HasInfo then
|
|
begin
|
|
addr:=nil;
|
|
if FDbgController.CurrentProcess.DbgInfo.GetLineAddresses(AnsiString(AParams[0].VAnsiString), AParams[1].VInteger, addr, fsNext)
|
|
then begin
|
|
result := true;
|
|
FDbgController.InitializeCommand(TDbgControllerRunToCmd.Create(FDbgController, addr));
|
|
StartDebugLoop;
|
|
end;
|
|
end;
|
|
end;
|
|
dcStepOver:
|
|
begin
|
|
FDbgController.InitializeCommand(TDbgControllerStepOverOrFinallyCmd.Create(FDbgController));
|
|
StartDebugLoop;
|
|
result := true;
|
|
end;
|
|
dcStepInto:
|
|
begin
|
|
FDbgController.Step;
|
|
StartDebugLoop;
|
|
result := true;
|
|
end;
|
|
dcStepOut:
|
|
begin
|
|
FDbgController.StepOut(True);
|
|
StartDebugLoop;
|
|
result := true;
|
|
end;
|
|
dcDetach:
|
|
begin
|
|
Result := FDbgController.Detach;
|
|
if Result and (State in [dsPause, dsInternalPause]) then
|
|
StartDebugLoop(State); // Keep current State
|
|
end;
|
|
dcEvaluate:
|
|
begin
|
|
EvalFlags := TWatcheEvaluateFlags(AParams[1].VInteger);
|
|
GetCurrentThreadAndStackFrame(AThreadId, AStackFrame);
|
|
if FEvalWorkItem <> nil then begin
|
|
EvalWorkItem := FEvalWorkItem;
|
|
FEvalWorkItem := nil;
|
|
EvalWorkItem.Abort;
|
|
EvalWorkItem.DecRef;
|
|
end;
|
|
if defFullTypeInfo in EvalFlags then
|
|
FEvalWorkItem := TFpThreadWorkerCmdEval.Create(Self, twpInspect, String(AParams[0].VAnsiString),
|
|
AStackFrame, AThreadId, EvalFlags, TDBGEvaluateResultCallback(ACallback))
|
|
else
|
|
FEvalWorkItem := TFpThreadWorkerCmdEval.Create(Self, twpUser, String(AParams[0].VAnsiString),
|
|
AStackFrame, AThreadId, EvalFlags, TDBGEvaluateResultCallback(ACallback));
|
|
FWorkQueue.PushItem(FEvalWorkItem);
|
|
Result := True;
|
|
end;
|
|
dcModify:
|
|
begin
|
|
GetCurrentThreadAndStackFrame(AThreadId, AStackFrame);
|
|
WorkItemModify := TFpThreadWorkerModifyUpdate.Create(Self, AnsiString(AParams[0].VAnsiString), AnsiString(AParams[1].VAnsiString),
|
|
AStackFrame, AThreadId);
|
|
FWorkQueue.PushItem(WorkItemModify);
|
|
WorkItemModify.DecRef;
|
|
Result := True;
|
|
end;
|
|
dcSendConsoleInput:
|
|
begin
|
|
FDbgController.CurrentProcess.SendConsoleInput(String(AParams[0].VAnsiString));
|
|
end;
|
|
end; {case}
|
|
end;
|
|
|
|
function TFpDebugDebugger.ChangeFileName: Boolean;
|
|
begin
|
|
result := true;
|
|
end;
|
|
|
|
function TFpDebugDebugger.ExecuteInDebugThread(AMethod: TFpDbgAsyncMethod
|
|
): boolean;
|
|
var
|
|
WorkItem: TFpThreadWorkerAsyncMeth;
|
|
begin
|
|
assert(ThreadID <> FWorkerThreadId, 'TFpDebugDebugger.ExecuteInDebugThread: ThreadID <> FWorkerThreadId');
|
|
//Result := True;
|
|
//if ThreadID = FWorkerThreadId then begin
|
|
// AMethod();
|
|
// exit;
|
|
//end;
|
|
|
|
Result := False;
|
|
|
|
WorkItem := TFpThreadWorkerAsyncMeth.Create(Self, AMethod);
|
|
FWorkQueue.PushItem(WorkItem);
|
|
FWorkQueue.WaitForItem(WorkItem, True);
|
|
WorkItem.DecRef;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.StartDebugLoop(AState: TDBGState);
|
|
var
|
|
WorkItem: TFpThreadWorkerRunLoopUpdate;
|
|
begin
|
|
{$ifdef DBG_FPDEBUG_VERBOSE}
|
|
DebugLn(DBG_VERBOSE, 'StartDebugLoop');
|
|
{$endif DBG_FPDEBUG_VERBOSE}
|
|
SetState(AState);
|
|
WorkItem := TFpThreadWorkerRunLoopUpdate.Create(Self);
|
|
FWorkQueue.PushItem(WorkItem);
|
|
WorkItem.DecRef;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DebugLoopFinished(Data: PtrInt);
|
|
var
|
|
Cont: boolean;
|
|
WorkItem: TFpThreadWorkerRunLoopAfterIdleUpdate;
|
|
c: Integer;
|
|
begin
|
|
LockRelease;
|
|
try
|
|
{$ifdef DBG_FPDEBUG_VERBOSE}
|
|
DebugLn(DBG_VERBOSE, 'DebugLoopFinished');
|
|
{$endif DBG_FPDEBUG_VERBOSE}
|
|
|
|
(* Need to ensure CurrentThreadId is correct,
|
|
because any callstack (never mind which to which IDE-thread object it belongs
|
|
will always get the data for the current thread only
|
|
TODO: callstacks need a field with the thread-id to which they belong *)
|
|
if (Threads <> nil) and (Threads.CurrentThreads <> nil) and
|
|
(FDbgController.CurrentThread <> nil)
|
|
then
|
|
Threads.CurrentThreads.CurrentThreadId := FDbgController.CurrentThreadId;
|
|
|
|
FPauseForEvent := False;
|
|
FSendingEvents := True;
|
|
try
|
|
FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)
|
|
if State = dsRun then
|
|
RunQuickPauseTasks;
|
|
finally
|
|
FSendingEvents := False;
|
|
end;
|
|
|
|
FQuickPause:=false;
|
|
|
|
if Cont then begin
|
|
if State in [dsPause, dsInternalPause] then begin
|
|
FWorkQueue.Lock;
|
|
CheckAndRunIdle;
|
|
(* IdleThreadCount could (race condition) be to high.
|
|
Then DebugHistory may loose ONE item. (only one working thread.
|
|
Practically this is unlikely, since the thread had time to set
|
|
the count, since the Lock started.
|
|
*)
|
|
c := FWorkQueue.Count + FWorkQueue.ThreadCount - FWorkQueue.IdleThreadCount;
|
|
FWorkQueue.Unlock;
|
|
if c = 0 then
|
|
DoProcessMessages;
|
|
end
|
|
else
|
|
c := 0;
|
|
|
|
if c = 0 then begin
|
|
StartDebugLoop;
|
|
end
|
|
else begin
|
|
WorkItem := TFpThreadWorkerRunLoopAfterIdleUpdate.Create(Self);
|
|
FWorkQueue.PushItem(WorkItem);
|
|
WorkItem.DecRef;
|
|
end;
|
|
end;
|
|
finally
|
|
UnlockRelease;
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.QuickPause;
|
|
begin
|
|
FQuickPause:=FDbgController.Pause;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.RunQuickPauseTasks(AForce: Boolean);
|
|
begin
|
|
if AForce or
|
|
FQuickPause
|
|
then
|
|
TFPBreakpoints(Breakpoints).DoStateChange(dsRun);
|
|
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)
|
|
then begin
|
|
FDbgController.Stop;
|
|
FDbgControllerProcessExitEvent(0); // Force exit;
|
|
end;
|
|
|
|
inherited DoRelease;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.CheckAndRunIdle;
|
|
begin
|
|
if (not (State in [dsPause, dsInternalPause])) or
|
|
(not Assigned(OnIdle)) or
|
|
(FWorkQueue.Count <> 0)
|
|
then
|
|
exit;
|
|
|
|
DebugLnEnter(DBG_VERBOSE, ['>> TFpDebugDebugger.CheckAndRunIdle ']);
|
|
FIsIdle := True;
|
|
try
|
|
OnIdle(Self);
|
|
except
|
|
on E: Exception do
|
|
DebugLn(['exception during idle ', E.ClassName, ': ', E.Message]);
|
|
end;
|
|
FIsIdle := False;
|
|
DebugLnExit(DBG_VERBOSE, ['<< TFpDebugDebugger.CheckAndRunIdle ']);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoBeforeState(const OldState: TDBGState);
|
|
var
|
|
EvalWorkItem: TFpThreadWorkerCmdEval;
|
|
begin
|
|
if not (State in [dsPause, dsInternalPause]) then begin
|
|
TFPThreads(Threads).StopWorkes;
|
|
TFPCallStackSupplier(CallStack).StopWorkes;
|
|
TFPWatches(Watches).StopWorkes;
|
|
TFPLocals(Locals).StopWorkes;
|
|
|
|
if FEvalWorkItem <> nil then begin
|
|
EvalWorkItem := FEvalWorkItem;
|
|
FEvalWorkItem := nil;
|
|
EvalWorkItem.Abort;
|
|
EvalWorkItem.DecRef;
|
|
end;
|
|
end;
|
|
|
|
inherited DoBeforeState(OldState);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoState(const OldState: TDBGState);
|
|
begin
|
|
LockRelease;
|
|
try
|
|
inherited DoState(OldState);
|
|
finally
|
|
UnlockRelease;
|
|
end;
|
|
end;
|
|
|
|
function TFpDebugDebugger.GetIsIdle: Boolean;
|
|
begin
|
|
Result := (FWorkQueue.Count = 0) or FIsIdle;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoAddBreakFuncLib;
|
|
begin
|
|
if FCacheLib <> nil then
|
|
FCacheBreakpoint := FCacheLib.AddBreak(FCacheFileName, FCacheBoolean)
|
|
else
|
|
FCacheBreakpoint := TDbgInstance(FDbgController.CurrentProcess).AddBreak(FCacheFileName, FCacheBoolean);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoAddBreakLocation;
|
|
begin
|
|
if FCacheLocation = 0 then
|
|
FCacheBreakpoint := FDbgController.CurrentProcess.AddBreak(nil, FCacheBoolean)
|
|
else
|
|
FCacheBreakpoint := FDbgController.CurrentProcess.AddBreak(FCacheLocation, FCacheBoolean);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoReadData;
|
|
begin
|
|
FCacheBoolean:=FDbgController.CurrentProcess.ReadData(FCacheLocation, FCacheLine, FCachePointer^);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoReadPartialData;
|
|
begin
|
|
FCacheBoolean:=FDbgController.CurrentProcess.ReadData(FCacheLocation, FCacheLine, FCachePointer^, FCacheBytesRead);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoFindContext;
|
|
begin
|
|
FCacheContext := FDbgController.CurrentProcess.FindSymbolScope(FCacheThreadId, FCacheStackFrame);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoSetStackFrameForBasePtr;
|
|
begin
|
|
FDbgController.CurrentThread.PrepareCallStackEntryList(7);
|
|
if (FCacheLocation = 0) and (FCacheLocation2 <> 0) then
|
|
FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByInstructionPointer(FCacheLocation2, 15, 1)
|
|
else
|
|
FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(FCacheLocation, 30, 1);
|
|
end;
|
|
|
|
function TFpDebugDebugger.AddBreak(const ALocation: TDbgPtr; AnEnabled: Boolean
|
|
): TFpDbgBreakpoint;
|
|
begin
|
|
// Shortcut, if in debug-thread / do not use Self.F*
|
|
if ThreadID = FWorkerThreadId then
|
|
if ALocation = 0 then exit(FDbgController.CurrentProcess.AddBreak(nil, AnEnabled))
|
|
else exit(FDbgController.CurrentProcess.AddBreak(ALocation, AnEnabled));
|
|
|
|
FCacheLocation:=ALocation;
|
|
FCacheBoolean:=AnEnabled;
|
|
FCacheBreakpoint := nil;
|
|
ExecuteInDebugThread(@DoAddBreakLocation);
|
|
result := FCacheBreakpoint;
|
|
end;
|
|
|
|
function TFpDebugDebugger.AddBreak(const AFuncName: String; ALib: TDbgLibrary;
|
|
AnEnabled: Boolean): TFpDbgBreakpoint;
|
|
begin
|
|
// Shortcut, if in debug-thread / do not use Self.F*
|
|
if ThreadID = FWorkerThreadId then
|
|
if ALib <> nil then exit(ALib.AddBreak(AFuncName, AnEnabled))
|
|
else exit(TDbgInstance(FDbgController.CurrentProcess).AddBreak(AFuncName, AnEnabled));
|
|
|
|
FCacheFileName:=AFuncName;
|
|
FCacheLib:=ALib;
|
|
FCacheBoolean:=AnEnabled;
|
|
FCacheBreakpoint := nil;
|
|
ExecuteInDebugThread(@DoAddBreakFuncLib);
|
|
result := FCacheBreakpoint;
|
|
end;
|
|
|
|
function TFpDebugDebugger.ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean;
|
|
begin
|
|
// Shortcut, if in debug-thread / do not use Self.F*
|
|
if ThreadID = FWorkerThreadId then
|
|
exit(FDbgController.CurrentProcess.ReadData(AAdress, ASize, AData));
|
|
|
|
FCacheLocation := AAdress;
|
|
FCacheLine:=ASize;
|
|
FCachePointer := @AData;
|
|
FCacheBoolean := False;
|
|
ExecuteInDebugThread(@DoReadData);
|
|
result := FCacheBoolean;
|
|
end;
|
|
|
|
function TFpDebugDebugger.ReadData(const AAdress: TDbgPtr;
|
|
const ASize: Cardinal; out AData; out ABytesRead: Cardinal): Boolean;
|
|
begin
|
|
// Shortcut, if in debug-thread / do not use Self.F*
|
|
if ThreadID = FWorkerThreadId then
|
|
exit(FDbgController.CurrentProcess.ReadData(AAdress, ASize, AData, ABytesRead));
|
|
|
|
FCacheLocation := AAdress;
|
|
FCacheLine:=ASize;
|
|
FCachePointer := @AData;
|
|
FCacheBoolean := False;
|
|
FCacheBytesRead := 0;
|
|
ExecuteInDebugThread(@DoReadPartialData);
|
|
result := FCacheBoolean;
|
|
ABytesRead := FCacheBytesRead;
|
|
end;
|
|
|
|
function TFpDebugDebugger.ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean;
|
|
var
|
|
dw: DWord;
|
|
qw: QWord;
|
|
begin
|
|
case FDbgController.CurrentProcess.Mode of
|
|
dm32:
|
|
begin
|
|
result := ReadData(AAdress, sizeof(dw), dw);
|
|
AData:=dw;
|
|
end;
|
|
dm64:
|
|
begin
|
|
result := ReadData(AAdress, sizeof(qw), qw);
|
|
AData:=qw;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFpDebugDebugger.SetStackFrameForBasePtr(ABasePtr: TDBGPtr;
|
|
ASearchAssert: boolean; CurAddr: TDBGPtr): TDBGPtr;
|
|
const
|
|
SYS_ASSERT_NAME = 'SYSUTILS_$$_ASSERT'; // AssertErrorHandler, in case the assert is hidden in the stack
|
|
var
|
|
f: Integer;
|
|
CList: TDbgCallstackEntryList;
|
|
P: TFpSymbol;
|
|
begin
|
|
assert(GetCurrentThreadId=MainThreadID, 'TFpDebugDebugger.SetStackFrameForBasePtr: GetCurrentThreadId=MainThreadID');
|
|
|
|
Result := 0;
|
|
if FDbgController.CurrentThread = nil then
|
|
exit;
|
|
FCacheLocation:=ABasePtr;
|
|
FCacheLocation2:=CurAddr;
|
|
ExecuteInDebugThread(@DoSetStackFrameForBasePtr);
|
|
f := FCacheStackFrame;
|
|
|
|
if (f >= 2) and ASearchAssert and (ABasePtr <> 0) then begin
|
|
// stack is already prepared / exe in thread not needed
|
|
CList := FDbgController.CurrentThread.CallStackEntryList;
|
|
if (CList[f].AnAddress = CurAddr) then begin
|
|
P := CList[f-2].ProcSymbol;
|
|
if (P <> nil) and
|
|
( (P.Name = 'FPC_ASSERT') or (P.Name = 'fpc_assert') or
|
|
(P.Name = 'ASSERT') or (P.Name = 'assert') or
|
|
(CompareText(copy(P.Name, 1, length(SYS_ASSERT_NAME)), SYS_ASSERT_NAME) = 0) )
|
|
then begin
|
|
dec(f);
|
|
Result := CList[f].AnAddress - 1;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if (ABasePtr = 0) and (CurAddr <> 0) and (f > 0) then begin
|
|
Result := CurAddr - 1; // found address on stack, so this is return address
|
|
end;
|
|
|
|
if f > 0 then begin
|
|
TFPCallStackSupplier(CallStack).FThreadForInitialFrame := FDbgController.CurrentThread.ID;
|
|
TFPCallStackSupplier(CallStack).FInitialFrame := f;
|
|
end;
|
|
end;
|
|
|
|
function TFpDebugDebugger.FindSymbolScope(AThreadId, AStackFrame: Integer): TFpDbgSymbolScope;
|
|
begin
|
|
assert(GetCurrentThreadId=MainThreadID, 'TFpDebugDebugger.FindSymbolScope: GetCurrentThreadId=MainThreadID');
|
|
FCacheThreadId := AThreadId;
|
|
FCacheStackFrame := AStackFrame;
|
|
FCacheContext := nil;
|
|
ExecuteInDebugThread(@DoFindContext);
|
|
Result := FCacheContext;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.StopAllWorkers;
|
|
begin
|
|
TFPThreads(Threads).StopWorkes;
|
|
TFPCallStackSupplier(CallStack).StopWorkes;
|
|
TFPWatches(Watches).StopWorkes;
|
|
TFPLocals(Locals).StopWorkes;
|
|
if FEvalWorkItem <> nil then begin
|
|
FEvalWorkItem.Abort;
|
|
FEvalWorkItem.DecRef;
|
|
FEvalWorkItem := nil;
|
|
end;
|
|
end;
|
|
|
|
function TFpDebugDebugger.IsPausedAndValid: boolean;
|
|
begin
|
|
Result := False;
|
|
if self = nil then
|
|
exit;
|
|
Result := (State in [dsPause, dsInternalPause]) and
|
|
(FDbgController <> nil) and
|
|
(FDbgController.CurrentProcess <> nil);
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.DoProcessMessages;
|
|
begin
|
|
try
|
|
Application.ProcessMessages;
|
|
except
|
|
on E: Exception do debugln(['Application.ProcessMessages crashed with ', E.Message]);
|
|
end;
|
|
end;
|
|
|
|
constructor TFpDebugDebugger.Create(const AExternalDebugger: String);
|
|
begin
|
|
ProcessMessagesProc := @DoProcessMessages;
|
|
inherited Create(AExternalDebugger);
|
|
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);
|
|
FMemConverter := TFpDbgMemConvertorLittleEndian.Create;
|
|
FMemManager := TFpDbgMemManager.Create(FMemReader, FMemConverter);
|
|
FMemManager.MemLimits.MaxMemReadSize := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxMemReadSize;
|
|
FMemManager.MemLimits.MaxArrayLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxArrayLen;
|
|
FMemManager.MemLimits.MaxStringLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxStringLen;
|
|
FMemManager.MemLimits.MaxNullStringSearchLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxNullStringSearchLen;
|
|
FDbgController := TDbgController.Create(FMemManager);
|
|
FDbgController.OnCreateProcessEvent:=@FDbgControllerCreateProcessEvent;
|
|
FDbgController.OnHitBreakpointEvent:=@FDbgControllerHitBreakpointEvent;
|
|
FDbgController.OnProcessExitEvent:=@FDbgControllerProcessExitEvent;
|
|
FDbgController.OnExceptionEvent:=@FDbgControllerExceptionEvent;
|
|
FDbgController.OnDebugInfoLoaded := @FDbgControllerDebugInfoLoaded;
|
|
FDbgController.OnLibraryLoadedEvent := @FDbgControllerLibraryLoaded;
|
|
FDbgController.OnLibraryUnloadedEvent := @FDbgControllerLibraryUnloaded;
|
|
FDbgController.OnThreadDebugOutputEvent := @DoThreadDebugOutput;
|
|
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
|
|
|
|
FDbgController.OnThreadProcessLoopCycleEvent:=@FExceptionStepper.ThreadProcessLoopCycle;
|
|
FDbgController.OnThreadBeforeProcessLoop:=@FExceptionStepper.ThreadBeforeLoop;
|
|
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;
|
|
FWorkQueue.TerminateAllThreads(True);
|
|
DoProcessMessages; // run the AsyncMethods
|
|
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF}
|
|
|
|
Application.RemoveAsyncCalls(Self);
|
|
FreeAndNil(FFpDebugOutputQueue);
|
|
FreeAndNil(FDbgController);
|
|
FreeAndNil(FPrettyPrinter);
|
|
FreeAndNil(FMemManager);
|
|
FreeAndNil(FMemConverter);
|
|
FreeAndNil(FMemReader);
|
|
FreeAndNil(FExceptionStepper);
|
|
inherited Destroy;
|
|
FreeAndNil(FWorkQueue);
|
|
FreeAndNil(FLockList);
|
|
end;
|
|
|
|
function TFpDebugDebugger.GetLocationRec(AnAddress: TDBGPtr;
|
|
AnAddrOffset: Integer): TDBGLocationRec;
|
|
var
|
|
sym, symproc: TFpSymbol;
|
|
begin
|
|
if Assigned(FDbgController.CurrentProcess) then
|
|
begin
|
|
result.FuncName:='';
|
|
result.SrcFile:='';
|
|
result.SrcFullName:='';
|
|
result.SrcLine:=0;
|
|
|
|
if AnAddress=0 then
|
|
result.Address := FDbgController.DefaultContext.Address // DefaultContext has the InstrPtr cached
|
|
//result.Address := FDbgController.CurrentThread.GetInstructionPointerRegisterValue
|
|
else
|
|
result.Address := AnAddress;
|
|
|
|
{$PUSH}{$R-}{$Q-}
|
|
sym := FDbgController.CurrentProcess.FindProcSymbol(result.Address + AnAddrOffset);
|
|
{$POP}
|
|
if sym = nil then
|
|
Exit;
|
|
|
|
result.SrcFile := ExtractFileName(sym.FileName);
|
|
result.SrcLine := sym.Line;
|
|
result.SrcFullName := sym.FileName;
|
|
|
|
symproc := sym;
|
|
//while not (symproc.kind in [skProcedure, skFunction]) do
|
|
// symproc := symproc.Parent;
|
|
|
|
if assigned(symproc) then
|
|
result.FuncName:=symproc.Name;
|
|
sym.ReleaseReference;
|
|
end
|
|
end;
|
|
|
|
function TFpDebugDebugger.GetLocation: TDBGLocationRec;
|
|
begin
|
|
Result:=GetLocationRec;
|
|
end;
|
|
|
|
class function TFpDebugDebugger.Caption: String;
|
|
begin
|
|
Result:='FpDebug internal Dwarf-debugger';
|
|
end;
|
|
|
|
class function TFpDebugDebugger.NeedsExePath: boolean;
|
|
begin
|
|
Result:=False;
|
|
end;
|
|
|
|
class function TFpDebugDebugger.RequiredCompilerOpts(ATargetCPU, ATargetOS: String): TDebugCompilerRequirements;
|
|
begin
|
|
{$ifdef CD_Cocoa}{$DEFINE MacOS}
|
|
if ATargetCPU = '' then ATargetCPU := 'x86_64';
|
|
{$ENDIF}
|
|
{$IFDEF Darwin}{$DEFINE MacOS}
|
|
if ATargetCPU = '' then ATargetCPU := 'i386';
|
|
{$ENDIF}
|
|
{$IFDEF MacOs}
|
|
if LowerCase(ATargetCPU) = 'i386' then
|
|
Result:=[dcrDwarfOnly] // carbon
|
|
else
|
|
Result:=[dcrExternalDbgInfoOnly, dcrDwarfOnly]; // cocoa
|
|
{$ELSE}
|
|
Result:=[dcrDwarfOnly];
|
|
{$ENDIF}
|
|
end;
|
|
|
|
class function TFpDebugDebugger.CreateProperties: TDebuggerProperties;
|
|
begin
|
|
Result := TFpDebugDebuggerProperties.Create;
|
|
end;
|
|
|
|
function TFpDebugDebugger.GetCommands: TDBGCommands;
|
|
begin
|
|
Result := inherited GetCommands;
|
|
if State = dsStop then
|
|
Result := Result - [dcStepInto, dcStepOver, dcStepOut, dcStepIntoInstr, dcStepOverInstr];
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.LockCommandProcessing;
|
|
begin
|
|
//inherited LockCommandProcessing;
|
|
// FWorkQueue.Lock;
|
|
end;
|
|
|
|
procedure TFpDebugDebugger.UnLockCommandProcessing;
|
|
begin
|
|
//inherited UnLockCommandProcessing;
|
|
// FWorkQueue.Unlock;
|
|
end;
|
|
|
|
class function TFpDebugDebugger.GetSupportedCommands: TDBGCommands;
|
|
begin
|
|
Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver,
|
|
dcStepTo, dcRunTo, dcPause, dcStepOut, dcStepInto, dcEvaluate, dcModify,
|
|
dcSendConsoleInput
|
|
{$IFDEF windows} , dcAttach, dcDetach {$ENDIF}
|
|
{$IFDEF linux} , dcAttach, dcDetach {$ENDIF}
|
|
];
|
|
end;
|
|
|
|
class function TFpDebugDebugger.SupportedCommandsFor(AState: TDBGState
|
|
): TDBGCommands;
|
|
begin
|
|
Result := inherited SupportedCommandsFor(AState);
|
|
if AState = dsStop then
|
|
Result := Result - [dcStepInto, dcStepOver, dcStepOut, dcStepIntoInstr, dcStepOverInstr];
|
|
end;
|
|
|
|
class function TFpDebugDebugger.SupportedFeatures: TDBGFeatures;
|
|
begin
|
|
Result := [dfEvalFunctionCalls];
|
|
end;
|
|
|
|
initialization
|
|
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
|
|
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
|
|
DBG_BREAKPOINTS := DebugLogger.FindOrRegisterLogGroup('DBG_BREAKPOINTS' {$IFDEF DBG_BREAKPOINTS} , True {$ENDIF} );
|
|
FPDBG_COMMANDS := DebugLogger.FindOrRegisterLogGroup('FPDBG_COMMANDS' {$IFDEF FPDBG_COMMANDS} , True {$ENDIF} );
|
|
|
|
end.
|
|
|