mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-04 11:03:47 +02:00
3159 lines
89 KiB
ObjectPascal
3159 lines
89 KiB
ObjectPascal
(* This program 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, 3 or any later version
|
|
of the License (at your option).
|
|
|
|
This program 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.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
*)
|
|
|
|
(*
|
|
settings set target.output-path /tmp/out.txt
|
|
*)
|
|
unit LldbDebugger;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, strutils, math,
|
|
// LazUtils
|
|
LazClasses, LazFileUtils, LazLoggerBase, LazStringUtils, Maps,
|
|
// DebuggerIntf
|
|
DbgIntfDebuggerBase, DbgIntfBaseTypes,
|
|
// CmdLineDebuggerBase
|
|
DebugProcess,
|
|
// LazDebuggerLldb
|
|
LldbInstructions, LldbHelper;
|
|
|
|
type
|
|
|
|
(*
|
|
* Commands
|
|
*)
|
|
|
|
TLldbDebugger = class;
|
|
TLldbDebuggerCommand = class;
|
|
|
|
{ TLldbDebuggerCommandQueue }
|
|
|
|
TLldbDebuggerCommandQueue = class(TRefCntObjList)
|
|
private
|
|
FDebugger: TLldbDebugger;
|
|
FLockQueueRun: Integer;
|
|
function Get(Index: Integer): TLldbDebuggerCommand;
|
|
procedure Put(Index: Integer; const AValue: TLldbDebuggerCommand);
|
|
private
|
|
FRunningCommand: TLldbDebuggerCommand;
|
|
procedure Run; // Call Debugger.OnIdle // set IsIdle
|
|
protected
|
|
procedure CommandFinished(ACommand: TLldbDebuggerCommand);
|
|
public
|
|
constructor Create(ADebugger: TLldbDebugger);
|
|
destructor Destroy; override;
|
|
procedure CancelAll;
|
|
procedure CancelForRun;
|
|
procedure LockQueueRun;
|
|
procedure UnLockQueueRun;
|
|
property Items[Index: Integer]: TLldbDebuggerCommand read Get write Put; default;
|
|
procedure QueueCommand(AValue: TLldbDebuggerCommand);
|
|
procedure DoLineDataReceived(var ALine: String);
|
|
property RunningCommand: TLldbDebuggerCommand read FRunningCommand;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommand }
|
|
|
|
TLldbDebuggerCommand = class(TRefCountedObject)
|
|
private
|
|
FCancelableForRun: Boolean;
|
|
FOwner: TLldbDebugger;
|
|
FIsRunning: Boolean;
|
|
function GetDebuggerState: TDBGState;
|
|
function GetCommandQueue: TLldbDebuggerCommandQueue;
|
|
function GetInstructionQueue: TLldbInstructionQueue;
|
|
protected
|
|
procedure DoLineDataReceived(var ALine: String); virtual;
|
|
procedure DoExecute; virtual; abstract;
|
|
procedure DoCancel; virtual;
|
|
procedure Finished;
|
|
|
|
procedure InstructionSucceeded(AnInstruction: TObject);
|
|
procedure InstructionFailed(AnInstruction: TObject);
|
|
|
|
procedure QueueInstruction(AnInstruction: TLldbInstruction);
|
|
procedure SetDebuggerState(const AValue: TDBGState);
|
|
property Debugger: TLldbDebugger read FOwner;
|
|
property CommandQueue: TLldbDebuggerCommandQueue read GetCommandQueue;
|
|
property InstructionQueue: TLldbInstructionQueue read GetInstructionQueue;
|
|
property DebuggerState: TDBGState read GetDebuggerState;
|
|
public
|
|
constructor Create(AOwner: TLldbDebugger);
|
|
destructor Destroy; override;
|
|
procedure Execute;
|
|
procedure Cancel;
|
|
property CancelableForRun: Boolean read FCancelableForRun write FCancelableForRun;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandInit }
|
|
|
|
TLldbDebuggerCommandInit = class(TLldbDebuggerCommand)
|
|
private
|
|
FGotLLDB: Boolean;
|
|
protected
|
|
procedure DoExecute; override;
|
|
procedure DoLineDataReceived(var ALine: String); override;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandRun }
|
|
|
|
TLldbDebuggerCommandRun = class(TLldbDebuggerCommand)
|
|
private type
|
|
TExceptionInfoCommand = (exiReg0, exiReg2, exiClass, exiMsg);
|
|
TExceptionInfoCommands = set of TExceptionInfoCommand;
|
|
private
|
|
FMode: (cmRun, cmRunToCatch, cmRunAfterCatch, cmRunToTmpBrk);
|
|
FState: (crRunning, crReadingThreads, crStopped, crStoppedRaise, crDone);
|
|
FNextStepAction: TLldbInstructionProcessStepAction;
|
|
FWaitToResume: Boolean;
|
|
FCurBrkId, FTmpBreakId: Integer;
|
|
FUnknownStopReason: String;
|
|
FThreadInstr: TLldbInstructionThreadList;
|
|
FCurrentExceptionInfo: record
|
|
FHasCommandData: TExceptionInfoCommands; // cleared in Setstate
|
|
FObjAddress, FFramePtr: TDBGPtr;
|
|
FExceptClass: String;
|
|
FExceptMsg: String;
|
|
end;
|
|
FFramePtrAtStart: TDBGPtr;
|
|
FFramesDescending: Boolean;
|
|
procedure ThreadInstructionSucceeded(Sender: TObject);
|
|
procedure ExceptionReadReg0Success(Sender: TObject);
|
|
procedure ExceptionReadReg2Success(Sender: TObject);
|
|
procedure ExceptionReadClassSuccess(Sender: TObject);
|
|
procedure ExceptionReadMsgSuccess(Sender: TObject);
|
|
procedure CatchesStackInstructionFinished(Sender: TObject);
|
|
procedure SearchFpStackInstructionFinished(Sender: TObject);
|
|
procedure SearchExceptFpStackInstructionFinished(Sender: TObject);
|
|
procedure TempBreakPointSet(Sender: TObject);
|
|
procedure RunInstructionSucceeded(AnInstruction: TObject);
|
|
procedure ResetStateToRun;
|
|
procedure SetNextStepCommand(AStepAction: TLldbInstructionProcessStepAction);
|
|
procedure ResumeWithNextStepCommand;
|
|
procedure SetTempBreakPoint(AnAddr: TDBGPtr);
|
|
procedure DeleteTempBreakPoint;
|
|
Procedure SetDebuggerLocation(AnAddr, AFrame: TDBGPtr; AFuncName, AFile, AFullFile: String; SrcLine: integer);
|
|
protected
|
|
FStepAction: TLldbInstructionProcessStepAction;
|
|
procedure DoLineDataReceived(var ALine: String); override;
|
|
procedure DoCancel; override;
|
|
procedure DoInitialExecute; virtual; abstract;
|
|
procedure DoExecute; override;
|
|
public
|
|
constructor Create(AOwner: TLldbDebugger);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandRunStep }
|
|
|
|
TLldbDebuggerCommandRunStep = class(TLldbDebuggerCommandRun)
|
|
private
|
|
protected
|
|
procedure DoInitialExecute; override;
|
|
public
|
|
constructor Create(AOwner: TLldbDebugger; AStepAction: TLldbInstructionProcessStepAction);
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandRunLaunch }
|
|
|
|
TLldbDebuggerCommandRunLaunch = class(TLldbDebuggerCommandRun)
|
|
private
|
|
FRunInstr: TLldbInstruction;
|
|
FLaunchWarnings: String;
|
|
procedure CollectDwarfLoadErrors(Sender: TObject);
|
|
procedure ExceptBreakInstructionFinished(Sender: TObject);
|
|
procedure LaunchInstructionSucceeded(Sender: TObject);
|
|
procedure TargetCreated(Sender: TObject);
|
|
protected
|
|
procedure DoInitialExecute; override;
|
|
constructor Create(AOwner: TLldbDebugger);
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandStop }
|
|
|
|
TLldbDebuggerCommandStop = class(TLldbDebuggerCommand)
|
|
private
|
|
procedure StopInstructionSucceeded(Sender: TObject);
|
|
protected
|
|
procedure DoExecute; override;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandLocals }
|
|
|
|
TLldbDebuggerCommandLocals = class(TLldbDebuggerCommand)
|
|
private
|
|
FLocals: TLocals;
|
|
FLocalsInstr: TLldbInstructionLocals;
|
|
procedure DoLocalsFreed(Sender: TObject);
|
|
procedure LocalsInstructionFinished(Sender: TObject);
|
|
protected
|
|
procedure DoExecute; override;
|
|
public
|
|
constructor Create(AOwner: TLldbDebugger; ALocals: TLocals);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandEvaluate }
|
|
|
|
TLldbDebuggerCommandEvaluate = class(TLldbDebuggerCommand)
|
|
private
|
|
FInstr: TLldbInstructionExpression;
|
|
FWatchValue: TWatchValue;
|
|
FExpr: String;
|
|
FFlags: TDBGEvaluateFlags;
|
|
FCallback: TDBGEvaluateResultCallback;
|
|
procedure DoWatchFreed(Sender: TObject);
|
|
procedure EvalInstructionFailed(Sender: TObject);
|
|
procedure EvalInstructionSucceeded(Sender: TObject);
|
|
protected
|
|
procedure DoExecute; override;
|
|
public
|
|
// TODO: Pass FCurrentStackFrame to create
|
|
constructor Create(AOwner: TLldbDebugger; AWatchValue: TWatchValue);
|
|
constructor Create(AOwner: TLldbDebugger; AnExpr: String; AFlags: TDBGEvaluateFlags;
|
|
ACallback: TDBGEvaluateResultCallback);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
{ TlldbInternalBreakPoint }
|
|
|
|
TlldbInternalBreakPoint = class
|
|
private
|
|
FDwarfLoadErrors: String;
|
|
FName: String;
|
|
FBeforePrologue: Boolean;
|
|
FId: Integer;
|
|
FDebugger: TLldbDebugger;
|
|
FOnFail: TNotifyEvent;
|
|
FOnFinish: TNotifyEvent;
|
|
procedure BreakSetSuccess(Sender: TObject);
|
|
procedure DoFailed(Sender: TObject);
|
|
procedure DoFinished(Sender: TObject);
|
|
procedure QueueInstruction(AnInstr: TLldbInstruction);
|
|
public
|
|
constructor Create(AName: String; ADebugger: TLldbDebugger; ABeforePrologue: Boolean = False);
|
|
destructor Destroy; override;
|
|
procedure Enable;
|
|
procedure Disable;
|
|
procedure Remove;
|
|
property BreakId: Integer read FId;
|
|
property OnFail: TNotifyEvent read FOnFail write FOnFail;
|
|
property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
|
|
property DwarfLoadErrors: String read FDwarfLoadErrors;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandRegister }
|
|
|
|
TLldbDebuggerCommandRegister = class(TLldbDebuggerCommand)
|
|
private
|
|
FRegisters: TRegisters;
|
|
procedure RegisterInstructionFinished(Sender: TObject);
|
|
protected
|
|
procedure DoExecute; override;
|
|
procedure DoCancel; override;
|
|
public
|
|
constructor Create(AOwner: TLldbDebugger; ARegisters: TRegisters);
|
|
destructor Destroy; override;
|
|
property Registers: TRegisters read FRegisters;
|
|
end;
|
|
|
|
(*
|
|
* Debugger
|
|
*)
|
|
{ TLldbDebugger }
|
|
|
|
{ TLldbDebuggerProperties }
|
|
|
|
TLldbDebuggerProperties = class(TDebuggerProperties)
|
|
private
|
|
FLaunchNewTerminal: Boolean;
|
|
FSkipGDBDetection: Boolean;
|
|
FIgnoreLaunchWarnings: Boolean;
|
|
public
|
|
constructor Create; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property LaunchNewTerminal: Boolean read FLaunchNewTerminal write FLaunchNewTerminal default False;
|
|
property SkipGDBDetection: Boolean read FSkipGDBDetection write FSkipGDBDetection default False;
|
|
property IgnoreLaunchWarnings: Boolean read FIgnoreLaunchWarnings write FIgnoreLaunchWarnings default False;
|
|
end;
|
|
|
|
TLldbDebugger = class(TDebuggerIntf)
|
|
private
|
|
FDebugProcess: TDebugProcess;
|
|
FDebugInstructionQueue: TLldbInstructionQueue;
|
|
FCommandQueue: TLldbDebuggerCommandQueue;
|
|
FInIdle: Boolean;
|
|
FCurrentLocation: TDBGLocationRec;
|
|
FCurrentStackFrame: Integer;
|
|
FCurrentThreadId: Integer;
|
|
FCurrentThreadFramePtr: TDBGPtr;
|
|
FBreakErrorBreak: TlldbInternalBreakPoint;
|
|
FRunErrorBreak: TlldbInternalBreakPoint;
|
|
FExceptionBreak: TlldbInternalBreakPoint;
|
|
FPopExceptStack, FCatchesBreak, FReRaiseBreak: TlldbInternalBreakPoint;
|
|
FTargetWidth: Byte;
|
|
FTargetRegisters: array[0..2] of String;
|
|
FLldbMissingBreakSetDisable: Boolean;
|
|
FExceptionInfo: record
|
|
FReg0Cmd, FReg2Cmd, FExceptClassCmd, FExceptMsgCmd: String;
|
|
FAtExcepiton: Boolean; // cleared in Setstate
|
|
end;
|
|
(* DoAfterLineReceived is called after DebugInstruction.ProcessInputFromDbg
|
|
(but not if ProcessInputFromDbg already handled the Line)
|
|
DoAfterLineReceived will first call CommandQueue.DoLineDataReceived
|
|
*)
|
|
procedure DoAfterLineReceived(var ALine: String); //
|
|
procedure DoBeforeLineReceived(var ALine: String); // Before DebugInstruction.ProcessInputFromDbg
|
|
procedure DoCmdLineDebuggerTerminated(Sender: TObject);
|
|
procedure DoLineSentToDbg(Sender: TObject; ALine: String);
|
|
|
|
function LldbRun: Boolean;
|
|
function LldbStep(AStepAction: TLldbInstructionProcessStepAction): Boolean;
|
|
function LldbStop: Boolean;
|
|
function LldbPause: Boolean;
|
|
function LldbEvaluate(const AExpression: String; EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
|
|
function LldbEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
|
|
procedure TerminateLldb; // Kills external debugger
|
|
protected
|
|
procedure DoBeforeLaunch; virtual;
|
|
procedure DoAfterLaunch(var LaunchWarnings: string); virtual;
|
|
procedure DoBeginReceivingLines(Sender: TObject);
|
|
procedure DoEndReceivingLines(Sender: TObject);
|
|
procedure LockRelease; override;
|
|
procedure UnlockRelease; override;
|
|
procedure QueueCommand(const ACommand: TLldbDebuggerCommand);
|
|
procedure DoState(const OldState: TDBGState); override;
|
|
//procedure DoBeforeState(const OldState: TDBGState); override;
|
|
procedure SetErrorState(const AMsg: String; const AInfo: String = '');
|
|
function DoExceptionHit(AExcClass, AExcMsg: String): Boolean;
|
|
function DoBreakpointHit(BrkId: Integer): Boolean;
|
|
|
|
property CurrentThreadId: Integer read FCurrentThreadId;
|
|
property CurrentStackFrame: Integer read FCurrentStackFrame;
|
|
property CurrentLocation: TDBGLocationRec read FCurrentLocation;
|
|
property DebugInstructionQueue: TLldbInstructionQueue read FDebugInstructionQueue;
|
|
property CommandQueue: TLldbDebuggerCommandQueue read FCommandQueue;
|
|
protected
|
|
function CreateBreakPoints: TDBGBreakPoints; override;
|
|
function CreateLocals: TLocalsSupplier; override;
|
|
//function CreateLineInfo: TDBGLineInfo; override;
|
|
function CreateRegisters: TRegisterSupplier; override;
|
|
function CreateCallStack: TCallStackSupplier; override;
|
|
//function CreateDisassembler: TDBGDisassembler; override;
|
|
function CreateWatches: TWatchesSupplier; override;
|
|
function CreateThreads: TThreadsSupplier; override;
|
|
function GetTargetWidth: Byte; override;
|
|
|
|
function GetIsIdle: Boolean; override;
|
|
class function GetSupportedCommands: TDBGCommands; override;
|
|
//function GetCommands: TDBGCommands; override;
|
|
function RequestCommand(const ACommand: TDBGCommand;
|
|
const AParams: array of const;
|
|
const ACallback: TMethod): Boolean; override;
|
|
public
|
|
class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
|
|
class function Caption: String; override;
|
|
class function ExePaths: String; override;
|
|
class function ExePathsMruGroup: TDebuggerClass; override;
|
|
|
|
constructor Create(const AExternalDebugger: String); override;
|
|
destructor Destroy; override;
|
|
procedure Init; override; // Initializes external debugger
|
|
procedure Done; override; // Kills external debugger
|
|
|
|
class function RequiredCompilerOpts(ATargetCPU, ATargetOS: String
|
|
): TDebugCompilerRequirements; override;
|
|
function GetLocation: TDBGLocationRec; override;
|
|
// function GetProcessList({%H-}AList: TRunningProcessInfoList): boolean; override;
|
|
function NeedReset: Boolean; override;
|
|
procedure TestCmd(const ACommand: String); override;
|
|
end;
|
|
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
var
|
|
DBG_VERBOSE: PLazLoggerLogGroup;
|
|
|
|
type
|
|
|
|
{%region
|
|
*****
|
|
***** Threads
|
|
***** }
|
|
|
|
{ TLldbDebuggerCommandThreads }
|
|
|
|
TLldbDebuggerCommandThreads = class(TLldbDebuggerCommand)
|
|
private
|
|
procedure ThreadInstructionSucceeded(Sender: TObject);
|
|
protected
|
|
constructor Create(AOwner: TLldbDebugger);
|
|
procedure DoExecute; override;
|
|
end;
|
|
|
|
{ TLldbThreads }
|
|
|
|
TLldbThreads = class(TThreadsSupplier)
|
|
private
|
|
FThreadFramePointers: Array of TDBGPtr;
|
|
function GetDebugger: TLldbDebugger;
|
|
protected
|
|
procedure DoStateEnterPause; override;
|
|
procedure ReadFromThreadInstruction(Instr: TLldbInstructionThreadList; ACurrentId: Integer = -1);
|
|
public
|
|
procedure RequestMasterData; override;
|
|
procedure ChangeCurrentThread(ANewId: Integer); override;
|
|
function GetFramePointerForThread(AnId: Integer): TDBGPtr;
|
|
property Debugger: TLldbDebugger read GetDebugger;
|
|
end;
|
|
|
|
{%endregion ^^^^^ Threads ^^^^^ }
|
|
|
|
{%region
|
|
*****
|
|
***** CallStack
|
|
***** }
|
|
|
|
{ TLldbDebuggerCommandCallStack }
|
|
|
|
TLldbDebuggerCommandCallStack = class(TLldbDebuggerCommand)
|
|
private
|
|
FCurrentCallStack: TCallStackBase;
|
|
procedure DoCallstackFreed(Sender: TObject);
|
|
procedure StackInstructionFinished(Sender: TObject);
|
|
protected
|
|
procedure DoExecute; override;
|
|
public
|
|
constructor Create(AOwner: TLldbDebugger; ACurrentCallStack: TCallStackBase);
|
|
destructor Destroy; override;
|
|
property CurrentCallStack: TCallStackBase read FCurrentCallStack;
|
|
end;
|
|
|
|
{ TLldbCallStack }
|
|
|
|
TLldbCallStack = class(TCallStackSupplier)
|
|
protected
|
|
//procedure Clear;
|
|
procedure DoThreadChanged;
|
|
procedure ParentRequestEntries(ACallstack: TCallStackBase);
|
|
public
|
|
procedure RequestAtLeastCount(ACallstack: TCallStackBase;
|
|
ARequiredMinCount: Integer); override;
|
|
procedure UpdateCurrentIndex; override;
|
|
procedure RequestCurrent(ACallstack: TCallStackBase); override;
|
|
procedure RequestEntries(ACallstack: TCallStackBase); override;
|
|
end;
|
|
|
|
{%endregion ^^^^^ CallStack ^^^^^ }
|
|
|
|
{%region
|
|
*****
|
|
***** Locals
|
|
***** }
|
|
|
|
{ TLldbLocals }
|
|
|
|
TLldbLocals = class(TLocalsSupplier)
|
|
public
|
|
procedure RequestData(ALocals: TLocals); override;
|
|
end;
|
|
|
|
{%endregion ^^^^^ Locals ^^^^^ }
|
|
|
|
{%region
|
|
*****
|
|
***** Watches
|
|
***** }
|
|
|
|
{ TLldbWatches }
|
|
|
|
TLldbWatches = class(TWatchesSupplier)
|
|
private
|
|
protected
|
|
procedure InternalRequestData(AWatchValue: TWatchValue); override;
|
|
public
|
|
end;
|
|
|
|
{%endregion ^^^^^ Watches ^^^^^ }
|
|
|
|
{%region
|
|
*****
|
|
***** BreakPoint
|
|
***** }
|
|
|
|
{ TLldbBreakPoint }
|
|
|
|
TLldbBreakPoint = class(TDBGBreakPoint)
|
|
private
|
|
FBreakID: Integer;
|
|
FCurrentInstruction: TLldbInstruction;
|
|
FNeededChanges: TDbgBpChangeIndicators;
|
|
procedure InstructionSetBreakFinished(Sender: TObject);
|
|
procedure InstructionUpdateBreakFinished(Sender: TObject);
|
|
procedure SetBreakPoint;
|
|
procedure ReleaseBreakPoint;
|
|
procedure UpdateProperties(AChanged: TDbgBpChangeIndicators);
|
|
procedure DoCurrentInstructionFinished;
|
|
procedure CancelCurrentInstruction;
|
|
protected
|
|
procedure DoStateChange(const AOldState: TDBGState); override;
|
|
procedure DoPropertiesChanged(AChanged: TDbgBpChangeIndicators); override;
|
|
public
|
|
// constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
// procedure DoLogExpression(const AnExpression: String); override;
|
|
end;
|
|
|
|
{ TLldbBreakPoints }
|
|
|
|
TLldbBreakPoints = class(TDBGBreakPoints)
|
|
protected
|
|
function FindById(AnId: Integer): TLldbBreakPoint;
|
|
end;
|
|
|
|
{%endregion ^^^^^ BreakPoint ^^^^^ }
|
|
|
|
{%region
|
|
*****
|
|
***** Register
|
|
***** }
|
|
|
|
{ TLldbRegisterSupplier }
|
|
|
|
TLldbRegisterSupplier = class(TRegisterSupplier)
|
|
public
|
|
procedure Changed;
|
|
procedure RequestData(ARegisters: TRegisters); override;
|
|
end;
|
|
|
|
{ TLldbDebuggerProperties }
|
|
|
|
constructor TLldbDebuggerProperties.Create;
|
|
begin
|
|
inherited Create;
|
|
FLaunchNewTerminal := False;
|
|
FSkipGDBDetection := False;
|
|
FIgnoreLaunchWarnings := False;
|
|
end;
|
|
|
|
procedure TLldbDebuggerProperties.Assign(Source: TPersistent);
|
|
begin
|
|
inherited Assign(Source);
|
|
if Source is TLldbDebuggerProperties then begin
|
|
FLaunchNewTerminal := TLldbDebuggerProperties(Source).FLaunchNewTerminal;
|
|
FSkipGDBDetection := TLldbDebuggerProperties(Source).FSkipGDBDetection;
|
|
FIgnoreLaunchWarnings := TLldbDebuggerProperties(Source).FIgnoreLaunchWarnings;
|
|
end;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandRun }
|
|
|
|
procedure TLldbDebuggerCommandRun.CatchesStackInstructionFinished(Sender: TObject);
|
|
var
|
|
Instr: TLldbInstruction;
|
|
r: TStringArray;
|
|
Id, line: Integer;
|
|
IsCur: Boolean;
|
|
addr, stack, frame: TDBGPtr;
|
|
func, filename, fullfile, d: String;
|
|
Arguments: TStringList;
|
|
begin
|
|
r := TLldbInstructionStackTrace(Sender).Res;
|
|
if Length(r) < 1 then begin
|
|
SetDebuggerState(dsPause);
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
ParseNewFrameLocation(r[0], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
|
|
Arguments.Free;
|
|
if addr = 0 then begin
|
|
SetDebuggerState(dsPause);
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
if FMode = cmRunToTmpBrk then begin
|
|
if (FFramesDescending and (frame > FFramePtrAtStart)) or
|
|
((not FFramesDescending) and (frame < FFramePtrAtStart))
|
|
then begin
|
|
ResetStateToRun;
|
|
SetNextStepCommand(saContinue);
|
|
exit;
|
|
end;
|
|
DeleteTempBreakPoint; // except stepped out below temp brkpoint
|
|
end;
|
|
|
|
|
|
SetTempBreakPoint(Addr);
|
|
ResetStateToRun;
|
|
FMode := cmRunAfterCatch;
|
|
SetNextStepCommand(saContinue);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.TempBreakPointSet(Sender: TObject);
|
|
begin
|
|
FTmpBreakId := TLldbInstructionBreakSet(Sender).BreakId;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.SearchFpStackInstructionFinished(
|
|
Sender: TObject);
|
|
var
|
|
r: TStringArray;
|
|
fr: Integer;
|
|
Id, line: Integer;
|
|
IsCur: Boolean;
|
|
addr, stack, frame, prev: TDBGPtr;
|
|
func, filename, fullfile, d: String;
|
|
Arguments: TStringList;
|
|
begin
|
|
r := TLldbInstructionStackTrace(Sender).Res;
|
|
if Length(r) < 1 then begin
|
|
SetDebuggerState(dsPause);
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
fr := 0;
|
|
prev := 0;
|
|
repeat
|
|
ParseNewFrameLocation(r[fr], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
|
|
Arguments.Free;
|
|
|
|
if fr = 0 then begin
|
|
FFramesDescending := frame > FFramePtrAtStart;
|
|
if (FState = crStoppedRaise) and (Length(r) >= 2) then begin
|
|
inc(fr);
|
|
Continue;
|
|
end;
|
|
end;
|
|
|
|
if not( (frame = 0) or ((fr > 0) and (frame = {%H-}prev)) ) then begin
|
|
|
|
if frame = FFramePtrAtStart then
|
|
break;
|
|
|
|
if (prev <> 0) and (
|
|
( (fr < prev) and not(FFramePtrAtStart < fr) ) or
|
|
( (fr > prev) and not(FFramePtrAtStart > fr) )
|
|
)
|
|
then begin
|
|
SetDebuggerState(dsPause);
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
prev := frame;
|
|
end;
|
|
inc(fr);
|
|
until fr >= Length(r);
|
|
|
|
if (fr >= Length(r)) or (addr = 0) then begin
|
|
SetDebuggerState(dsPause);
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
SetTempBreakPoint(Addr);
|
|
ResetStateToRun;
|
|
FMode := cmRunToTmpBrk;
|
|
SetNextStepCommand(saContinue);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.SearchExceptFpStackInstructionFinished(
|
|
Sender: TObject);
|
|
var
|
|
r: TStringArray;
|
|
fr: Integer;
|
|
Id, line: Integer;
|
|
IsCur: Boolean;
|
|
addr, stack, frame: TDBGPtr;
|
|
func, filename, fullfile, d: String;
|
|
Arguments: TStringList;
|
|
begin
|
|
r := TLldbInstructionStackTrace(Sender).Res;
|
|
if Length(r) < 2 then begin
|
|
SetDebuggerState(dsPause);
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
fr := 1;
|
|
repeat
|
|
ParseNewFrameLocation(r[fr], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
|
|
Arguments.Free;
|
|
|
|
if frame = FCurrentExceptionInfo.FFramePtr then begin
|
|
SetDebuggerLocation(Addr, Frame, Func, filename, FullFile, Line);
|
|
break;
|
|
end;
|
|
|
|
inc(fr);
|
|
until fr >= Length(r);
|
|
|
|
SetDebuggerState(dsPause);
|
|
Debugger.DoCurrent(Debugger.FCurrentLocation);
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.ThreadInstructionSucceeded(Sender: TObject);
|
|
begin
|
|
FState := crStopped;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.ExceptionReadReg0Success(Sender: TObject);
|
|
var
|
|
v: String;
|
|
i: SizeInt;
|
|
begin
|
|
v := TLldbInstructionReadExpression(Sender).Res;
|
|
i := pos(' = ', v);
|
|
if i > 1 then
|
|
delete(v, 1, i+2);
|
|
FCurrentExceptionInfo.FObjAddress := StrToInt64Def(v, 0);
|
|
Include(FCurrentExceptionInfo.FHasCommandData, exiReg0);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.ExceptionReadReg2Success(Sender: TObject);
|
|
var
|
|
v: String;
|
|
i: SizeInt;
|
|
begin
|
|
v := TLldbInstructionReadExpression(Sender).Res;
|
|
i := pos(' = ', v);
|
|
if i > 1 then
|
|
delete(v, 1, i+2);
|
|
FCurrentExceptionInfo.FFramePtr := StrToInt64Def(v, 0);
|
|
Include(FCurrentExceptionInfo.FHasCommandData, exiReg2);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.ExceptionReadClassSuccess(Sender: TObject);
|
|
var
|
|
s: String;
|
|
i: SizeInt;
|
|
l: Integer;
|
|
begin
|
|
// (char * ) $2 = 0x005c18d0 "\tException"
|
|
// (char *) $10 = 0x00652d44 "\x04TXXX"
|
|
s := TLldbInstructionReadExpression(Sender).Res;
|
|
i := pos('"', s);
|
|
l := 255;
|
|
if i > 0 then begin
|
|
if s[i+1] = '\' then begin
|
|
inc(i, 2);
|
|
if s[i] = 'x' then begin
|
|
l := StrToIntDef('$'+copy(s, i+1, 2), 255);
|
|
inc(i, 2);
|
|
end
|
|
else begin
|
|
case s[i] of
|
|
'a': l := 7;
|
|
'b': l := 8;
|
|
't': l := 9;
|
|
'n': l := 10;
|
|
'v': l := 11;
|
|
'f': l := 12;
|
|
'r': l := 13;
|
|
'e': l := 27;
|
|
's': l := 32;
|
|
'\': l := 92;
|
|
'd': l := 127;
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
inc(i, 1);
|
|
l := ord(s[i]);
|
|
end;
|
|
s := copy(s, i+1, Min(l, Length(s)-i-1));
|
|
end;
|
|
FCurrentExceptionInfo.FExceptClass := s;
|
|
Include(FCurrentExceptionInfo.FHasCommandData, exiClass);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.ExceptionReadMsgSuccess(Sender: TObject);
|
|
var
|
|
s: String;
|
|
i: SizeInt;
|
|
begin
|
|
s := TLldbInstructionReadExpression(Sender).Res;
|
|
i := pos('"', s);
|
|
if i > 0 then
|
|
s := copy(s, i+1, Length(s)-i-1);
|
|
FCurrentExceptionInfo.FExceptMsg := s;
|
|
Include(FCurrentExceptionInfo.FHasCommandData, exiMsg);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.DoLineDataReceived(var ALine: String);
|
|
const
|
|
MaxStackSearch = 99;
|
|
|
|
procedure ContinueRunning;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
if FStepAction = saContinue then begin
|
|
DeleteTempBreakPoint;
|
|
ResetStateToRun;
|
|
FMode := cmRun;
|
|
SetNextStepCommand(saContinue);
|
|
exit;
|
|
end;
|
|
|
|
if FFramePtrAtStart = 0 then begin
|
|
SetDebuggerState(dsPause);
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
if FTmpBreakId = 0 then begin
|
|
FMode := cmRunToTmpBrk;
|
|
FState := crRunning; // Ignore the STEP 3 / frame
|
|
Instr := TLldbInstructionStackTrace.Create(MaxStackSearch, 0, Debugger.FCurrentThreadId);
|
|
Instr.OnFinish := @SearchFpStackInstructionFinished;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
exit;
|
|
end;
|
|
|
|
ResetStateToRun;
|
|
FMode := cmRunToTmpBrk;
|
|
SetNextStepCommand(saContinue);
|
|
|
|
//case FStepAction of
|
|
// saInsIn: SetDebuggerState(dsPause);
|
|
// saInsOver, saOver: ;
|
|
// saInto: ;
|
|
// saOut: ;
|
|
//end;
|
|
end;
|
|
|
|
function GetBreakPointId(AReason: String): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := pos('.', AReason);
|
|
if i = 0 then i := Length(AReason)+1;
|
|
Result := StrToIntDef(copy(AReason, 12, i-12), -1);
|
|
debugln(DBG_VERBOSE, ['DoBreakPointHit ', AReason, ' / ', Result]);
|
|
end;
|
|
|
|
procedure DoException;
|
|
var
|
|
ExcClass, ExcMsg: String;
|
|
CanContinue: Boolean;
|
|
Instr: TLldbInstructionStackTrace;
|
|
ExceptItem: TBaseException;
|
|
begin
|
|
if exiClass in FCurrentExceptionInfo.FHasCommandData then
|
|
ExcClass := FCurrentExceptionInfo.FExceptClass
|
|
else
|
|
ExcClass := '<Unknown Class>'; // TODO: move to IDE
|
|
if exiMsg in FCurrentExceptionInfo.FHasCommandData then
|
|
ExcMsg := FCurrentExceptionInfo.FExceptMsg
|
|
else
|
|
ExcMsg := '<Unknown Message>'; // TODO: move to IDE
|
|
|
|
ExceptItem := Debugger.Exceptions.Find(ExcClass);
|
|
if (ExceptItem <> nil) and (ExceptItem.Enabled)
|
|
then begin
|
|
FState := crStoppedRaise;
|
|
ContinueRunning;
|
|
exit;
|
|
end;
|
|
|
|
CanContinue := Debugger.DoExceptionHit(ExcClass, ExcMsg);
|
|
|
|
if CanContinue then begin
|
|
FState := crStoppedRaise;
|
|
ContinueRunning;
|
|
exit;
|
|
end
|
|
else begin
|
|
Debugger.FExceptionInfo.FAtExcepiton := True;
|
|
|
|
if (exiReg2 in FCurrentExceptionInfo.FHasCommandData) and (FCurrentExceptionInfo.FFramePtr <> 0) then begin
|
|
FState := crRunning; // ensure command is not finished early
|
|
Instr := TLldbInstructionStackTrace.Create(MaxStackSearch, 0, Debugger.FCurrentThreadId);
|
|
Instr.OnFinish := @SearchExceptFpStackInstructionFinished;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
exit;
|
|
end;
|
|
|
|
Debugger.FCurrentLocation.SrcLine := -1;
|
|
SetDebuggerState(dsPause); // after GetLocation => dsPause may run stack, watches etc
|
|
end;
|
|
end;
|
|
|
|
procedure DoRunError;
|
|
var
|
|
CanContinue: Boolean;
|
|
ErrNo: Integer;
|
|
ExceptName: String;
|
|
ExceptItem: TBaseException;
|
|
begin
|
|
ErrNo := 0;
|
|
if exiReg0 in FCurrentExceptionInfo.FHasCommandData then
|
|
ErrNo := FCurrentExceptionInfo.FObjAddress;
|
|
ErrNo := ErrNo and $FFFF;
|
|
|
|
ExceptName := Format('RunError(%d)', [ErrNo]);
|
|
ExceptItem := Debugger.Exceptions.Find(ExceptName);
|
|
if (ExceptItem <> nil) and (ExceptItem.Enabled)
|
|
then begin
|
|
FState := crStoppedRaise;
|
|
ContinueRunning;
|
|
exit;
|
|
end;
|
|
|
|
Debugger.DoException(deRunError, ExceptName, Debugger.FCurrentLocation, Debugger.RunErrorText[ErrNo], CanContinue);
|
|
if CanContinue
|
|
then begin
|
|
FState := crStoppedRaise;
|
|
ContinueRunning;
|
|
exit;
|
|
end;
|
|
|
|
SetDebuggerState(dsPause); // after GetLocation => dsPause may run stack, watches etc
|
|
end;
|
|
|
|
procedure DoUnknownStopReason(AStopReason: String);
|
|
var
|
|
CanContinue: Boolean;
|
|
begin
|
|
Debugger.DoException(deExternal, Format('Debugger stopped with reason: %s', [AStopReason]), Debugger.FCurrentLocation, '', CanContinue);
|
|
|
|
SetDebuggerState(dsPause); // after GetLocation => dsPause may run stack, watches etc
|
|
end;
|
|
|
|
procedure DoCatchesHit;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
FState := crRunning; // Ignore the STEP 3 / frame
|
|
Instr := TLldbInstructionStackTrace.Create(1, 1, Debugger.FCurrentThreadId);
|
|
Instr.OnFinish := @CatchesStackInstructionFinished;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
procedure DoStopTemp;
|
|
begin
|
|
if (FMode in [cmRunAfterCatch, cmRunToTmpBrk]) and (Debugger.FCurrentLocation.SrcLine = 0) then begin
|
|
DeleteTempBreakPoint;
|
|
ResetStateToRun;
|
|
FMode := cmRun;
|
|
SetNextStepCommand(saOver);
|
|
exit;
|
|
end;
|
|
|
|
SetDebuggerState(dsPause);
|
|
end;
|
|
|
|
procedure DoBreakPointHit(BrkId: Integer);
|
|
var
|
|
BreakPoint: TLldbBreakPoint;
|
|
CanContinue: Boolean;
|
|
begin
|
|
CanContinue := Debugger.DoBreakpointHit(BrkId);
|
|
|
|
if CanContinue
|
|
then begin
|
|
// Important trigger State => as snapshot is taken in TDebugManager.DebuggerChangeState
|
|
SetDebuggerState(dsInternalPause); // TODO: need location?
|
|
ContinueRunning;
|
|
end
|
|
else begin
|
|
SetDebuggerState(dsPause);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Instr: TLldbInstruction;
|
|
found: TStringArray;
|
|
AnId, SrcLine, i: Integer;
|
|
AnIsCurrent: Boolean;
|
|
AnAddr, stack, frame: TDBGPtr;
|
|
AFuncName, AFile, AReminder, AFullFile, s, Name: String;
|
|
AnArgs: TStringList;
|
|
begin
|
|
(* When the debuggee stops (pause), the following will be received:
|
|
// for EXCEPTIONS ONLY (less the spaces between * ) )
|
|
p/x $eax
|
|
(unsigned int) $1 = 0x04dfd920
|
|
p ((char *** )$eax)[0][3]
|
|
(char * ) $2 = 0x005c18d0 "\tException"
|
|
p ((char ** )$eax)[1]
|
|
(char * ) $3 = 0x00000000 <no value available>
|
|
|
|
// Hit breakpoint
|
|
Process 10992 stopped
|
|
// thread list => but thread ID may be wrong (maybe look for "reason", instead of leading *
|
|
* thread #1: tid=0x1644: 0x00409e91, 0x0158FF38, 0x0158FF50 &&//FULL: \FPC\SVN\fixes_3_0\rtl\win32\..\inc\except.inc &&//SHORT: except.inc &&//LINE: 185 &&//MOD: project1.exe &&//FUNC: fpc_raiseexception(OBJ=0x038f5a90, ANADDR=0x00401601, AFRAME=0x0158ff58) <<&&//FRAME"
|
|
thread #2: tid=0x27bc: 0x77abf8dc, 0x0557FE64, 0x0557FEC8 &&//FULL: &&//SHORT: &&//LINE: &&//MOD: ntdll.dll &&//FUNC: NtDelayExecution <<&&//FRAME"
|
|
Process 10992 stopped
|
|
// thread (correct) and frame
|
|
* thread #1, stop reason = breakpoint 6.1
|
|
frame #0: 0x0042b855 &&//FULL: \tmp\New Folder (2)\unit1.pas &&//SHORT: unit1.pas &&//LINE: 54 &&//MOD: project1.exe &&//FUNC: FORMCREATE(this=0x04c81248, SENDER=0x04c81248) <<&&//FRAME
|
|
... stop reason = Exception 0xc0000005 encountered at address 0x42e067
|
|
... stop reason = EXC_BAD_ACCESS (code=1, address=0x4)
|
|
... stop reason = step over
|
|
... stop reason = step in
|
|
... stop reason = instruction step over
|
|
... google stop reason = signal / trace / watchpoint
|
|
*)
|
|
|
|
{%region exception }
|
|
s := TrimLeft(ALine);
|
|
Instr := nil;
|
|
if StrStartsWith(s, Debugger.FExceptionInfo.FReg0Cmd, True) then begin
|
|
Instr := TLldbInstructionReadExpression.Create;
|
|
Instr.OnSuccess := @ExceptionReadReg0Success;
|
|
end
|
|
else
|
|
if StrStartsWith(s, Debugger.FExceptionInfo.FReg2Cmd, True) then begin
|
|
Instr := TLldbInstructionReadExpression.Create;
|
|
Instr.OnSuccess := @ExceptionReadReg2Success;
|
|
end
|
|
else
|
|
if StrStartsWith(s, Debugger.FExceptionInfo.FExceptClassCmd, True) then begin
|
|
Instr := TLldbInstructionReadExpression.Create;
|
|
Instr.OnSuccess := @ExceptionReadClassSuccess;
|
|
end
|
|
else
|
|
if StrStartsWith(s, Debugger.FExceptionInfo.FExceptMsgCmd, True) then begin
|
|
Instr := TLldbInstructionReadExpression.Create;
|
|
Instr.OnSuccess := @ExceptionReadMsgSuccess;
|
|
end;
|
|
|
|
if Instr <> nil then begin
|
|
ALine := '';
|
|
debugln(DBG_VERBOSE, ['Reading exception info']);
|
|
assert(InstructionQueue.RunningInstruction = nil, 'InstructionQueue.RunningInstruction = nil');
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
exit;
|
|
end;
|
|
{%endregion exception }
|
|
|
|
// STEP 1: Process 10992 stopped
|
|
if (FState = crRunning) and StrMatches(ALine, ['Process ', 'stopped']) then begin
|
|
FState := crReadingThreads;
|
|
debugln(DBG_VERBOSE, ['Reading thread info']);
|
|
FThreadInstr := TLldbInstructionThreadListReader.Create();
|
|
FThreadInstr.OnSuccess := @ThreadInstructionSucceeded;
|
|
QueueInstruction(FThreadInstr);
|
|
exit;
|
|
end;
|
|
|
|
// STEP 2: * thread #1, stop reason = breakpoint 6.1
|
|
if StrMatches(ALine, ['* thread #', ', stop reason = ', ''], found) then begin
|
|
FState := crStopped;
|
|
debugln(DBG_VERBOSE, ['Reading stopped thread']);
|
|
SetDebuggerLocation(0, 0, '', '', '', 0);
|
|
if StrStartsWith(found[1], 'breakpoint ') then begin
|
|
FCurBrkId := GetBreakPointId(found[1])
|
|
//end else
|
|
//if StrStartsWith(found[1], 'watchpoint ') then begin
|
|
end else begin
|
|
FUnknownStopReason := '';
|
|
if not( ( StrStartsWith(found[1], 'step ') or StrStartsWith(found[1], 'instruction step ') ) and
|
|
( StrContains(found[1], ' in') or StrContains(found[1], ' over') or StrContains(found[1], ' out') )
|
|
)
|
|
then
|
|
FUnknownStopReason := found[1];
|
|
|
|
FCurBrkId := -1;
|
|
end;
|
|
|
|
ParseNewThreadLocation(ALine, AnId, AnIsCurrent, Name, AnAddr,
|
|
Stack, Frame, AFuncName, AnArgs, AFile, AFullFile, SrcLine, AReminder);
|
|
AnArgs.Free;
|
|
|
|
Debugger.FCurrentThreadId := AnId;
|
|
Debugger.FCurrentStackFrame := 0;
|
|
SetDebuggerLocation(AnAddr, Frame, AFuncName, AFile, AFullFile, SrcLine);
|
|
|
|
InstructionQueue.SetKnownThreadAndFrame(Debugger.FCurrentThreadId, 0);
|
|
Debugger.Threads.CurrentThreads.CurrentThreadId := Debugger.FCurrentThreadId; // set again from thread list
|
|
|
|
if StrStartsWith(found[1], 'breakpoint ') then begin
|
|
if FCurBrkId = Debugger.FExceptionBreak.BreakId then
|
|
DoException
|
|
else
|
|
if FCurBrkId = Debugger.FRunErrorBreak.BreakId then
|
|
DoRunError // location = frame with fp // see gdbmi
|
|
else
|
|
if FCurBrkId = Debugger.FBreakErrorBreak.BreakId then
|
|
DoRunError // location = frame(1) // see gdbmi
|
|
else
|
|
if (FCurBrkId = Debugger.FCatchesBreak.BreakId) or
|
|
(FCurBrkId = Debugger.FPopExceptStack.BreakId)
|
|
then
|
|
DoCatchesHit
|
|
else
|
|
if FCurBrkId = Debugger.FReRaiseBreak.BreakId then begin
|
|
FState := crStoppedRaise;
|
|
ContinueRunning;
|
|
end
|
|
else
|
|
if FCurBrkId = FTmpBreakId then
|
|
DoStopTemp
|
|
else
|
|
DoBreakPointHit(FCurBrkId);
|
|
end
|
|
else
|
|
if FUnknownStopReason <> '' then begin
|
|
DoUnknownStopReason(FUnknownStopReason);
|
|
end
|
|
else
|
|
SetDebuggerState(dsPause);
|
|
|
|
if (FState = crRunning) then
|
|
exit;
|
|
|
|
if DebuggerState in [dsPause, dsInternalPause, dsStop] then
|
|
Debugger.DoCurrent(Debugger.FCurrentLocation);
|
|
FState := crDone;
|
|
ALine := '';
|
|
|
|
exit;
|
|
end;
|
|
|
|
if (FState = crRunning) then
|
|
exit;
|
|
|
|
// STEP 3: frame #0: 0x0042b855 &&//FULL: \tmp\New Folder (2)\unit1.pas &&//SHORT: unit1.pas &&//LINE: 54 &&//MOD: project1.exe &&//FUNC: FORMCREATE(this=0x04c81248, SENDER=0x04c81248) <<&&//FRAME
|
|
if ParseNewFrameLocation(ALine, AnId, AnIsCurrent, AnAddr, stack, frame, AFuncName, AnArgs,
|
|
AFile, AFullFile, SrcLine, AReminder)
|
|
then begin
|
|
AnArgs.Free;
|
|
if FState = crReadingThreads then begin
|
|
FState := crStopped;
|
|
// did not execute "thread list" / thread cmd reader has read "stop reason"
|
|
for i := 0 to length(FThreadInstr.Res) - 1 do
|
|
DoLineDataReceived(FThreadInstr.Res[i]);
|
|
end;
|
|
|
|
DeleteTempBreakPoint;
|
|
Finished;
|
|
end;
|
|
|
|
if (LeftStr(ALine, 8) = 'Process ') and (pos('exited with status = ', ALine) > 0) then begin
|
|
DeleteTempBreakPoint;
|
|
Finished;
|
|
exit; // handle in main debugger
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.DoCancel;
|
|
begin
|
|
InstructionQueue.CancelAllForCommand(Self); // in case there still are any
|
|
DeleteTempBreakPoint;
|
|
// Must not call Finished; => would cancel DeleteTempBreakPoint;
|
|
if CommandQueue.RunningCommand = Self then
|
|
CommandQueue.CommandFinished(Self);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.DoExecute;
|
|
begin
|
|
if FWaitToResume then
|
|
ResumeWithNextStepCommand
|
|
else
|
|
DoInitialExecute;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.RunInstructionSucceeded(AnInstruction: TObject
|
|
);
|
|
begin
|
|
FCurrentExceptionInfo.FHasCommandData := [];
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.ResetStateToRun;
|
|
begin
|
|
FState := crRunning;
|
|
FCurBrkId := 0;
|
|
if FThreadInstr <> nil then begin
|
|
FThreadInstr.ReleaseReference;
|
|
FThreadInstr := nil;
|
|
end;
|
|
FCurrentExceptionInfo.FHasCommandData := [];
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.SetNextStepCommand(
|
|
AStepAction: TLldbInstructionProcessStepAction);
|
|
begin
|
|
FNextStepAction := AStepAction;
|
|
{$IFDEF LLDB_SKIP_SNAP}
|
|
ResumeWithNextStepCommand;
|
|
exit;
|
|
{$ENDIF}
|
|
FWaitToResume := True;
|
|
|
|
// Run the queue, before continue
|
|
CommandQueue.QueueCommand(Self);
|
|
CommandQueue.CommandFinished(Self);
|
|
//CommandQueue.FRunningCommand := nil;
|
|
//CommandQueue.Run;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.ResumeWithNextStepCommand;
|
|
var
|
|
Instr: TLldbInstructionProcessStep;
|
|
begin
|
|
if FNextStepAction in [saOver, saInto, saOut, saInsOver] then
|
|
Debugger.FReRaiseBreak.Enable
|
|
else
|
|
Debugger.FReRaiseBreak.Disable;
|
|
|
|
if FMode in [cmRunToCatch, cmRunToTmpBrk] then begin
|
|
Debugger.FCatchesBreak.Enable;
|
|
Debugger.FPopExceptStack.Enable;
|
|
Instr := TLldbInstructionProcessStep.Create(saContinue);
|
|
end
|
|
else begin
|
|
Debugger.FCatchesBreak.Disable;
|
|
Debugger.FPopExceptStack.Disable;
|
|
Instr := TLldbInstructionProcessStep.Create(FNextStepAction, Debugger.FCurrentThreadId);
|
|
end;
|
|
Instr.OnFinish := @RunInstructionSucceeded;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
if DebuggerState <> dsRun then
|
|
SetDebuggerState(dsRun);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.SetTempBreakPoint(AnAddr: TDBGPtr);
|
|
var
|
|
Instr: TLldbInstructionBreakSet;
|
|
begin
|
|
Instr := TLldbInstructionBreakSet.Create(AnAddr);
|
|
Instr.OnFinish := @TempBreakPointSet;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.DeleteTempBreakPoint;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
if FTmpBreakId = 0 then
|
|
exit;
|
|
Instr := TLldbInstructionBreakDelete.Create(FTmpBreakId);
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
FTmpBreakId := 0;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRun.SetDebuggerLocation(AnAddr, AFrame: TDBGPtr;
|
|
AFuncName, AFile, AFullFile: String; SrcLine: integer);
|
|
begin
|
|
Debugger.FCurrentThreadFramePtr := AFrame;
|
|
Debugger.FCurrentLocation.Address := AnAddr;
|
|
Debugger.FCurrentLocation.FuncName := AFuncName;
|
|
Debugger.FCurrentLocation.SrcFile := AFile;
|
|
Debugger.FCurrentLocation.SrcFullName := AFullFile;
|
|
Debugger.FCurrentLocation.SrcLine := SrcLine;
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandRun.Create(AOwner: TLldbDebugger);
|
|
begin
|
|
AOwner.FExceptionInfo.FAtExcepiton := False;
|
|
FState := crRunning;
|
|
FMode := cmRun;
|
|
FFramePtrAtStart := AOwner.FCurrentThreadFramePtr;
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
destructor TLldbDebuggerCommandRun.Destroy;
|
|
begin
|
|
FThreadInstr.ReleaseReference;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandLocals }
|
|
|
|
procedure TLldbDebuggerCommandLocals.LocalsInstructionFinished(Sender: TObject
|
|
);
|
|
var
|
|
n: String;
|
|
i: Integer;
|
|
begin
|
|
if FLocals <> nil then begin
|
|
FLocals.Clear;
|
|
for i := 0 to FLocalsInstr.Res.Count - 1 do begin
|
|
n := FLocalsInstr.Res.Names[i];
|
|
FLocals.Add(n, FLocalsInstr.Res.Values[n]);
|
|
end;
|
|
FLocals.SetDataValidity(ddsValid);
|
|
end;
|
|
|
|
ReleaseRefAndNil(FLocalsInstr);
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandLocals.DoLocalsFreed(Sender: TObject);
|
|
begin
|
|
FLocals := nil;
|
|
if FLocalsInstr <> nil then begin
|
|
FLocalsInstr.OnFinish := nil;
|
|
FLocalsInstr.Cancel;
|
|
ReleaseRefAndNil(FLocalsInstr);
|
|
Finished;
|
|
end;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandLocals.DoExecute;
|
|
begin
|
|
if FLocals = nil then begin
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
if FLocalsInstr <> nil then begin
|
|
FLocalsInstr.OnFinish := nil;
|
|
ReleaseRefAndNil(FLocalsInstr);
|
|
end;
|
|
FLocalsInstr := TLldbInstructionLocals.Create(FLocals.ThreadId, FLocals.StackFrame);
|
|
FLocalsInstr.OnFinish := @LocalsInstructionFinished;
|
|
QueueInstruction(FLocalsInstr);
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandLocals.Create(AOwner: TLldbDebugger;
|
|
ALocals: TLocals);
|
|
begin
|
|
FLocals := ALocals;
|
|
FLocals.AddFreeNotification(@DoLocalsFreed);
|
|
CancelableForRun := True;
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
destructor TLldbDebuggerCommandLocals.Destroy;
|
|
begin
|
|
if FLocalsInstr <> nil then begin
|
|
FLocalsInstr.OnFinish := nil;
|
|
ReleaseRefAndNil(FLocalsInstr);
|
|
end;
|
|
if FLocals <> nil then
|
|
FLocals.RemoveFreeNotification(@DoLocalsFreed);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{%endregion ^^^^^ Register ^^^^^ }
|
|
|
|
{%region
|
|
*****
|
|
***** Threads
|
|
***** }
|
|
|
|
{ TLldbDebuggerCommandThreads }
|
|
|
|
procedure TLldbDebuggerCommandThreads.ThreadInstructionSucceeded(Sender: TObject);
|
|
begin
|
|
TLldbThreads(Debugger.Threads).ReadFromThreadInstruction(TLldbInstructionThreadList(Sender));
|
|
Finished;
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandThreads.Create(AOwner: TLldbDebugger);
|
|
begin
|
|
CancelableForRun := True;
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandThreads.DoExecute;
|
|
var
|
|
Instr: TLldbInstructionThreadList;
|
|
begin
|
|
Instr := TLldbInstructionThreadList.Create();
|
|
Instr.OnFinish := @ThreadInstructionSucceeded;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
{ TLldbThreads }
|
|
|
|
function TLldbThreads.GetDebugger: TLldbDebugger;
|
|
begin
|
|
Result := TLldbDebugger(inherited Debugger);
|
|
end;
|
|
|
|
procedure TLldbThreads.DoStateEnterPause;
|
|
begin
|
|
inherited DoStateEnterPause;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLldbThreads.ReadFromThreadInstruction(
|
|
Instr: TLldbInstructionThreadList; ACurrentId: Integer);
|
|
var
|
|
i, j, line: Integer;
|
|
s, func, filename, name, d, fullfile: String;
|
|
found, foundFunc, foundArg: TStringArray;
|
|
TId, CurThrId: LongInt;
|
|
CurThr: Boolean;
|
|
Arguments: TStringList;
|
|
addr, stack, frame: TDBGPtr;
|
|
te: TThreadEntry;
|
|
begin
|
|
CurrentThreads.Clear;
|
|
SetLength(FThreadFramePointers, Length(Instr.Res));
|
|
for i := 0 to Length(Instr.Res) - 1 do begin
|
|
s := Instr.Res[i];
|
|
ParseNewThreadLocation(s, TId, CurThr, name, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
|
|
FThreadFramePointers[i] := frame;
|
|
if CurThr then
|
|
CurThrId := TId;
|
|
|
|
te := CurrentThreads.CreateEntry(
|
|
addr,
|
|
Arguments,
|
|
func,
|
|
filename, fullfile,
|
|
line,
|
|
TId, name, ''
|
|
);
|
|
CurrentThreads.Add(te);
|
|
te.Free;
|
|
|
|
Arguments.Free;
|
|
end;
|
|
|
|
if ACurrentId >= 0 then
|
|
CurThrId := ACurrentId;
|
|
CurrentThreads.CurrentThreadId := CurThrId;
|
|
CurrentThreads.SetValidity(ddsValid);
|
|
end;
|
|
|
|
procedure TLldbThreads.RequestMasterData;
|
|
var
|
|
Cmd: TLldbDebuggerCommandThreads;
|
|
RunCmd: TLldbDebuggerCommand;
|
|
Instr: TLldbInstructionThreadList;
|
|
begin
|
|
if not (Debugger.State in [dsPause, dsInternalPause]) then
|
|
exit;
|
|
|
|
RunCmd := Debugger.CommandQueue.RunningCommand;
|
|
if RunCmd is TLldbDebuggerCommandRun then begin
|
|
Instr := TLldbDebuggerCommandRun(RunCmd).FThreadInstr;
|
|
if (Instr <> nil) and Instr.IsSuccess then begin
|
|
// FThreadInstr, may have the wrong thread marked. Use Debugger.FCurrentThreadId (which should not have changed since the RunCommand set it)
|
|
ReadFromThreadInstruction(TLldbInstructionThreadList(Instr), Debugger.FCurrentThreadId);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
Cmd := TLldbDebuggerCommandThreads.Create(Debugger);
|
|
Debugger.QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbThreads.ChangeCurrentThread(ANewId: Integer);
|
|
begin
|
|
if Debugger = nil then Exit;
|
|
if not(Debugger.State in [dsPause, dsInternalPause]) then exit;
|
|
|
|
Debugger.FCurrentThreadId := ANewId;
|
|
Debugger.FCurrentThreadFramePtr := GetFramePointerForThread(ANewId);
|
|
|
|
if CurrentThreads <> nil
|
|
then CurrentThreads.CurrentThreadId := ANewId;
|
|
|
|
TLldbCallStack(Debugger.CallStack).DoThreadChanged;
|
|
end;
|
|
|
|
function TLldbThreads.GetFramePointerForThread(AnId: Integer): TDBGPtr;
|
|
begin
|
|
if (AnId < 0) or (AnId >= Length(FThreadFramePointers)) then
|
|
exit(0);
|
|
Result := FThreadFramePointers[AnId];
|
|
end;
|
|
|
|
{%endregion ^^^^^ Threads ^^^^^ }
|
|
|
|
{%region
|
|
*****
|
|
***** CallStack
|
|
***** }
|
|
|
|
{ TLldbDebuggerCommandCallStack }
|
|
|
|
procedure TLldbDebuggerCommandCallStack.StackInstructionFinished(Sender: TObject
|
|
);
|
|
var
|
|
Instr: TLldbInstructionStackTrace absolute Sender;
|
|
i, FId, line: Integer;
|
|
e: TCallStackEntry;
|
|
found, foundArg: TStringArray;
|
|
Arguments: TStringList;
|
|
It: TMapIterator;
|
|
s, func, filename, d, fullfile: String;
|
|
IsCur: Boolean;
|
|
addr, stack, frame: TDBGPtr;
|
|
begin
|
|
if FCurrentCallStack = nil then begin
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
It := TMapIterator.Create(FCurrentCallStack.RawEntries);
|
|
|
|
for i := 0 to Length(Instr.Res) - 1 do begin
|
|
s := Instr.Res[i];
|
|
ParseNewFrameLocation(s, FId, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
|
|
if It.Locate(FId) then begin
|
|
e := TCallStackEntry(It.DataPtr^);
|
|
e.Init(addr, Arguments, func, filename, fullfile, line);
|
|
end;
|
|
Arguments.Free;
|
|
end;
|
|
It.Free;
|
|
|
|
TLldbCallStack(Debugger.CallStack).ParentRequestEntries(FCurrentCallStack);
|
|
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandCallStack.DoCallstackFreed(Sender: TObject);
|
|
begin
|
|
FCurrentCallStack := nil;
|
|
//TODO cancel
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandCallStack.DoExecute;
|
|
var
|
|
StartIdx, EndIdx: Integer;
|
|
Instr: TLldbInstructionStackTrace;
|
|
begin
|
|
if FCurrentCallStack = nil then begin
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
StartIdx := Max(FCurrentCallStack.LowestUnknown, 0);
|
|
EndIdx := FCurrentCallStack.HighestUnknown;
|
|
if EndIdx < StartIdx then begin
|
|
Finished;
|
|
exit;
|
|
end;
|
|
|
|
Instr := TLldbInstructionStackTrace.Create(EndIdx+1, FCurrentCallStack.ThreadId);
|
|
Instr.OnFinish := @StackInstructionFinished;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandCallStack.Create(AOwner: TLldbDebugger;
|
|
ACurrentCallStack: TCallStackBase);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FCurrentCallStack := ACurrentCallStack;
|
|
FCurrentCallStack.AddFreeNotification(@DoCallstackFreed);
|
|
CancelableForRun := True;
|
|
end;
|
|
|
|
destructor TLldbDebuggerCommandCallStack.Destroy;
|
|
begin
|
|
if FCurrentCallStack <> nil then
|
|
FCurrentCallStack.RemoveFreeNotification(@DoCallstackFreed);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TLldbCallStack }
|
|
|
|
procedure TLldbCallStack.DoThreadChanged;
|
|
var
|
|
tid, idx: Integer;
|
|
cs: TCallStackBase;
|
|
begin
|
|
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
|
|
exit;
|
|
end;
|
|
|
|
TLldbDebugger(Debugger).FCurrentStackFrame := 0;
|
|
tid := Debugger.Threads.CurrentThreads.CurrentThreadId;
|
|
cs := TCallStackBase(CurrentCallStackList.EntriesForThreads[tid]);
|
|
idx := cs.CurrentIndex; // CURRENT
|
|
if idx < 0 then idx := 0;
|
|
|
|
TLldbDebugger(Debugger).FCurrentStackFrame := idx;
|
|
cs.CurrentIndex := idx;
|
|
end;
|
|
|
|
procedure TLldbCallStack.ParentRequestEntries(ACallstack: TCallStackBase);
|
|
begin
|
|
inherited RequestEntries(ACallstack);
|
|
end;
|
|
|
|
procedure TLldbCallStack.RequestAtLeastCount(ACallstack: TCallStackBase;
|
|
ARequiredMinCount: Integer);
|
|
begin
|
|
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
|
|
ACallstack.SetCurrentValidity(ddsInvalid);
|
|
Exit;
|
|
end;
|
|
|
|
ACallstack.Count := ARequiredMinCount + 1; // TODO: get data, and return correct result
|
|
ACallstack.SetCountValidity(ddsValid);
|
|
end;
|
|
|
|
procedure TLldbCallStack.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; // FCurrentThreadId ?
|
|
cs := TCallStackBase(CurrentCallStackList.EntriesForThreads[tid]);
|
|
idx := cs.NewCurrentIndex; // NEW-CURRENT
|
|
|
|
if TLldbDebugger(Debugger).FCurrentStackFrame = idx then Exit;
|
|
|
|
TLldbDebugger(Debugger).FCurrentStackFrame := idx;
|
|
|
|
if cs <> nil then begin
|
|
cs.CurrentIndex := idx;
|
|
cs.SetCurrentValidity(ddsValid);
|
|
end;
|
|
end;
|
|
|
|
procedure TLldbCallStack.RequestCurrent(ACallstack: TCallStackBase);
|
|
begin
|
|
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
|
|
ACallstack.SetCurrentValidity(ddsInvalid);
|
|
Exit;
|
|
end;
|
|
|
|
if ACallstack.ThreadId = TLldbDebugger(Debugger).FCurrentThreadId
|
|
then ACallstack.CurrentIndex := TLldbDebugger(Debugger).FCurrentStackFrame
|
|
else ACallstack.CurrentIndex := 0; // will be used, if thread is changed
|
|
ACallstack.SetCurrentValidity(ddsValid);
|
|
end;
|
|
|
|
procedure TLldbCallStack.RequestEntries(ACallstack: TCallStackBase);
|
|
var
|
|
Cmd: TLldbDebuggerCommandCallStack;
|
|
begin
|
|
if not (Debugger.State in [dsPause, dsInternalPause]) then
|
|
exit;
|
|
|
|
Cmd := TLldbDebuggerCommandCallStack.Create(TLldbDebugger(Debugger), ACallstack);
|
|
TLldbDebugger(Debugger).QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
{%endregion ^^^^^ CallStack ^^^^^ }
|
|
|
|
{ TLldbLocals }
|
|
|
|
procedure TLldbLocals.RequestData(ALocals: TLocals);
|
|
var
|
|
Cmd: TLldbDebuggerCommandLocals;
|
|
begin
|
|
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
|
|
|
|
Cmd := TLldbDebuggerCommandLocals.Create(TLldbDebugger(Debugger), ALocals);
|
|
TLldbDebugger(Debugger).QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
{ TLldbWatches }
|
|
|
|
procedure TLldbWatches.InternalRequestData(AWatchValue: TWatchValue);
|
|
var
|
|
Cmd: TLldbDebuggerCommandEvaluate;
|
|
begin
|
|
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
|
|
|
|
Cmd := TLldbDebuggerCommandEvaluate.Create(TLldbDebugger(Debugger), AWatchValue);
|
|
TLldbDebugger(Debugger).QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
{ TLldbBreakPoint }
|
|
|
|
procedure TLldbBreakPoint.SetBreakPoint;
|
|
var
|
|
i: Integer;
|
|
s: String;
|
|
Instr: TLldbInstruction;
|
|
en: Boolean;
|
|
begin
|
|
debugln(DBG_VERBOSE, ['TLldbBreakPoint.SetBreakPoint ']);
|
|
|
|
if FCurrentInstruction <> nil then begin
|
|
if (FBreakID <> 0) or (not FCurrentInstruction.IsRunning) then begin
|
|
// Can be a queued SetBreak => replace
|
|
// Or an Update => don't care, ReleaseBreakpoint will be called
|
|
CancelCurrentInstruction;
|
|
end
|
|
else begin
|
|
// already running a SetBreakPoint
|
|
FNeededChanges := FNeededChanges + [ciLocation]; // wait for instruction to finish // need ID to del
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if (FBreakID <> 0) then
|
|
ReleaseBreakPoint;
|
|
|
|
en := Enabled;
|
|
if TLldbDebugger(Debugger).FLldbMissingBreakSetDisable and (not en) and (Kind <> bpkData) then begin
|
|
en := True;
|
|
FNeededChanges := FNeededChanges + [ciEnabled];
|
|
end;
|
|
|
|
case Kind of
|
|
bpkSource: begin
|
|
i := LastPos(PathDelim, Source);
|
|
if i > 0 then
|
|
s := Copy(Source, i+1, Length(Source))
|
|
else
|
|
s := Source;
|
|
Instr := TLldbInstructionBreakSet.Create(s, Line, not en, Expression);
|
|
end;
|
|
bpkAddress: begin
|
|
Instr := TLldbInstructionBreakSet.Create(Address, not en, Expression);
|
|
end;
|
|
bpkData: begin
|
|
if not Enabled then // do not set, if not enabled
|
|
exit;
|
|
// TODO: scope
|
|
// TODO: apply , Expression, not Enabled
|
|
Instr := TLldbInstructionWatchSet.Create(WatchData, WatchKind);
|
|
if Expression <> '' then
|
|
FNeededChanges := FNeededChanges + [ciCondition];
|
|
end;
|
|
end;
|
|
|
|
Instr.OnFinish := @InstructionSetBreakFinished;
|
|
TLldbDebugger(Debugger).FDebugInstructionQueue.QueueInstruction(Instr);
|
|
FCurrentInstruction := Instr;
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.InstructionSetBreakFinished(Sender: TObject);
|
|
var
|
|
nc: TDbgBpChangeIndicators;
|
|
begin
|
|
DoCurrentInstructionFinished;
|
|
|
|
if TLldbInstructionBreakOrWatchSet(Sender).LldbNoDisableError then begin
|
|
TLldbDebugger(Debugger).FLldbMissingBreakSetDisable := True;
|
|
FNeededChanges := FNeededChanges + [ciLocation]
|
|
end;
|
|
|
|
if TLldbInstructionBreakOrWatchSet(Sender).IsSuccess then begin
|
|
FBreakID := TLldbInstructionBreakOrWatchSet(Sender).BreakId;
|
|
if FNeededChanges * [ciDestroy, ciLocation] = [] then
|
|
SetValid(TLldbInstructionBreakOrWatchSet(Sender).State);
|
|
end
|
|
else
|
|
SetValid(vsInvalid);
|
|
|
|
nc := FNeededChanges;
|
|
FNeededChanges := [];
|
|
MarkPropertiesChanged(nc);
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.InstructionUpdateBreakFinished(Sender: TObject);
|
|
var
|
|
nc: TDbgBpChangeIndicators;
|
|
begin
|
|
DoCurrentInstructionFinished;
|
|
|
|
nc := FNeededChanges;
|
|
FNeededChanges := [];
|
|
MarkPropertiesChanged(nc);
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.ReleaseBreakPoint;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
CancelCurrentInstruction;
|
|
|
|
if FBreakID <= 0 then exit;
|
|
SetHitCount(0);
|
|
|
|
case Kind of
|
|
bpkSource, bpkAddress:
|
|
Instr := TLldbInstructionBreakDelete.Create(FBreakID);
|
|
bpkData:
|
|
Instr := TLldbInstructionWatchDelete.Create(FBreakID);
|
|
end;
|
|
FBreakID := 0; // Allow a new location to be set immediately
|
|
|
|
//Instr.OwningCommand := Self; // if it needs to be cancelled
|
|
TLldbDebugger(Debugger).FDebugInstructionQueue.QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.UpdateProperties(AChanged: TDbgBpChangeIndicators);
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
assert(AChanged * [ciEnabled, ciCondition] <> [], 'break.UpdateProperties() AChanged * [ciEnabled, ciCondition] <> []');
|
|
|
|
if (FCurrentInstruction <> nil) then begin
|
|
FNeededChanges := FNeededChanges + AChanged;
|
|
exit;
|
|
end;
|
|
|
|
if FBreakID = 0 then // SetBreakPoint may have failed / nothing to do
|
|
exit;
|
|
|
|
case Kind of
|
|
bpkSource, bpkAddress:
|
|
if ciCondition in AChanged
|
|
then Instr := TLldbInstructionBreakModify.Create(FBreakID, not Enabled, Expression)
|
|
else Instr := TLldbInstructionBreakModify.Create(FBreakID, not Enabled);
|
|
bpkData:
|
|
begin
|
|
if Enabled <> (FBreakID <> 0) then begin
|
|
if Enabled
|
|
then SetBreakPoint // will
|
|
else ReleaseBreakPoint;
|
|
exit;
|
|
end;
|
|
if ciCondition in AChanged then
|
|
Instr := TLldbInstructionWatchModify.Create(FBreakID, Expression);
|
|
end;
|
|
end;
|
|
|
|
TLldbDebugger(Debugger).FDebugInstructionQueue.QueueInstruction(Instr);
|
|
Instr.OnFinish := @InstructionUpdateBreakFinished;
|
|
FCurrentInstruction := Instr;
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.DoCurrentInstructionFinished;
|
|
begin
|
|
if FCurrentInstruction <> nil then begin
|
|
FCurrentInstruction.OnFinish := nil;
|
|
ReleaseRefAndNil(FCurrentInstruction);
|
|
end;
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.CancelCurrentInstruction;
|
|
begin
|
|
if FCurrentInstruction <> nil then begin
|
|
FCurrentInstruction.OnFinish := nil;
|
|
FCurrentInstruction.Cancel;
|
|
ReleaseRefAndNil(FCurrentInstruction);
|
|
end;
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.DoStateChange(const AOldState: TDBGState);
|
|
begin
|
|
inherited DoStateChange(AOldState);
|
|
case DebuggerState of
|
|
dsRun: if AOldState = dsInit then begin
|
|
// Disabled data breakpoints: wait until enabled
|
|
// Disabled other breakpoints: Give to LLDB to see if they are valid
|
|
SetBreakPoint
|
|
end;
|
|
dsStop: begin
|
|
if FBreakID > 0
|
|
then ReleaseBreakpoint;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TLldbBreakPoint.DoPropertiesChanged(AChanged: TDbgBpChangeIndicators);
|
|
begin
|
|
FNeededChanges := [];
|
|
if not (DebuggerState in [dsPause, dsInternalPause, dsRun]) then
|
|
exit;
|
|
|
|
if ciDestroy in AChanged then begin
|
|
ReleaseBreakPoint;
|
|
DoCurrentInstructionFinished;
|
|
exit;
|
|
end;
|
|
|
|
if AChanged * [ciLocation, ciCreated] <> [] then
|
|
SetBreakPoint
|
|
else
|
|
UpdateProperties(AChanged);
|
|
end;
|
|
|
|
destructor TLldbBreakPoint.Destroy;
|
|
begin
|
|
DoCurrentInstructionFinished;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TLldbBreakPoints }
|
|
|
|
function TLldbBreakPoints.FindById(AnId: Integer): TLldbBreakPoint;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do begin
|
|
Result := TLldbBreakPoint(Items[i]);
|
|
if Result.FBreakID = AnId then
|
|
exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
{%region
|
|
*****
|
|
***** Register
|
|
***** }
|
|
|
|
{ TLldbDebuggerCommandRegister }
|
|
|
|
procedure TLldbDebuggerCommandRegister.RegisterInstructionFinished(
|
|
Sender: TObject);
|
|
var
|
|
Instr: TLldbInstructionRegister absolute Sender;
|
|
RegVal: TRegisterValue;
|
|
n: String;
|
|
i: Integer;
|
|
begin
|
|
if not Instr.IsSuccess then begin
|
|
if FRegisters.DataValidity in [ddsRequested, ddsEvaluating] then
|
|
FRegisters.DataValidity := ddsInvalid;
|
|
exit;
|
|
end;
|
|
|
|
FRegisters.DataValidity := ddsEvaluating;
|
|
|
|
for i := 0 to Instr.Res.Count - 1 do begin
|
|
n := Instr.Res.Names[i];
|
|
RegVal := FRegisters.EntriesByName[n];
|
|
RegVal.Value := Instr.Res.Values[n];
|
|
RegVal.DataValidity := ddsValid;
|
|
end;
|
|
|
|
FRegisters.DataValidity := ddsValid;
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRegister.DoExecute;
|
|
var
|
|
Instr: TLldbInstructionRegister;
|
|
begin
|
|
// TODO: store thread/frame when command is created
|
|
Instr := TLldbInstructionRegister.Create(FRegisters.ThreadId, FRegisters.StackFrame);
|
|
Instr.OnFinish := @RegisterInstructionFinished;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRegister.DoCancel;
|
|
begin
|
|
if FRegisters <> nil then
|
|
FRegisters.DataValidity := ddsInvalid;
|
|
inherited DoCancel;
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandRegister.Create(AOwner: TLldbDebugger;
|
|
ARegisters: TRegisters);
|
|
begin
|
|
FRegisters := ARegisters;
|
|
FRegisters.AddReference;
|
|
CancelableForRun := True;
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
destructor TLldbDebuggerCommandRegister.Destroy;
|
|
begin
|
|
ReleaseRefAndNil(FRegisters);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TLldbRegisterSupplier }
|
|
|
|
procedure TLldbRegisterSupplier.Changed;
|
|
begin
|
|
if CurrentRegistersList <> nil
|
|
then CurrentRegistersList.Clear;
|
|
end;
|
|
|
|
procedure TLldbRegisterSupplier.RequestData(ARegisters: TRegisters);
|
|
var
|
|
Cmd: TLldbDebuggerCommandRegister;
|
|
begin
|
|
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause, dsStop]) then
|
|
exit;
|
|
|
|
Cmd := TLldbDebuggerCommandRegister.Create(TLldbDebugger(Debugger), ARegisters);
|
|
TLldbDebugger(Debugger).QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
{%endregion ^^^^^ Register ^^^^^ }
|
|
|
|
{ TLldbDebuggerCommandQueue }
|
|
|
|
function TLldbDebuggerCommandQueue.Get(Index: Integer): TLldbDebuggerCommand;
|
|
begin
|
|
Result := TLldbDebuggerCommand(inherited Get(Index));
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.Put(Index: Integer;
|
|
const AValue: TLldbDebuggerCommand);
|
|
begin
|
|
inherited Put(Index, AValue);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.QueueCommand(AValue: TLldbDebuggerCommand);
|
|
begin
|
|
debugln(DBG_VERBOSE, ['CommandQueue.QueueCommand ', AValue.ClassName]);
|
|
Insert(Count, AValue);
|
|
Run;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.DoLineDataReceived(var ALine: String);
|
|
begin
|
|
if FRunningCommand <> nil then
|
|
FRunningCommand.DoLineDataReceived(ALine);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.Run;
|
|
begin
|
|
if (FRunningCommand <> nil) or (FLockQueueRun > 0) then
|
|
exit;
|
|
{$IFnDEF LLDB_SKIP_IDLE}
|
|
if Count = 0 then begin
|
|
if Assigned(FDebugger.OnIdle) and (not FDebugger.FInIdle) then begin
|
|
FDebugger.FInIdle := True;
|
|
LockQueueRun;
|
|
FDebugger.OnIdle(Self);
|
|
UnLockQueueRun;
|
|
FDebugger.FInIdle := False;
|
|
end;
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
FRunningCommand := Items[0];
|
|
FRunningCommand.AddReference;
|
|
Delete(0);
|
|
DebugLnEnter(DBG_VERBOSE, ['||||||||>>> CommandQueue.Run ', FRunningCommand.ClassName, ', ', dbgs(fDebugger.State), ' Cnt:',Count]);
|
|
FRunningCommand.Execute;
|
|
// debugger and queue may get destroyed at the end of execute
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.CommandFinished(
|
|
ACommand: TLldbDebuggerCommand);
|
|
begin
|
|
if FRunningCommand = ACommand then begin
|
|
DebugLnExit(DBG_VERBOSE, ['||||||||<<< CommandQueue.Run ', FRunningCommand.ClassName, ', ', dbgs(fDebugger.State), ' Cnt:',Count]);
|
|
ReleaseRefAndNil(FRunningCommand);
|
|
end//;
|
|
else DebugLn(DBG_VERBOSE, ['|||||||| TLldbDebuggerCommandQueue.CommandFinished >> unknown ???', ', ', dbgs(fDebugger.State), ' Cnt:',Count]);
|
|
if not(FDebugger.State in [dsError, dsDestroying, dsNone]) then
|
|
Run;
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandQueue.Create(ADebugger: TLldbDebugger);
|
|
begin
|
|
FDebugger := ADebugger;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TLldbDebuggerCommandQueue.Destroy;
|
|
begin
|
|
while Count > 0 do
|
|
Delete(0);
|
|
if FRunningCommand <> nil then begin
|
|
DebugLnExit(DBG_VERBOSE, ['<<< CommandQueue.Run (Destroy)', FRunningCommand.ClassName, ', ', fDebugger.State]);
|
|
ReleaseRefAndNil(FRunningCommand);
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.CancelAll;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := Count - 1;
|
|
while i >= 0 do begin
|
|
Items[i].Cancel;
|
|
dec(i);
|
|
if i > Count then
|
|
i := Count - 1;
|
|
end;
|
|
if FRunningCommand <> nil then
|
|
FRunningCommand.Cancel;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.CancelForRun;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := Count - 1;
|
|
while i >= 0 do begin
|
|
if Items[i].CancelableForRun then
|
|
Items[i].Cancel;
|
|
dec(i);
|
|
if i > Count then
|
|
i := Count - 1;
|
|
end;
|
|
if (FRunningCommand <> nil) and (FRunningCommand.CancelableForRun) then
|
|
FRunningCommand.Cancel;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.LockQueueRun;
|
|
begin
|
|
inc(FLockQueueRun);
|
|
debugln(DBG_VERBOSE, ['TLldbDebuggerCommandQueue.LockQueueRun ',FLockQueueRun]);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandQueue.UnLockQueueRun;
|
|
begin
|
|
debugln(DBG_VERBOSE, ['TLldbDebuggerCommandQueue.UnLockQueueRun ',FLockQueueRun]);
|
|
dec(FLockQueueRun);
|
|
if FLockQueueRun = 0 then Run;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommand }
|
|
|
|
function TLldbDebuggerCommand.GetDebuggerState: TDBGState;
|
|
begin
|
|
Result := Debugger.State;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.InstructionSucceeded(AnInstruction: TObject);
|
|
begin
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.InstructionFailed(AnInstruction: TObject);
|
|
begin
|
|
SetDebuggerState(dsError);
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.Finished;
|
|
begin
|
|
InstructionQueue.CancelAllForCommand(Self); // in case there still are any
|
|
CommandQueue.CommandFinished(Self);
|
|
end;
|
|
|
|
function TLldbDebuggerCommand.GetCommandQueue: TLldbDebuggerCommandQueue;
|
|
begin
|
|
Result := Debugger.FCommandQueue;
|
|
end;
|
|
|
|
function TLldbDebuggerCommand.GetInstructionQueue: TLldbInstructionQueue;
|
|
begin
|
|
Result := Debugger.FDebugInstructionQueue;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.QueueInstruction(AnInstruction: TLldbInstruction);
|
|
begin
|
|
AnInstruction.OwningCommand := Self;
|
|
InstructionQueue.QueueInstruction(AnInstruction);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.SetDebuggerState(const AValue: TDBGState);
|
|
begin
|
|
Debugger.SetState(AValue);
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommand.Create(AOwner: TLldbDebugger);
|
|
begin
|
|
FOwner := AOwner;
|
|
inherited Create;
|
|
AddReference;
|
|
end;
|
|
|
|
destructor TLldbDebuggerCommand.Destroy;
|
|
begin
|
|
if InstructionQueue <> nil then
|
|
InstructionQueue.CancelAllForCommand(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.Execute;
|
|
var
|
|
d: TLldbDebugger;
|
|
begin
|
|
FIsRunning := True;
|
|
d := Debugger;
|
|
try
|
|
AddReference;
|
|
d.LockRelease;
|
|
DoExecute; // may call Finished and Destroy Self
|
|
finally
|
|
d.UnlockRelease;
|
|
ReleaseReference;
|
|
end;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.Cancel;
|
|
begin
|
|
AddReference;
|
|
Debugger.CommandQueue.Remove(Self); // current running command is not on queue // dec refcount, may call destroy
|
|
if FIsRunning then
|
|
DoCancel; // should call CommandQueue.CommandFinished
|
|
ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.DoLineDataReceived(var ALine: String);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommand.DoCancel;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandInit }
|
|
|
|
procedure TLldbDebuggerCommandInit.DoExecute;
|
|
const
|
|
FRAME_INFO =
|
|
'${frame.pc}, {${frame.sp}}, {${frame.fp}}' +
|
|
' &&//FULL: {${line.file.fullpath}} &&//SHORT: {${line.file.basename}} &&//LINE: {${line.number}}' +
|
|
' &&//MOD: {${module.file.basename}} &&//FUNC: {${function.name-with-args}}' +
|
|
' <<&&//FRAME';
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
Instr := TLldbInstructionSettingSet.Create('frame-format',
|
|
'"frame #${frame.index}: ' + FRAME_INFO + '\n"'
|
|
);
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Instr := TLldbInstructionSettingSet.Create('thread-format',
|
|
'"thread #${thread.index}: tid=${thread.id%tid}: ' + FRAME_INFO +
|
|
//'{, activity = ''${thread.info.activity.name}''}{, ${thread.info.trace_messages} messages}' +
|
|
'{, stop reason = ${thread.stop-reason}}' +
|
|
//'{\nReturn value: ${thread.return-value}}{\nCompleted expression: ${thread.completed-expression}}' +
|
|
'\n"'
|
|
);
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
// Not all versions of lldb have this
|
|
Instr := TLldbInstructionSettingSet.Create('thread-stop-format',
|
|
'"thread #${thread.index}: tid=${thread.id%tid}: ' + FRAME_INFO +
|
|
//'{, activity = ''${thread.info.activity.name}''}{, ${thread.info.trace_messages} messages}' +
|
|
'{, stop reason = ${thread.stop-reason}}' +
|
|
//'{\nReturn value: ${thread.return-value}}{\nCompleted expression: ${thread.completed-expression}}' +
|
|
'\n"'
|
|
);
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Instr := TLldbInstructionTargetStopHook.Create('thread list');
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Instr := TLldbInstructionSettingSet.Create('stop-line-count-after', '0');
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Instr := TLldbInstructionSettingSet.Create('stop-line-count-before', '0');
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Instr := TLldbInstructionSettingSet.Create('stop-disassembly-count', '0');
|
|
Instr.OnFinish := @InstructionSucceeded;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandInit.DoLineDataReceived(var ALine: String);
|
|
begin
|
|
inherited DoLineDataReceived(ALine);
|
|
if FGotLLDB then
|
|
exit;
|
|
if TLldbDebuggerProperties(Debugger.GetProperties).SkipGDBDetection then
|
|
FGotLLDB := True
|
|
else
|
|
if StrContains(UpperCase(ALine), 'LLDB') then
|
|
FGotLLDB := True
|
|
else
|
|
if StrContains(UpperCase(ALine), '(GDB)') then
|
|
Debugger.SetErrorState('GDB detected', 'The external debugger identified itself as GDB. The IDE expected LLDB.');
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandRunStep }
|
|
|
|
procedure TLldbDebuggerCommandRunStep.DoInitialExecute;
|
|
begin
|
|
SetNextStepCommand(FStepAction);
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandRunStep.Create(AOwner: TLldbDebugger;
|
|
AStepAction: TLldbInstructionProcessStepAction);
|
|
var
|
|
AtExcepiton: Boolean;
|
|
begin
|
|
AtExcepiton := AOwner.FExceptionInfo.FAtExcepiton;
|
|
FStepAction := AStepAction;
|
|
inherited Create(AOwner);
|
|
if AtExcepiton and
|
|
(AStepAction in [saOver, saInto, saOut])
|
|
then
|
|
FMode := cmRunToCatch;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandRunLaunch }
|
|
|
|
procedure TLldbDebuggerCommandRunLaunch.TargetCreated(Sender: TObject);
|
|
var
|
|
TargetInstr: TLldbInstructionTargetCreate absolute Sender;
|
|
Instr: TLldbInstruction;
|
|
found: TStringArray;
|
|
begin
|
|
if not TargetInstr.IsSuccess then begin
|
|
SetDebuggerState(dsError);
|
|
Finished;
|
|
end;
|
|
CollectDwarfLoadErrors(Sender);
|
|
|
|
If StrMatches(TargetInstr.Res, [''{}, '','('{}, ')',''], found) then begin
|
|
if (found[1] = 'i386') or (found[1] = 'i686') then begin
|
|
DebugLn(DBG_VERBOSE, ['Target 32 bit: ', found[1]]);
|
|
Debugger.FTargetWidth := 32;
|
|
Debugger.FTargetRegisters[0] := '$eax';
|
|
Debugger.FTargetRegisters[1] := '$edx';
|
|
Debugger.FTargetRegisters[2] := '$ecx';
|
|
end
|
|
else
|
|
if (found[1] = '(x86_64)') or (found[1] = 'x86_64') then begin
|
|
DebugLn(DBG_VERBOSE, ['Target 64 bit: ', found[1]]);
|
|
Debugger.FTargetWidth := 64;
|
|
// target list gives more detailed result. But until remote debugging is added, use the current system
|
|
{$IFDEF MSWindows}
|
|
Debugger.FTargetRegisters[0] := '$rcx';
|
|
Debugger.FTargetRegisters[1] := '$rdx';
|
|
Debugger.FTargetRegisters[2] := '$r8';
|
|
{$ELSE}
|
|
Debugger.FTargetRegisters[0] := '$rdi';
|
|
Debugger.FTargetRegisters[1] := '$rsi';
|
|
Debugger.FTargetRegisters[2] := '$rdx';
|
|
{$ENDIF}
|
|
end
|
|
else found := nil;
|
|
end
|
|
else found := nil;
|
|
if found = nil then begin
|
|
DebugLn(DBG_VERBOSE, ['Target bitness UNKNOWN']);
|
|
// use architecture of IDE
|
|
{$IFDEF cpu64}
|
|
Debugger.FTargetWidth := 64;
|
|
{$IFDEF MSWindows}
|
|
Debugger.FTargetRegisters[0] := '$rcx';
|
|
Debugger.FTargetRegisters[1] := '$rdx';
|
|
Debugger.FTargetRegisters[2] := '$r8';
|
|
{$ELSE}
|
|
Debugger.FTargetRegisters[0] := '$rdi';
|
|
Debugger.FTargetRegisters[1] := '$rsi';
|
|
Debugger.FTargetRegisters[2] := '$rdx';
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
Debugger.FTargetWidth := 32;
|
|
Debugger.FTargetRegisters[0] := '$eax';
|
|
Debugger.FTargetRegisters[1] := '$edx';
|
|
Debugger.FTargetRegisters[2] := '$ecx';
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if Trim(Debugger.Arguments) <> '' then
|
|
Instr := TLldbInstructionSettingSet.Create('target.run-args', Debugger.Arguments)
|
|
else
|
|
Instr := TLldbInstructionSettingClear.Create('target.run-args');
|
|
Instr.OnFinish := @CollectDwarfLoadErrors;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Debugger.FBreakErrorBreak.OnFinish := @CollectDwarfLoadErrors;
|
|
Debugger.FRunErrorBreak.OnFinish := @CollectDwarfLoadErrors;
|
|
Debugger.FExceptionBreak.OnFinish := @ExceptBreakInstructionFinished;
|
|
Debugger.FBreakErrorBreak.Enable;
|
|
Debugger.FRunErrorBreak.Enable;
|
|
Debugger.FExceptionBreak.Enable;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRunLaunch.CollectDwarfLoadErrors(Sender: TObject);
|
|
begin
|
|
if Sender is TlldbInternalBreakPoint then begin
|
|
FLaunchWarnings := FLaunchWarnings + TlldbInternalBreakPoint(Sender).DwarfLoadErrors;
|
|
TlldbInternalBreakPoint(Sender).OnFinish := nil;
|
|
end
|
|
else
|
|
FLaunchWarnings := FLaunchWarnings + TLldbInstruction(Sender).DwarfLoadErrors;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRunLaunch.ExceptBreakInstructionFinished(Sender: TObject
|
|
);
|
|
var
|
|
Instr: TLldbInstruction;
|
|
BrkId: Integer;
|
|
begin
|
|
CollectDwarfLoadErrors(Sender);
|
|
Debugger.FBreakErrorBreak.OnFinish := nil;
|
|
|
|
Debugger.FExceptionInfo.FReg0Cmd := '';
|
|
Debugger.FExceptionInfo.FReg2Cmd := '';
|
|
Debugger.FExceptionInfo.FExceptClassCmd := '';
|
|
Debugger.FExceptionInfo.FExceptMsgCmd := '';
|
|
|
|
BrkId := Debugger.FExceptionBreak.BreakId;
|
|
if BrkId > 0 then begin
|
|
Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0];
|
|
Debugger.FExceptionInfo.FReg2Cmd := 'p/x ' + Debugger.FTargetRegisters[2];
|
|
Debugger.FExceptionInfo.FExceptClassCmd := 'p ((char ***)' + Debugger.FTargetRegisters[0] + ')[0][3]';
|
|
Debugger.FExceptionInfo.FExceptMsgCmd := 'p ((char **)' + Debugger.FTargetRegisters[0] + ')[1]';
|
|
// 'p ((EXCEPTION *)' + Debugger.FTargetRegisters[0] + ')->FMESSAGE'
|
|
|
|
Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [
|
|
Debugger.FExceptionInfo.FReg0Cmd, Debugger.FExceptionInfo.FReg2Cmd, Debugger.FExceptionInfo.FExceptClassCmd, Debugger.FExceptionInfo.FExceptMsgCmd
|
|
]);
|
|
Instr.OnFinish := @CollectDwarfLoadErrors;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
BrkId := Debugger.FRunErrorBreak.BreakId;
|
|
if BrkId > 0 then begin
|
|
Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0];
|
|
Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [Debugger.FExceptionInfo.FReg0Cmd]);
|
|
Instr.OnFinish := @CollectDwarfLoadErrors;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
BrkId := Debugger.FBreakErrorBreak.BreakId;
|
|
if BrkId > 0 then begin
|
|
Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0];
|
|
Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [Debugger.FExceptionInfo.FReg0Cmd]);
|
|
Instr.OnFinish := @CollectDwarfLoadErrors;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
SetDebuggerState(dsRun);
|
|
// the state change allows breakpoints to be set, before the run command is issued.
|
|
|
|
FRunInstr := TLldbInstructionProcessLaunch.Create(TLldbDebuggerProperties(Debugger.GetProperties).LaunchNewTerminal);
|
|
FRunInstr.OnSuccess := @LaunchInstructionSucceeded;
|
|
FRunInstr.OnFailure := @InstructionFailed;
|
|
QueueInstruction(FRunInstr);
|
|
FRunInstr.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRunLaunch.LaunchInstructionSucceeded(Sender: TObject);
|
|
begin
|
|
CollectDwarfLoadErrors(Sender);
|
|
Debugger.DoAfterLaunch(FLaunchWarnings);
|
|
if (not TLldbDebuggerProperties(Debugger.GetProperties).IgnoreLaunchWarnings) and
|
|
(FLaunchWarnings <> '') and
|
|
assigned(Debugger.OnFeedback)
|
|
then begin
|
|
case Debugger.OnFeedback(self,
|
|
Format('The debugger encountered some errors/warnings while launching the target application.%0:s'
|
|
+ 'Press "Ok" to continue debugging.%0:s'
|
|
+ 'Press "Stop" to end the debug session.',
|
|
[LineEnding]),
|
|
FLaunchWarnings, ftWarning, [frOk, frStop]
|
|
) of
|
|
frOk: begin
|
|
end;
|
|
frStop: begin
|
|
Debugger.Stop;
|
|
end;
|
|
end;
|
|
end;
|
|
RunInstructionSucceeded(Sender);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandRunLaunch.DoInitialExecute;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
Instr := TLldbInstructionTargetCreate.Create(Debugger.FileName);
|
|
Instr.OnSuccess := @TargetCreated;
|
|
Instr.OnFailure := @InstructionFailed;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandRunLaunch.Create(AOwner: TLldbDebugger);
|
|
begin
|
|
FStepAction := saContinue;
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandStop }
|
|
|
|
procedure TLldbDebuggerCommandStop.StopInstructionSucceeded(Sender: TObject);
|
|
begin
|
|
if DebuggerState <> dsIdle then
|
|
SetDebuggerState(dsStop);
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandStop.DoExecute;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
Instr := TLldbInstructionProcessKill.Create();
|
|
Instr.OnSuccess := @StopInstructionSucceeded;
|
|
Instr.OnFailure := @InstructionFailed;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Instr := TLldbInstructionTargetDelete.Create();
|
|
Instr.OnFailure := @InstructionFailed;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
|
|
Instr := TLldbInstructionTargetDelete.Create();
|
|
Instr.OnSuccess := @InstructionSucceeded;
|
|
Instr.OnFailure := @InstructionFailed;
|
|
QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
{ TLldbDebuggerCommandEvaluate }
|
|
|
|
procedure TLldbDebuggerCommandEvaluate.EvalInstructionSucceeded(Sender: TObject
|
|
);
|
|
begin
|
|
if FWatchValue <> nil then begin
|
|
FWatchValue.Value := FInstr.Res;
|
|
//FWatchValue.TypeInfo := TypeInfo;
|
|
FWatchValue.Validity := ddsValid;
|
|
end
|
|
else
|
|
if FCallback <> nil then
|
|
FCallback(Debugger, True, FInstr.Res, nil);
|
|
|
|
FInstr.ReleaseReference;
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandEvaluate.EvalInstructionFailed(Sender: TObject);
|
|
begin
|
|
if FWatchValue <> nil then
|
|
FWatchValue.Validity := ddsError
|
|
else
|
|
if FCallback <> nil then
|
|
FCallback(Debugger, False, '', nil);
|
|
FInstr.ReleaseReference;
|
|
Finished;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandEvaluate.DoWatchFreed(Sender: TObject);
|
|
begin
|
|
FWatchValue := nil;
|
|
end;
|
|
|
|
procedure TLldbDebuggerCommandEvaluate.DoExecute;
|
|
begin
|
|
if FWatchValue <> nil then
|
|
FInstr := TLldbInstructionExpression.Create(FWatchValue.Expression, FWatchValue.ThreadId, FWatchValue.StackFrame)
|
|
else
|
|
// todo: only if FCallback ?
|
|
FInstr := TLldbInstructionExpression.Create(FExpr, Debugger.FCurrentThreadId, Debugger.FCurrentStackFrame);
|
|
FInstr.OnSuccess := @EvalInstructionSucceeded;
|
|
FInstr.OnFailure := @EvalInstructionFailed;
|
|
QueueInstruction(FInstr);
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandEvaluate.Create(AOwner: TLldbDebugger;
|
|
AWatchValue: TWatchValue);
|
|
begin
|
|
FWatchValue := AWatchValue;
|
|
FWatchValue.AddFreeNotification(@DoWatchFreed);
|
|
CancelableForRun := True;
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
constructor TLldbDebuggerCommandEvaluate.Create(AOwner: TLldbDebugger;
|
|
AnExpr: String; AFlags: TDBGEvaluateFlags;
|
|
ACallback: TDBGEvaluateResultCallback);
|
|
begin
|
|
FExpr := AnExpr;
|
|
FFlags := AFlags;
|
|
FCallback := ACallback;
|
|
CancelableForRun := True;
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
destructor TLldbDebuggerCommandEvaluate.Destroy;
|
|
begin
|
|
if FWatchValue <> nil then
|
|
FWatchValue.RemoveFreeNotification(@DoWatchFreed);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TlldbInternalBreakPoint }
|
|
|
|
procedure TlldbInternalBreakPoint.QueueInstruction(AnInstr: TLldbInstruction);
|
|
begin
|
|
AnInstr.OnFinish := @DoFinished;
|
|
FDebugger.DebugInstructionQueue.QueueInstruction(AnInstr);
|
|
AnInstr.ReleaseReference;
|
|
end;
|
|
|
|
procedure TlldbInternalBreakPoint.BreakSetSuccess(Sender: TObject);
|
|
begin
|
|
FId := TLldbInstructionBreakSet(Sender).BreakId;
|
|
end;
|
|
|
|
procedure TlldbInternalBreakPoint.DoFailed(Sender: TObject);
|
|
begin
|
|
if FId = 0 then
|
|
FId := -1;
|
|
if OnFail <> nil then
|
|
OnFail(Self);
|
|
end;
|
|
|
|
procedure TlldbInternalBreakPoint.DoFinished(Sender: TObject);
|
|
begin
|
|
FDwarfLoadErrors := TLldbInstruction(Sender).DwarfLoadErrors;
|
|
if OnFinish <> nil then
|
|
OnFinish(Self);
|
|
end;
|
|
|
|
constructor TlldbInternalBreakPoint.Create(AName: String;
|
|
ADebugger: TLldbDebugger; ABeforePrologue: Boolean);
|
|
begin
|
|
FName := AName;
|
|
FDebugger := ADebugger;
|
|
FBeforePrologue := ABeforePrologue;
|
|
FId := 0;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TlldbInternalBreakPoint.Destroy;
|
|
begin
|
|
Remove;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TlldbInternalBreakPoint.Enable;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
if FId = 0 then begin
|
|
Instr := TLldbInstructionBreakSet.Create(FName, False, FBeforePrologue);
|
|
Instr.OnSuccess := @BreakSetSuccess;
|
|
Instr.OnFailure := @DoFailed;
|
|
QueueInstruction(Instr);
|
|
exit;
|
|
end;
|
|
|
|
if FId < 0 then begin
|
|
DoFailed(nil);
|
|
exit;
|
|
end;
|
|
|
|
Instr := TLldbInstructionBreakModify.Create(FId, False);
|
|
Instr.OnFailure := @DoFailed;
|
|
QueueInstruction(Instr);
|
|
end;
|
|
|
|
procedure TlldbInternalBreakPoint.Disable;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
if FId <= 0 then
|
|
exit;
|
|
|
|
Instr := TLldbInstructionBreakModify.Create(FId, True);
|
|
Instr.OnFailure := @DoFailed;
|
|
QueueInstruction(Instr);
|
|
end;
|
|
|
|
procedure TlldbInternalBreakPoint.Remove;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
if FId <= 0 then
|
|
exit;
|
|
|
|
Instr := TLldbInstructionBreakDelete.Create(FId);
|
|
QueueInstruction(Instr);
|
|
FId := 0;
|
|
end;
|
|
|
|
{ TLldbDebugger }
|
|
|
|
function TLldbDebugger.LldbRun: Boolean;
|
|
var
|
|
Cmd: TLldbDebuggerCommandRunLaunch;
|
|
begin
|
|
DebugLn(DBG_VERBOSE, '*** Run');
|
|
Result := True;
|
|
|
|
if State in [dsPause, dsInternalPause, dsRun] then begin // dsRun in case of exception
|
|
CommandQueue.CancelForRun;
|
|
LldbStep(saContinue);
|
|
exit;
|
|
end;
|
|
|
|
if State in [dsNone, dsIdle, dsStop] then
|
|
SetState(dsInit);
|
|
|
|
FInIdle := False;
|
|
|
|
DoBeforeLaunch;
|
|
|
|
Cmd := TLldbDebuggerCommandRunLaunch.Create(Self);
|
|
QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoAfterLineReceived(var ALine: String);
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
if ALine = '' then
|
|
exit;
|
|
|
|
FCommandQueue.DoLineDataReceived(ALine);
|
|
if ALine = '' then
|
|
exit;
|
|
|
|
|
|
// Process 8888 exited with status = 0 (0x00000000)
|
|
if (LeftStr(ALine, 8) = 'Process ') and (pos('exited with status = ', ALine) > 0) then begin
|
|
// todo: target delete
|
|
if State <> dsIdle then
|
|
SetState(dsStop);
|
|
ALine := '';
|
|
|
|
Instr := TLldbInstructionTargetDelete.Create();
|
|
FDebugInstructionQueue.QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
exit;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoBeforeLineReceived(var ALine: String);
|
|
begin
|
|
DoDbgOutput(ALine);
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoBeginReceivingLines(Sender: TObject);
|
|
begin
|
|
LockRelease;
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoCmdLineDebuggerTerminated(Sender: TObject);
|
|
begin
|
|
SetState(dsError);
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoLineSentToDbg(Sender: TObject; ALine: String);
|
|
begin
|
|
DoDbgOutput('>> '+ALine);
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoEndReceivingLines(Sender: TObject);
|
|
begin
|
|
UnlockRelease;
|
|
end;
|
|
|
|
function TLldbDebugger.LldbStep(AStepAction: TLldbInstructionProcessStepAction
|
|
): Boolean;
|
|
var
|
|
Cmd: TLldbDebuggerCommandRunStep;
|
|
begin
|
|
Result := True;
|
|
CommandQueue.CancelForRun;
|
|
Cmd := TLldbDebuggerCommandRunStep.Create(Self, AStepAction);
|
|
QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
function TLldbDebugger.LldbStop: Boolean;
|
|
var
|
|
Cmd: TLldbDebuggerCommandStop;
|
|
begin
|
|
DebugLn(DBG_VERBOSE, '*** Stop');
|
|
Result := True;
|
|
|
|
CommandQueue.CancelAll;
|
|
Cmd := TLldbDebuggerCommandStop.Create(Self);
|
|
QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
function TLldbDebugger.LldbPause: Boolean;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
begin
|
|
Result := True;
|
|
Instr := TLldbInstructionProcessInterrupt.Create();
|
|
FDebugInstructionQueue.QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
end;
|
|
|
|
function TLldbDebugger.LldbEvaluate(const AExpression: String;
|
|
EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
|
|
var
|
|
Cmd: TLldbDebuggerCommandEvaluate;
|
|
begin
|
|
Cmd := TLldbDebuggerCommandEvaluate.Create(Self, AExpression, EvalFlags, ACallback);
|
|
QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
Result := True;
|
|
end;
|
|
|
|
function TLldbDebugger.LldbEnvironment(const AVariable: String;
|
|
const ASet: Boolean): Boolean;
|
|
var
|
|
Instr: TLldbInstruction;
|
|
s: String;
|
|
begin
|
|
debugln(DBG_VERBOSE, ['-----------------------------------------', AVariable]);
|
|
if ASet then
|
|
Instr := TLldbInstructionSettingSet.Create('target.env-vars', AVariable, False, True)
|
|
else begin
|
|
s := AVariable;
|
|
Instr := TLldbInstructionSettingRemove.Create('target.env-vars', GetPart([], ['='], s, False, False));
|
|
end;
|
|
|
|
FDebugInstructionQueue.QueueInstruction(Instr);
|
|
Instr.ReleaseReference;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TLldbDebugger.TerminateLldb;
|
|
begin
|
|
if FDebugProcess.DebugProcessRunning then begin
|
|
FDebugProcess.SendCmdLn('process kill');
|
|
FDebugProcess.SendCmdLn('quit');
|
|
Sleep(100);
|
|
end;
|
|
FDebugInstructionQueue.OnDebuggerTerminated := nil; // TODO: use a flag to prevent this
|
|
FDebugProcess.StopDebugProcess;
|
|
FDebugInstructionQueue.OnDebuggerTerminated := @DoCmdLineDebuggerTerminated;
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoBeforeLaunch;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoAfterLaunch(var LaunchWarnings: string);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TLldbDebugger.LockRelease;
|
|
begin
|
|
inherited LockRelease;
|
|
end;
|
|
|
|
procedure TLldbDebugger.UnlockRelease;
|
|
begin
|
|
inherited UnlockRelease;
|
|
end;
|
|
|
|
procedure TLldbDebugger.QueueCommand(const ACommand: TLldbDebuggerCommand);
|
|
begin
|
|
FCommandQueue.QueueCommand(ACommand);
|
|
end;
|
|
|
|
procedure TLldbDebugger.SetErrorState(const AMsg: String; const AInfo: String);
|
|
begin
|
|
inherited SetErrorState(AMsg, AInfo);
|
|
end;
|
|
|
|
procedure TLldbDebugger.DoState(const OldState: TDBGState);
|
|
begin
|
|
inherited DoState(OldState);
|
|
if (State = dsError) then
|
|
TerminateLldb;
|
|
end;
|
|
|
|
function TLldbDebugger.DoExceptionHit(AExcClass, AExcMsg: String): Boolean;
|
|
begin
|
|
if Assigned(EventLogHandler) then
|
|
EventLogHandler.LogCustomEvent(ecDebugger, etExceptionRaised,
|
|
Format('Exception class "%s" at $%.' + IntToStr(TargetWidth div 4) + 'x with message "%s"',
|
|
[AExcClass, FCurrentLocation.Address, AExcMsg]));
|
|
|
|
if Assigned(OnException) then
|
|
OnException(Self, deInternal, AExcClass, FCurrentLocation, AExcMsg, Result) // TODO: Location
|
|
else
|
|
Result := True; // CanContinue
|
|
end;
|
|
|
|
function TLldbDebugger.DoBreakpointHit(BrkId: Integer): Boolean;
|
|
var
|
|
BreakPoint: TLldbBreakPoint;
|
|
begin
|
|
if (BrkId >= 0) then
|
|
BreakPoint := TLldbBreakPoints(BreakPoints).FindById(BrkId)
|
|
else
|
|
BreakPoint := nil;
|
|
|
|
if Assigned(EventLogHandler) then
|
|
EventLogHandler.LogEventBreakPointHit(Breakpoint, FCurrentLocation);
|
|
|
|
if BreakPoint <> nil then begin
|
|
if (BreakPoint.Valid = vsPending) then
|
|
BreakPoint.SetPendingToValid(vsValid);
|
|
|
|
try
|
|
BreakPoint.AddReference;
|
|
|
|
// Important: The Queue must be unlocked
|
|
// BreakPoint.Hit may evaluate stack and expressions
|
|
// SetDebuggerState may evaluate data for Snapshot
|
|
Result := False; // Result;
|
|
BreakPoint.Hit(Result);
|
|
finally
|
|
BreakPoint.ReleaseReference;
|
|
end;
|
|
|
|
end
|
|
else
|
|
if (State = dsRun)
|
|
then begin
|
|
debugln(DBG_VERBOSE, ['********** WARNING: breakpoint hit, but nothing known about it ABreakId=', BrkId]);
|
|
end;
|
|
end;
|
|
|
|
function TLldbDebugger.CreateBreakPoints: TDBGBreakPoints;
|
|
begin
|
|
Result := TLldbBreakPoints.Create(Self, TLldbBreakPoint);
|
|
end;
|
|
|
|
function TLldbDebugger.CreateLocals: TLocalsSupplier;
|
|
begin
|
|
Result := TLldbLocals.Create(Self);
|
|
end;
|
|
|
|
function TLldbDebugger.CreateRegisters: TRegisterSupplier;
|
|
begin
|
|
Result := TLldbRegisterSupplier.Create(Self);
|
|
end;
|
|
|
|
function TLldbDebugger.CreateCallStack: TCallStackSupplier;
|
|
begin
|
|
Result := TLldbCallStack.Create(Self);
|
|
end;
|
|
|
|
function TLldbDebugger.CreateWatches: TWatchesSupplier;
|
|
begin
|
|
Result := TLldbWatches.Create(Self);
|
|
end;
|
|
|
|
function TLldbDebugger.CreateThreads: TThreadsSupplier;
|
|
begin
|
|
Result := TLldbThreads.Create(Self);
|
|
end;
|
|
|
|
function TLldbDebugger.GetTargetWidth: Byte;
|
|
begin
|
|
Result := FTargetWidth;
|
|
end;
|
|
|
|
function TLldbDebugger.GetIsIdle: Boolean;
|
|
begin
|
|
Result := FInIdle or ( (CommandQueue.Count = 0) and (CommandQueue.RunningCommand = nil) );
|
|
end;
|
|
|
|
class function TLldbDebugger.GetSupportedCommands: TDBGCommands;
|
|
begin
|
|
Result := [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOut, dcEvaluate,
|
|
dcStepOverInstr, dcStepIntoInstr, dcPause, dcEnvironment];
|
|
// Result := [dcStepTo, dcAttach, dcDetach, dcJumpto,
|
|
// dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
|
|
// dcSetStackFrame, dcDisassemble
|
|
// ];
|
|
end;
|
|
|
|
function TLldbDebugger.RequestCommand(const ACommand: TDBGCommand;
|
|
const AParams: array of const; const ACallback: TMethod): Boolean;
|
|
var
|
|
EvalFlags: TDBGEvaluateFlags;
|
|
begin
|
|
LockRelease;
|
|
try
|
|
case ACommand of
|
|
dcRun: Result := LldbRun;
|
|
dcPause: Result := LldbPause;
|
|
dcStop: Result := LldbStop;
|
|
dcStepOver: Result := LldbStep(saOver);
|
|
dcStepInto: Result := LldbStep(saInto);
|
|
dcStepOut: Result := LldbStep(saOut);
|
|
dcStepOverInstr: Result := LldbStep(saInsOver);
|
|
dcStepIntoInstr: Result := LldbStep(saInsIn);
|
|
dcEvaluate: begin
|
|
EvalFlags := [];
|
|
if high(AParams) >= 1 then
|
|
EvalFlags := TDBGEvaluateFlags(AParams[1].VInteger);
|
|
Result := LldbEvaluate(String(AParams[0].VAnsiString),
|
|
EvalFlags, TDBGEvaluateResultCallback(ACallback));
|
|
end;
|
|
// dcStepTo: Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
|
|
// dcJumpto: Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
|
|
// dcAttach: Result := GDBAttach(String(AParams[0].VAnsiString));
|
|
// dcDetach: Result := GDBDetach;
|
|
// dcModify: Result := GDBModify(String(AParams[0].VAnsiString), String(AParams[1].VAnsiString));
|
|
dcEnvironment: Result := LldbEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean);
|
|
// dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^),
|
|
// String(AParams[3].VPointer^), String(AParams[4].VPointer^),
|
|
// String(AParams[5].VPointer^), Integer(AParams[6].VPointer^))
|
|
// {%H-};
|
|
end;
|
|
finally
|
|
UnlockRelease;
|
|
end;
|
|
end;
|
|
|
|
class function TLldbDebugger.CreateProperties: TDebuggerProperties;
|
|
begin
|
|
Result := TLldbDebuggerProperties.Create;
|
|
end;
|
|
|
|
class function TLldbDebugger.Caption: String;
|
|
begin
|
|
Result := 'LLDB Debugger (Alpha)';
|
|
end;
|
|
|
|
class function TLldbDebugger.ExePaths: String;
|
|
begin
|
|
{$IFdef MSWindows}
|
|
Result := '';
|
|
{$ELSE}
|
|
Result := '/usr/bin/lldb';
|
|
{$ENDIF}
|
|
end;
|
|
|
|
class function TLldbDebugger.ExePathsMruGroup: TDebuggerClass;
|
|
begin
|
|
Result := TLldbDebugger;
|
|
end;
|
|
|
|
constructor TLldbDebugger.Create(const AExternalDebugger: String);
|
|
begin
|
|
inherited Create(AExternalDebugger);
|
|
FDebugProcess := TDebugProcess.Create(AExternalDebugger);
|
|
FDebugProcess.OnLineSent := @DoLineSentToDbg;
|
|
|
|
FDebugInstructionQueue := TLldbInstructionQueue.Create(FDebugProcess);
|
|
FDebugInstructionQueue.OnBeginLinesReceived := @DoBeginReceivingLines;
|
|
FDebugInstructionQueue.OnEndLinesReceived := @DoEndReceivingLines;
|
|
FDebugInstructionQueue.OnBeforeHandleLineReceived := @DoBeforeLineReceived;
|
|
FDebugInstructionQueue.OnAfterHandleLineReceived := @DoAfterLineReceived;
|
|
FDebugInstructionQueue.OnDebuggerTerminated := @DoCmdLineDebuggerTerminated;
|
|
|
|
FCommandQueue := TLldbDebuggerCommandQueue.Create(Self);
|
|
|
|
FBreakErrorBreak := TlldbInternalBreakPoint.Create('fpc_break_error', Self, True);
|
|
FRunErrorBreak := TlldbInternalBreakPoint.Create('fpc_runerror', Self, True);
|
|
FExceptionBreak := TlldbInternalBreakPoint.Create('fpc_raiseexception', Self, True);
|
|
FPopExceptStack := TlldbInternalBreakPoint.Create('fpc_popaddrstack', Self);
|
|
FCatchesBreak := TlldbInternalBreakPoint.Create('fpc_catches', Self);
|
|
FReRaiseBreak := TlldbInternalBreakPoint.Create('fpc_reraise', Self);
|
|
end;
|
|
|
|
destructor TLldbDebugger.Destroy;
|
|
begin
|
|
debugln(DBG_VERBOSE, ['!!!!!!!!!!!!!!! TLldbDebugger.Destroy ']);
|
|
FBreakErrorBreak.Remove;
|
|
FRunErrorBreak.Remove;
|
|
FExceptionBreak.Remove;
|
|
FPopExceptStack.Remove;
|
|
FCatchesBreak.Remove;
|
|
FReRaiseBreak.Remove;
|
|
FDebugInstructionQueue.LockQueueRun;
|
|
inherited Destroy;
|
|
FBreakErrorBreak.Destroy;
|
|
FRunErrorBreak.Destroy;
|
|
FExceptionBreak.Destroy;
|
|
FPopExceptStack.Destroy;
|
|
FCatchesBreak.Destroy;
|
|
FReRaiseBreak.Destroy;
|
|
FCommandQueue.Destroy;
|
|
FDebugInstructionQueue.Destroy;
|
|
FDebugProcess.Destroy;
|
|
end;
|
|
|
|
procedure TLldbDebugger.Init;
|
|
var
|
|
Cmd: TLldbDebuggerCommandInit;
|
|
begin
|
|
FDebugProcess.CreateDebugProcess('', Environment);
|
|
inherited Init;
|
|
|
|
Cmd := TLldbDebuggerCommandInit.Create(Self);
|
|
QueueCommand(Cmd);
|
|
Cmd.ReleaseReference;
|
|
end;
|
|
|
|
procedure TLldbDebugger.Done;
|
|
begin
|
|
DebugLnEnter(DBG_VERBOSE, '!!! TLldbDebugger.Done;');
|
|
// TODO: cancel all commands
|
|
|
|
TerminateLldb;
|
|
inherited Done;
|
|
DebugLnExit(DBG_VERBOSE, '!!! TLldbDebugger.Done;');
|
|
end;
|
|
|
|
class function TLldbDebugger.RequiredCompilerOpts(ATargetCPU, ATargetOS: String
|
|
): TDebugCompilerRequirements;
|
|
begin
|
|
Result:=[dcrDwarfOnly];
|
|
end;
|
|
|
|
function TLldbDebugger.GetLocation: TDBGLocationRec;
|
|
begin
|
|
Result := FCurrentLocation;
|
|
end;
|
|
|
|
function TLldbDebugger.NeedReset: Boolean;
|
|
begin
|
|
Result := true;
|
|
end;
|
|
|
|
procedure TLldbDebugger.TestCmd(const ACommand: String);
|
|
begin
|
|
FDebugProcess.SendCmdLn(ACommand);
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterDebugger(TLldbDebugger);
|
|
end;
|
|
|
|
initialization
|
|
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
|
|
|
|
end.
|
|
|