mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 09:39:43 +01:00
LazDebuggerFp (pure): Rewrote/refactored ResolveDebugEvent. As much as possible code moved from the os-specific classes to the general classes. Now TDbgProcess and TDbgThread only handle single-stepping and the handling of breakpoints and exceptions. Other commands (like step-line, step-into-line etc) are implemented as childs of TDbgControllerCmd. All specific handling is done in those classes.
git-svn-id: trunk@45590 -
This commit is contained in:
joost
parent
7d00cd341d
commit
843f23eafd
@ -37,9 +37,8 @@ unit FpDbgClasses;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Maps, FpDbgDwarf, FpDbgUtil, FpDbgWinExtra, FpDbgLoader,
|
||||
Classes, SysUtils, Maps, FpDbgDwarf, FpDbgUtil, FpDbgLoader,
|
||||
FpDbgInfo, FpdMemoryTools, LazLoggerBase, LazClasses, DbgIntfBaseTypes, fgl,
|
||||
FpDbgDisasX86,
|
||||
fpDbgSymTableContext,
|
||||
FpDbgDwarfDataClasses;
|
||||
|
||||
@ -130,11 +129,11 @@ type
|
||||
|
||||
TDbgThread = class(TObject)
|
||||
private
|
||||
FNextIsSingleStep: boolean;
|
||||
FProcess: TDbgProcess;
|
||||
FID: Integer;
|
||||
FHandle: THandle;
|
||||
FSingleStepping: Boolean;
|
||||
FStepping: Boolean;
|
||||
FNeedIPDecrement: boolean;
|
||||
function GetRegisterValueList: TDbgRegisterValueList;
|
||||
protected
|
||||
FCallStackEntryList: TDbgCallstackEntryList;
|
||||
@ -144,13 +143,6 @@ type
|
||||
FStoreStepSrcLineNo: integer;
|
||||
FStoreStepStackFrame: TDBGPtr;
|
||||
FStoreStepFuncAddr: TDBGPtr;
|
||||
FHiddenWatchpointInto: integer;
|
||||
FHiddenWatchpointOut: integer;
|
||||
FHiddenBreakpoint: TDbgBreakpoint;
|
||||
FStepOut: boolean;
|
||||
FInto: boolean;
|
||||
FIntoDepth: boolean;
|
||||
procedure StoreStepInfo;
|
||||
procedure LoadRegisterValues; virtual;
|
||||
property Process: TDbgProcess read FProcess;
|
||||
public
|
||||
@ -161,22 +153,13 @@ type
|
||||
function RemoveWatchpoint(AnId: integer): boolean; virtual;
|
||||
procedure PrepareCallStackEntryList(AFrameRequired: Integer = -1); virtual;
|
||||
procedure ClearCallStack;
|
||||
procedure AfterHitBreak;
|
||||
procedure ClearHWBreakpoint;
|
||||
destructor Destroy; override;
|
||||
function SingleStep: Boolean; virtual;
|
||||
function StepLine: Boolean; virtual;
|
||||
function Next: Boolean; virtual;
|
||||
function StepInto: Boolean; virtual;
|
||||
function StepOut: Boolean; virtual;
|
||||
function IntNext: Boolean; virtual;
|
||||
function CompareStepInfo: boolean;
|
||||
procedure StoreStepInfo;
|
||||
property ID: Integer read FID;
|
||||
property Handle: THandle read FHandle;
|
||||
property SingleStepping: boolean read FSingleStepping write FSingleStepping;
|
||||
property Stepping: boolean read FStepping;
|
||||
property NextIsSingleStep: boolean read FNextIsSingleStep write FNextIsSingleStep;
|
||||
property RegisterValueList: TDbgRegisterValueList read GetRegisterValueList;
|
||||
property HiddenBreakpoint: TDbgBreakpoint read FHiddenBreakpoint;
|
||||
property CallStackEntryList: TDbgCallstackEntryList read FCallStackEntryList;
|
||||
end;
|
||||
TDbgThreadClass = class of TDbgThread;
|
||||
@ -280,6 +263,8 @@ type
|
||||
procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
|
||||
// Should create a TDbgThread-instance for the given ThreadIdentifier.
|
||||
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; virtual; abstract;
|
||||
// Should analyse why the debugger has stopped.
|
||||
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;
|
||||
public
|
||||
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory: string; AOnLog: TOnLog): TDbgProcess; virtual;
|
||||
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); virtual;
|
||||
@ -290,6 +275,7 @@ type
|
||||
function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
|
||||
function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
|
||||
function RemoveBreak(const ALocation: TDbgPtr): Boolean;
|
||||
function HasBreak(const ALocation: TDbgPtr): Boolean;
|
||||
procedure RemoveThread(const AID: DWord);
|
||||
procedure Log(const AString: string; const ALogLevel: TFPDLogLevel = dllDebug);
|
||||
procedure Log(const AString: string; const Options: array of const; const ALogLevel: TFPDLogLevel = dllDebug);
|
||||
@ -302,9 +288,9 @@ type
|
||||
function ReadString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: String): Boolean; virtual;
|
||||
function ReadWString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: WideString): Boolean; virtual;
|
||||
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual;
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; virtual;
|
||||
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; virtual; abstract;
|
||||
function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;
|
||||
function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; virtual;
|
||||
|
||||
function AddThread(AThreadIdentifier: THandle): TDbgThread;
|
||||
|
||||
@ -821,11 +807,55 @@ begin
|
||||
result := false;
|
||||
end;
|
||||
|
||||
function TDbgProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
|
||||
function TDbgProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread;
|
||||
SingleStep: boolean): boolean;
|
||||
begin
|
||||
result := false;
|
||||
end;
|
||||
|
||||
function TDbgProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
|
||||
var
|
||||
CurrentAddr: TDBGPtr;
|
||||
begin
|
||||
result := AnalyseDebugEvent(AThread);
|
||||
|
||||
if result = deBreakpoint then
|
||||
begin
|
||||
if assigned(FCurrentBreakpoint) then
|
||||
begin
|
||||
// When a breakpoint has been hit, the debugger always continues with
|
||||
// a single-step to jump over the breakpoint. Thereafter the breakpoint
|
||||
// has to be set again.
|
||||
FCurrentBreakpoint.SetBreak;
|
||||
if not AThread.NextIsSingleStep then
|
||||
// In this case the debugger has to continue. The debugger did only
|
||||
// stop to be able to reset the breakpoint again. It was not a 'normal'
|
||||
// singlestep.
|
||||
result := deInternalContinue;
|
||||
end;
|
||||
|
||||
// Determine the address where the execution has stopped
|
||||
CurrentAddr:=GetInstructionPointerRegisterValue;
|
||||
if not (FMainThread.NextIsSingleStep or assigned(FCurrentBreakpoint)) then
|
||||
begin
|
||||
// The debugger did not stop due to single-stepping, so a breakpoint has
|
||||
// been hit. But breakpoints stop *after* they have been hit. So the
|
||||
// decrement the CurrentAddr.
|
||||
FMainThread.FNeedIPDecrement:=true;
|
||||
dec(CurrentAddr);
|
||||
end
|
||||
else
|
||||
FMainThread.FNeedIPDecrement:=false;
|
||||
FCurrentBreakpoint:=nil;
|
||||
AThread.NextIsSingleStep:=false;
|
||||
|
||||
// Whatever reason there was to change the result to deInternalContinue,
|
||||
// if a breakpoint has been hit, always trigger it...
|
||||
if DoBreak(CurrentAddr, FMainThread.ID) then
|
||||
result := deBreakpoint;
|
||||
end
|
||||
end;
|
||||
|
||||
function TDbgProcess.AddThread(AThreadIdentifier: THandle): TDbgThread;
|
||||
var
|
||||
IsMainThread: boolean;
|
||||
@ -860,6 +890,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgProcess.HasBreak(const ALocation: TDbgPtr): Boolean;
|
||||
begin
|
||||
if FBreakMap = nil then
|
||||
Result := False
|
||||
else
|
||||
result := FBreakMap.HasId(ALocation);
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.RemoveThread(const AID: DWord);
|
||||
begin
|
||||
if FThreadMap = nil then Exit;
|
||||
@ -953,7 +991,6 @@ procedure TDbgProcess.MaskBreakpointsInReadData(const AAdress: TDbgPtr; const AS
|
||||
var
|
||||
BreakLocation: TDBGPtr;
|
||||
Bp: TDbgBreakpoint;
|
||||
DataArr: PByteArray;
|
||||
Iterator: TMapIterator;
|
||||
begin
|
||||
iterator := TMapIterator.Create(FBreakMap);
|
||||
@ -1002,7 +1039,7 @@ begin
|
||||
sym := FProcess.FindSymbol(AnAddr);
|
||||
if assigned(sym) then
|
||||
begin
|
||||
result := (((FStoreStepSrcFilename=sym.FileName) and (FStoreStepSrcLineNo=sym.Line)) or FStepOut) and
|
||||
result := (((FStoreStepSrcFilename=sym.FileName) and (FStoreStepSrcLineNo=sym.Line)) {or FStepOut}) and
|
||||
(FStoreStepFuncAddr=sym.Address.Address);
|
||||
if not result and (FStoreStepFuncAddr<>sym.Address.Address) then
|
||||
begin
|
||||
@ -1012,7 +1049,7 @@ begin
|
||||
// This because when stepping out of a procedure, the first asm-instruction
|
||||
// could still be part of the instruction-line that made the call to the
|
||||
// procedure in the first place.
|
||||
if (sym is TDbgDwarfSymbolBase) and not FInto then
|
||||
if (sym is TDbgDwarfSymbolBase) {and not FInto} then
|
||||
begin
|
||||
CU := TDbgDwarfSymbolBase(sym).CompilationUnit;
|
||||
if cu.GetLineAddress(sym.FileName, sym.Line)<>AnAddr then
|
||||
@ -1047,21 +1084,12 @@ begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
function TDbgThread.IntNext: Boolean;
|
||||
begin
|
||||
result := StepLine;
|
||||
FStepping:=result;
|
||||
end;
|
||||
|
||||
constructor TDbgThread.Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle);
|
||||
begin
|
||||
FID := AID;
|
||||
FHandle := AHandle;
|
||||
FProcess := AProcess;
|
||||
FRegisterValueList:=TDbgRegisterValueList.Create;
|
||||
FHiddenWatchpointInto:=-1;
|
||||
FHiddenWatchpointOut:=-1;
|
||||
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
@ -1072,13 +1100,13 @@ end;
|
||||
|
||||
function TDbgThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
|
||||
begin
|
||||
FProcess.log('Hardware watchpoints are nog available.');
|
||||
FProcess.log('Hardware watchpoints are not available.');
|
||||
result := -1;
|
||||
end;
|
||||
|
||||
function TDbgThread.RemoveWatchpoint(AnId: integer): boolean;
|
||||
begin
|
||||
FProcess.log('Hardware watchpoints are nog available.');
|
||||
FProcess.log('Hardware watchpoints are not available: '+self.classname);
|
||||
result := false;
|
||||
end;
|
||||
|
||||
@ -1132,29 +1160,6 @@ begin
|
||||
FCallStackEntryList.Clear;
|
||||
end;
|
||||
|
||||
procedure TDbgThread.AfterHitBreak;
|
||||
begin
|
||||
FStepping:=false;
|
||||
FInto:=false;
|
||||
FIntoDepth:=false;
|
||||
FStepOut:=false;
|
||||
FreeAndNil(FHiddenBreakpoint);
|
||||
end;
|
||||
|
||||
procedure TDbgThread.ClearHWBreakpoint;
|
||||
begin
|
||||
if FHiddenWatchpointOut>-1 then
|
||||
begin
|
||||
if RemoveWatchpoint(FHiddenWatchpointOut) then
|
||||
FHiddenWatchpointOut:=-1;
|
||||
end;
|
||||
if FHiddenWatchpointInto>-1 then
|
||||
begin
|
||||
if RemoveWatchpoint(FHiddenWatchpointInto) then
|
||||
FHiddenWatchpointInto:=-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TDbgThread.Destroy;
|
||||
begin
|
||||
FProcess.ThreadDestroyed(Self);
|
||||
@ -1164,74 +1169,6 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TDbgThread.SingleStep: Boolean;
|
||||
begin
|
||||
FSingleStepping := True;
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
function TDbgThread.StepLine: Boolean;
|
||||
|
||||
var
|
||||
CodeBin: array[0..20] of byte;
|
||||
p: pointer;
|
||||
ADump,
|
||||
AStatement: string;
|
||||
CallInstr: boolean;
|
||||
|
||||
begin
|
||||
if FInto and FIntoDepth then
|
||||
begin
|
||||
FHiddenWatchpointInto := AddWatchpoint(Process.GetStackPointerRegisterValue-4);
|
||||
FHiddenWatchpointOut := AddWatchpoint(Process.GetStackBasePointerRegisterValue+4);
|
||||
result := (FHiddenWatchpointInto<>-1) and (FHiddenWatchpointOut<>-1);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
CallInstr:=false;
|
||||
if FProcess.ReadData(FProcess.GetInstructionPointerRegisterValue,sizeof(CodeBin),CodeBin) then
|
||||
begin
|
||||
p := @CodeBin;
|
||||
Disassemble(p, FProcess.Mode=dm64, ADump, AStatement);
|
||||
if copy(AStatement,1,4)='call' then
|
||||
CallInstr:=true;
|
||||
end;
|
||||
|
||||
if CallInstr then
|
||||
begin
|
||||
FHiddenBreakpoint := TDbgBreakpoint.Create(FProcess, FProcess.GetInstructionPointerRegisterValue+(PtrUInt(p)-PtrUInt(@codebin)));
|
||||
if FInto then
|
||||
begin
|
||||
FHiddenWatchpointInto := AddWatchpoint(RegisterValueList.FindRegisterByDwarfIndex(4).NumValue-4);
|
||||
FIntoDepth:=true;
|
||||
end;
|
||||
end
|
||||
else
|
||||
SingleStep;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TDbgThread.Next: Boolean;
|
||||
begin
|
||||
StoreStepInfo;
|
||||
result := IntNext;
|
||||
end;
|
||||
|
||||
function TDbgThread.StepInto: Boolean;
|
||||
begin
|
||||
StoreStepInfo;
|
||||
FInto:=true;
|
||||
FIntoDepth:=false;
|
||||
result := IntNext;
|
||||
end;
|
||||
|
||||
function TDbgThread.StepOut: Boolean;
|
||||
begin
|
||||
result := next;
|
||||
FStepOut := result;
|
||||
end;
|
||||
|
||||
{ TDbgBreak }
|
||||
|
||||
constructor TDbgBreakpoint.Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr);
|
||||
@ -1259,7 +1196,10 @@ begin
|
||||
|
||||
if not Process.GetThread(AThreadId, Thread) then Exit;
|
||||
|
||||
Result := Thread.ResetInstructionPointerAfterBreakpoint;
|
||||
if Thread.FNeedIPDecrement then
|
||||
Result := Thread.ResetInstructionPointerAfterBreakpoint
|
||||
else
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
procedure TDbgBreakpoint.ResetBreak;
|
||||
|
||||
@ -8,8 +8,9 @@ uses
|
||||
Classes,
|
||||
SysUtils,
|
||||
Maps,
|
||||
FpDbgUtil,
|
||||
LazLogger,
|
||||
DbgIntfBaseTypes,
|
||||
FpDbgDisasX86,
|
||||
FpDbgClasses;
|
||||
|
||||
type
|
||||
@ -19,6 +20,71 @@ type
|
||||
TOnExceptionEvent = procedure(var continue: boolean; const ExceptionClass, ExceptionMessage: string) of object;
|
||||
TOnProcessExitEvent = procedure(ExitCode: DWord) of object;
|
||||
|
||||
TDbgController = class;
|
||||
|
||||
{ TDbgControllerCmd }
|
||||
|
||||
TDbgControllerCmd = class
|
||||
protected
|
||||
FController: TDbgController;
|
||||
public
|
||||
constructor Create(AController: TDbgController); virtual;
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); virtual; abstract;
|
||||
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); virtual; abstract;
|
||||
end;
|
||||
|
||||
{ TDbgControllerContinueCmd }
|
||||
|
||||
TDbgControllerContinueCmd = class(TDbgControllerCmd)
|
||||
public
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
||||
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
|
||||
end;
|
||||
|
||||
{ TDbgControllerStepIntoInstructionCmd }
|
||||
|
||||
TDbgControllerStepIntoInstructionCmd = class(TDbgControllerCmd)
|
||||
public
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
||||
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
|
||||
end;
|
||||
|
||||
{ TDbgControllerStepOverInstructionCmd }
|
||||
|
||||
TDbgControllerStepOverInstructionCmd = class(TDbgControllerCmd)
|
||||
private
|
||||
FHiddenBreakpoint: TDbgBreakpoint;
|
||||
FIsSet: boolean;
|
||||
public
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
||||
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
|
||||
end;
|
||||
|
||||
{ TDbgControllerStepOverLineCmd }
|
||||
|
||||
TDbgControllerStepOverLineCmd = class(TDbgControllerStepOverInstructionCmd)
|
||||
private
|
||||
FInfoStored: boolean;
|
||||
public
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
||||
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
|
||||
end;
|
||||
|
||||
{ TDbgControllerStepIntoLineCmd }
|
||||
|
||||
TDbgControllerStepIntoLineCmd = class(TDbgControllerCmd)
|
||||
private
|
||||
FInfoStored: boolean;
|
||||
FStoredStackFrame: TDBGPtr;
|
||||
FInto: boolean;
|
||||
FHiddenWatchpointInto: integer;
|
||||
FHiddenWatchpointOut: integer;
|
||||
public
|
||||
constructor Create(AController: TDbgController); override;
|
||||
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
|
||||
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
|
||||
end;
|
||||
|
||||
{ TDbgController }
|
||||
|
||||
TDbgController = class
|
||||
@ -45,12 +111,14 @@ type
|
||||
FMainProcess: TDbgProcess;
|
||||
FCurrentProcess: TDbgProcess;
|
||||
FCurrentThread: TDbgThread;
|
||||
FCommand: TDbgControllerCmd;
|
||||
procedure Log(const AString: string; const ALogLevel: TFPDLogLevel = dllDebug);
|
||||
procedure Log(const AString: string; const Options: array of const; const ALogLevel: TFPDLogLevel = dllDebug);
|
||||
function GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure InitializeCommand(ACommand: TDbgControllerCmd);
|
||||
function Run: boolean;
|
||||
procedure Stop;
|
||||
procedure StepIntoInstr;
|
||||
@ -65,6 +133,7 @@ type
|
||||
property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename;
|
||||
property OnLog: TOnLog read FOnLog write SetOnLog;
|
||||
property CurrentProcess: TDbgProcess read FCurrentProcess;
|
||||
property CurrentThread: TDbgThread read FCurrentThread;
|
||||
property MainProcess: TDbgProcess read FMainProcess;
|
||||
property Params: TStringList read FParams write SetParams;
|
||||
property Environment: TStrings read FEnvironment write SetEnvironment;
|
||||
@ -79,6 +148,177 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
{ TDbgControllerStepIntoLineCmd }
|
||||
|
||||
constructor TDbgControllerStepIntoLineCmd.Create(AController: TDbgController);
|
||||
begin
|
||||
inherited Create(AController);
|
||||
FHiddenWatchpointInto:=-1;
|
||||
FHiddenWatchpointOut:=-1;
|
||||
end;
|
||||
|
||||
procedure TDbgControllerStepIntoLineCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
|
||||
begin
|
||||
if not FInfoStored then
|
||||
begin
|
||||
FInfoStored:=true;
|
||||
FStoredStackFrame:=AProcess.GetStackBasePointerRegisterValue;
|
||||
AThread.StoreStepInfo;
|
||||
end;
|
||||
|
||||
AProcess.Continue(AProcess, AThread, not FInto);
|
||||
end;
|
||||
|
||||
procedure TDbgControllerStepIntoLineCmd.ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean);
|
||||
begin
|
||||
if (FHiddenWatchpointOut<>-1) and FController.FCurrentThread.RemoveWatchpoint(FHiddenWatchpointOut) then
|
||||
FHiddenWatchpointOut:=-1;
|
||||
if (FHiddenWatchpointInto<>-1) and FController.FCurrentThread.RemoveWatchpoint(FHiddenWatchpointInto) then
|
||||
FHiddenWatchpointInto:=-1;
|
||||
|
||||
Handled := false;
|
||||
Finished := (AnEvent<>deInternalContinue);
|
||||
if Finished then
|
||||
begin
|
||||
if FController.FCurrentThread.CompareStepInfo then
|
||||
begin
|
||||
AnEvent:=deInternalContinue;
|
||||
if not FInto and (FStoredStackFrame<>FController.FCurrentProcess.GetStackBasePointerRegisterValue) then
|
||||
begin
|
||||
// A sub-procedure has been called, with no debug-information. Use hadrware-breakpoints instead of single-
|
||||
// stepping for better performance.
|
||||
FInto:=true;
|
||||
end;
|
||||
|
||||
if FInto then
|
||||
begin
|
||||
FHiddenWatchpointInto := FController.FCurrentThread.AddWatchpoint(FController.FCurrentProcess.GetStackPointerRegisterValue-DBGPTRSIZE[FController.FCurrentProcess.Mode]);
|
||||
FHiddenWatchpointOut := FController.FCurrentThread.AddWatchpoint(FController.FCurrentProcess.GetStackBasePointerRegisterValue+DBGPTRSIZE[FController.FCurrentProcess.Mode]);
|
||||
assert((FHiddenWatchpointInto<>-1) and (FHiddenWatchpointOut<>-1));
|
||||
end;
|
||||
|
||||
Finished:=false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgControllerStepOverLineCmd }
|
||||
|
||||
procedure TDbgControllerStepOverLineCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
|
||||
begin
|
||||
if not FInfoStored then
|
||||
begin
|
||||
FInfoStored:=true;
|
||||
AThread.StoreStepInfo;
|
||||
end;
|
||||
|
||||
inherited DoContinue(AProcess, AThread);
|
||||
end;
|
||||
|
||||
procedure TDbgControllerStepOverLineCmd.ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean);
|
||||
begin
|
||||
inherited ResolveEvent(AnEvent, Handled, Finished);
|
||||
if Finished then
|
||||
begin
|
||||
if FController.FCurrentThread.CompareStepInfo then
|
||||
begin
|
||||
AnEvent:=deInternalContinue;
|
||||
FHiddenBreakpoint:=nil;
|
||||
FIsSet:=false;
|
||||
Finished:=false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TDbgControllerStepOverInstructionCmd }
|
||||
|
||||
procedure TDbgControllerStepOverInstructionCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
|
||||
|
||||
var
|
||||
CodeBin: array[0..20] of byte;
|
||||
p: pointer;
|
||||
ADump,
|
||||
AStatement: string;
|
||||
CallInstr: boolean;
|
||||
ALocation: TDbgPtr;
|
||||
|
||||
begin
|
||||
if FIsSet then
|
||||
AProcess.Continue(AProcess, AThread, false)
|
||||
else
|
||||
begin
|
||||
CallInstr:=false;
|
||||
if AProcess.ReadData(aProcess.GetInstructionPointerRegisterValue,sizeof(CodeBin),CodeBin) then
|
||||
begin
|
||||
p := @CodeBin;
|
||||
Disassemble(p, AProcess.Mode=dm64, ADump, AStatement);
|
||||
if copy(AStatement,1,4)='call' then
|
||||
CallInstr:=true;
|
||||
end;
|
||||
|
||||
if CallInstr then
|
||||
begin
|
||||
ALocation := AProcess.GetInstructionPointerRegisterValue+(PtrUInt(p)-PtrUInt(@codebin));
|
||||
if not AProcess.HasBreak(ALocation) then
|
||||
FHiddenBreakpoint := AProcess.AddBreak(ALocation);
|
||||
end;
|
||||
FIsSet:=true;
|
||||
AProcess.Continue(AProcess, AThread, not CallInstr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgControllerStepOverInstructionCmd.ResolveEvent(
|
||||
var AnEvent: TFPDEvent; out Handled, Finished: boolean);
|
||||
begin
|
||||
Handled := false;
|
||||
Finished := (AnEvent<>deInternalContinue);
|
||||
if Finished then
|
||||
begin
|
||||
if assigned(FHiddenBreakpoint) then
|
||||
begin
|
||||
FController.FCurrentProcess.RemoveBreak(FHiddenBreakpoint.Location);
|
||||
FHiddenBreakpoint.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgControllerStepIntoInstructionCmd }
|
||||
|
||||
procedure TDbgControllerStepIntoInstructionCmd.DoContinue(
|
||||
AProcess: TDbgProcess; AThread: TDbgThread);
|
||||
begin
|
||||
AProcess.Continue(AProcess, AThread, True);
|
||||
end;
|
||||
|
||||
procedure TDbgControllerStepIntoInstructionCmd.ResolveEvent(
|
||||
var AnEvent: TFPDEvent; out Handled, Finished: boolean);
|
||||
begin
|
||||
Handled := false;
|
||||
Finished := (AnEvent<>deInternalContinue);
|
||||
end;
|
||||
|
||||
{ TDbgControllerContinueCmd }
|
||||
|
||||
procedure TDbgControllerContinueCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
|
||||
begin
|
||||
AProcess.Continue(AProcess, AThread, False);
|
||||
end;
|
||||
|
||||
procedure TDbgControllerContinueCmd.ResolveEvent(var AnEvent: TFPDEvent; out
|
||||
Handled, Finished: boolean);
|
||||
begin
|
||||
Handled := false;
|
||||
Finished := (AnEvent<>deInternalContinue);
|
||||
end;
|
||||
|
||||
{ TDbgControllerCmd }
|
||||
|
||||
constructor TDbgControllerCmd.Create(AController: TDbgController);
|
||||
begin
|
||||
FController := AController;
|
||||
end;
|
||||
|
||||
{ TDbgController }
|
||||
|
||||
procedure TDbgController.DoOnDebugInfoLoaded(Sender: TObject);
|
||||
@ -119,6 +359,13 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDbgController.InitializeCommand(ACommand: TDbgControllerCmd);
|
||||
begin
|
||||
if assigned(FCommand) then
|
||||
raise exception.create('Prior command not finished yet.');
|
||||
FCommand := ACommand;
|
||||
end;
|
||||
|
||||
function TDbgController.Run: boolean;
|
||||
begin
|
||||
result := False;
|
||||
@ -160,27 +407,27 @@ end;
|
||||
|
||||
procedure TDbgController.StepIntoInstr;
|
||||
begin
|
||||
FCurrentThread.SingleStep;
|
||||
InitializeCommand(TDbgControllerStepIntoInstructionCmd.Create(self));
|
||||
end;
|
||||
|
||||
procedure TDbgController.StepOverInstr;
|
||||
begin
|
||||
FCurrentThread.StepLine;
|
||||
InitializeCommand(TDbgControllerStepOverInstructionCmd.Create(self));
|
||||
end;
|
||||
|
||||
procedure TDbgController.Next;
|
||||
begin
|
||||
FCurrentThread.Next;
|
||||
InitializeCommand(TDbgControllerStepOverLineCmd.Create(self));
|
||||
end;
|
||||
|
||||
procedure TDbgController.Step;
|
||||
begin
|
||||
FCurrentThread.StepInto;
|
||||
InitializeCommand(TDbgControllerStepIntoLineCmd.Create(self));
|
||||
end;
|
||||
|
||||
procedure TDbgController.StepOut;
|
||||
begin
|
||||
FCurrentThread.StepOut;
|
||||
//FCurrentThread.StepOut;
|
||||
end;
|
||||
|
||||
procedure TDbgController.Pause;
|
||||
@ -194,6 +441,8 @@ var
|
||||
AProcessIdentifier: THandle;
|
||||
AThreadIdentifier: THandle;
|
||||
AExit: boolean;
|
||||
IsHandled: boolean;
|
||||
IsFinished: boolean;
|
||||
|
||||
begin
|
||||
AExit:=false;
|
||||
@ -201,8 +450,12 @@ begin
|
||||
if assigned(FCurrentProcess) and not assigned(FMainProcess) then
|
||||
FMainProcess:=FCurrentProcess
|
||||
else
|
||||
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread);
|
||||
|
||||
begin
|
||||
if not assigned(FCommand) then
|
||||
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False)
|
||||
else
|
||||
FCommand.DoContinue(FCurrentProcess, FCurrentThread);
|
||||
end;
|
||||
if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then Continue;
|
||||
|
||||
FCurrentProcess := nil;
|
||||
@ -223,54 +476,42 @@ begin
|
||||
FCurrentThread := FCurrentProcess.AddThread(AThreadIdentifier);
|
||||
|
||||
FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread);
|
||||
if (FPDEvent<>deInternalContinue) and assigned(FCurrentProcess.RunToBreakpoint) then begin
|
||||
FCurrentProcess.ClearRunToBreakpoint;
|
||||
if assigned(FCommand) then
|
||||
FCommand.ResolveEvent(FPDEvent, IsHandled, IsFinished)
|
||||
else
|
||||
begin
|
||||
IsHandled:=false;
|
||||
IsFinished:=false;
|
||||
end;
|
||||
if assigned(FCurrentThread) then
|
||||
begin
|
||||
FCurrentThread.SingleStepping:=false;
|
||||
if not (FPDEvent in [deInternalContinue, deLoadLibrary]) then
|
||||
FCurrentThread.AfterHitBreak;
|
||||
FCurrentThread.ClearHWBreakpoint;
|
||||
end;
|
||||
case FPDEvent of
|
||||
deCreateProcess :
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
deExitProcess :
|
||||
begin
|
||||
if FCurrentProcess = FMainProcess then FMainProcess := nil;
|
||||
FExitCode:=FCurrentProcess.ExitCode;
|
||||
if not IsHandled then
|
||||
begin
|
||||
case FPDEvent of
|
||||
deExitProcess :
|
||||
begin
|
||||
if FCurrentProcess = FMainProcess then FMainProcess := nil;
|
||||
FExitCode:=FCurrentProcess.ExitCode;
|
||||
|
||||
FProcessMap.Delete(AProcessIdentifier);
|
||||
FCurrentProcess.Free;
|
||||
FCurrentProcess := nil;
|
||||
end;
|
||||
{ deLoadLibrary :
|
||||
begin
|
||||
if FCurrentProcess.GetLib(FCurrentProcess.LastEventProcessIdentifier, ALib)
|
||||
and (GImageInfo <> iiNone)
|
||||
then begin
|
||||
WriteLN('Name: ', ALib.Name);
|
||||
//if GImageInfo = iiDetail
|
||||
//then DumpPEImage(Proc.Handle, Lib.BaseAddr);
|
||||
FProcessMap.Delete(AProcessIdentifier);
|
||||
FCurrentProcess.Free;
|
||||
FCurrentProcess := nil;
|
||||
end;
|
||||
if GBreakOnLibraryLoad
|
||||
then GState := dsPause;
|
||||
{ deLoadLibrary :
|
||||
begin
|
||||
if FCurrentProcess.GetLib(FCurrentProcess.LastEventProcessIdentifier, ALib)
|
||||
and (GImageInfo <> iiNone)
|
||||
then begin
|
||||
WriteLN('Name: ', ALib.Name);
|
||||
//if GImageInfo = iiDetail
|
||||
//then DumpPEImage(Proc.Handle, Lib.BaseAddr);
|
||||
end;
|
||||
if GBreakOnLibraryLoad
|
||||
then GState := dsPause;
|
||||
|
||||
end;}
|
||||
deBreakpoint :
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
deInternalContinue,
|
||||
deLoadLibrary:
|
||||
begin
|
||||
if assigned(FCurrentThread) and FCurrentThread.Stepping then
|
||||
FCurrentThread.IntNext;
|
||||
end;
|
||||
end; {case}
|
||||
end;}
|
||||
end; {case}
|
||||
end;
|
||||
if IsFinished then
|
||||
FreeAndNil(FCommand);
|
||||
AExit:=true;
|
||||
until AExit;
|
||||
end;
|
||||
|
||||
@ -63,6 +63,34 @@ type
|
||||
__gs: cuint64;
|
||||
end;
|
||||
|
||||
x86_debug_state32_t = record
|
||||
__dr0: cuint32;
|
||||
__dr1: cuint32;
|
||||
__dr2: cuint32;
|
||||
__dr3: cuint32;
|
||||
__dr4: cuint32;
|
||||
__dr5: cuint32;
|
||||
__dr6: cuint32;
|
||||
__dr7: cuint32;
|
||||
end;
|
||||
|
||||
x86_debug_state64_t = record
|
||||
__dr0: cuint64;
|
||||
__dr1: cuint64;
|
||||
__dr2: cuint64;
|
||||
__dr3: cuint64;
|
||||
__dr4: cuint64;
|
||||
__dr5: cuint64;
|
||||
__dr6: cuint64;
|
||||
__dr7: cuint64;
|
||||
end;
|
||||
|
||||
x86_debug_state = record
|
||||
case a: byte of
|
||||
1: (ds32: x86_debug_state32_t);
|
||||
2: (ds64: x86_debug_state64_t);
|
||||
end;
|
||||
|
||||
type
|
||||
|
||||
{ TDbgDarwinThread }
|
||||
@ -71,11 +99,18 @@ type
|
||||
private
|
||||
FThreadState32: x86_thread_state32_t;
|
||||
FThreadState64: x86_thread_state64_t;
|
||||
FNeedIPDecrement: boolean;
|
||||
FDebugState32: x86_debug_state32_t;
|
||||
FDebugState64: x86_debug_state64_t;
|
||||
FDebugStateRead: boolean;
|
||||
FDebugStateChanged: boolean;
|
||||
protected
|
||||
function ReadThreadState: boolean;
|
||||
function ReadDebugState: boolean;
|
||||
public
|
||||
function ResetInstructionPointerAfterBreakpoint: boolean; override;
|
||||
function AddWatchpoint(AnAddr: TDBGPtr): integer; override;
|
||||
function RemoveWatchpoint(AnId: integer): boolean; override;
|
||||
procedure BeforeContinue; override;
|
||||
procedure LoadRegisterValues; override;
|
||||
end;
|
||||
|
||||
@ -94,6 +129,7 @@ type
|
||||
protected
|
||||
function InitializeLoader: TDbgImageLoader; override;
|
||||
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
|
||||
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
|
||||
public
|
||||
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory: string; AOnLog: TOnLog): TDbgProcess; override;
|
||||
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); override;
|
||||
@ -107,9 +143,9 @@ type
|
||||
function GetStackBasePointerRegisterValue: TDbgPtr; override;
|
||||
procedure TerminateProcess; override;
|
||||
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
|
||||
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
|
||||
function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; override;
|
||||
//function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; override;
|
||||
end;
|
||||
|
||||
procedure RegisterDbgClasses;
|
||||
@ -144,7 +180,7 @@ const
|
||||
x86_EXCEPTION_STATE = 9;
|
||||
x86_DEBUG_STATE32 = 10;
|
||||
x86_DEBUG_STATE64 = 11;
|
||||
x86_DEBUG_STATE = 12;
|
||||
//x86_DEBUG_STATE = 12;
|
||||
THREAD_STATE_NONE = 13;
|
||||
x86_AVX_STATE32 = 16;
|
||||
x86_AVX_STATE64 = 17;
|
||||
@ -152,6 +188,8 @@ const
|
||||
|
||||
x86_THREAD_STATE32_COUNT: mach_msg_Type_number_t = sizeof(x86_thread_state32_t) div sizeof(cint);
|
||||
x86_THREAD_STATE64_COUNT: mach_msg_Type_number_t = sizeof(x86_thread_state64_t) div sizeof(cint);
|
||||
x86_DEBUG_STATE32_COUNT: mach_msg_Type_number_t = sizeof(x86_debug_state32_t) div sizeof(cint);
|
||||
x86_DEBUG_STATE64_COUNT: mach_msg_Type_number_t = sizeof(x86_debug_state64_t) div sizeof(cint);
|
||||
|
||||
function task_for_pid(target_tport: mach_port_name_t; pid: integer; var t: mach_port_name_t): kern_return_t; cdecl external name 'task_for_pid';
|
||||
function mach_task_self: mach_port_name_t; cdecl external name 'mach_task_self';
|
||||
@ -167,6 +205,7 @@ function thread_set_state(target_act: thread_act_t; flavor: thread_state_flavor_
|
||||
procedure RegisterDbgClasses;
|
||||
begin
|
||||
OSDbgClasses.DbgProcessClass:=TDbgDarwinProcess;
|
||||
OSDbgClasses.DbgThreadClass:=TDbgDarwinThread;
|
||||
end;
|
||||
|
||||
Function WIFSTOPPED(Status: Integer): Boolean;
|
||||
@ -196,23 +235,53 @@ begin
|
||||
old_StateCnt:=x86_THREAD_STATE64_COUNT;
|
||||
aKernResult:=thread_get_state(Id,x86_THREAD_STATE64, @FThreadState64,old_StateCnt);
|
||||
end;
|
||||
if aKernResult <> KERN_SUCCESS then
|
||||
result := aKernResult = KERN_SUCCESS;
|
||||
if not result then
|
||||
begin
|
||||
Log('Failed to call thread_get_state for thread %d. Mach error: '+mach_error_string(aKernResult),[Id]);
|
||||
end;
|
||||
FRegisterValueListValid:=false;
|
||||
end;
|
||||
|
||||
function TDbgDarwinThread.ReadDebugState: boolean;
|
||||
var
|
||||
aKernResult: kern_return_t;
|
||||
old_StateCnt: mach_msg_Type_number_t;
|
||||
begin
|
||||
if FDebugStateRead then
|
||||
begin
|
||||
result := true;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if Process.Mode=dm32 then
|
||||
begin
|
||||
old_StateCnt:=x86_DEBUG_STATE32_COUNT;
|
||||
aKernResult:=thread_get_state(ID, x86_DEBUG_STATE32, @FDebugState32, old_StateCnt);
|
||||
end
|
||||
else
|
||||
begin
|
||||
old_StateCnt:=x86_DEBUG_STATE64_COUNT;
|
||||
aKernResult:=thread_get_state(ID, x86_DEBUG_STATE64, @FDebugState64, old_StateCnt);
|
||||
end;
|
||||
if aKernResult <> KERN_SUCCESS then
|
||||
begin
|
||||
Log('Failed to call thread_get_state to ge debug-info for thread %d. Mach error: '+mach_error_string(aKernResult),[Id]);
|
||||
result := false;
|
||||
end
|
||||
else
|
||||
begin
|
||||
result := true;
|
||||
FDebugStateRead:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDarwinThread.ResetInstructionPointerAfterBreakpoint: boolean;
|
||||
var
|
||||
aKernResult: kern_return_t;
|
||||
new_StateCnt: mach_msg_Type_number_t;
|
||||
begin
|
||||
result := true;
|
||||
// If the breakpoint is reached by single-stepping, decrementing the
|
||||
// instruction pointer is not necessary.
|
||||
if not FNeedIPDecrement then
|
||||
Exit;
|
||||
|
||||
if Process.Mode=dm32 then
|
||||
begin
|
||||
@ -233,6 +302,96 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDarwinThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
|
||||
|
||||
function SetBreakpoint(var dr: {$ifdef cpui386}DWORD{$else}DWORD64{$endif}; ind: byte): boolean;
|
||||
begin
|
||||
if (Dr=0) and ((FDebugState32.__dr7 and (1 shl ind))=0) then
|
||||
begin
|
||||
FDebugState32.__dr7 := FDebugState32.__dr7 or (1 shl (ind*2));
|
||||
FDebugState32.__dr7 := FDebugState32.__dr7 or ($30000 shl (ind*4));
|
||||
Dr:=AnAddr;
|
||||
FDebugStateChanged:=true;
|
||||
Result := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
result := -1;
|
||||
if not ReadDebugState then
|
||||
exit;
|
||||
|
||||
if SetBreakpoint(FDebugState32.__dr0, 0) then
|
||||
result := 0
|
||||
else if SetBreakpoint(FDebugState32.__dr1, 1) then
|
||||
result := 1
|
||||
else if SetBreakpoint(FDebugState32.__dr2, 2) then
|
||||
result := 2
|
||||
else if SetBreakpoint(FDebugState32.__dr3, 3) then
|
||||
result := 3
|
||||
else
|
||||
Process.Log('No hardware breakpoint available.');
|
||||
end;
|
||||
|
||||
function TDbgDarwinThread.RemoveWatchpoint(AnId: integer): boolean;
|
||||
|
||||
function RemoveBreakpoint(var dr: {$ifdef cpui386}DWORD{$else}DWORD64{$endif}; ind: byte): boolean;
|
||||
begin
|
||||
if (Dr<>0) and ((FDebugState32.__dr7 and (1 shl (ind*2)))<>0) then
|
||||
begin
|
||||
FDebugState32.__dr7 := FDebugState32.__dr7 xor (1 shl (ind*2));
|
||||
FDebugState32.__dr7 := FDebugState32.__dr7 xor ($30000 shl (ind*4));
|
||||
Dr:=0;
|
||||
FDebugStateChanged:=true;
|
||||
Result := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
result := False;
|
||||
Process.Log('HW watchpoint %d is not set.',[ind]);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
result := false;
|
||||
if not ReadDebugState then
|
||||
exit;
|
||||
|
||||
case AnId of
|
||||
0: result := RemoveBreakpoint(FDebugState32.__dr0, 0);
|
||||
1: result := RemoveBreakpoint(FDebugState32.__dr1, 1);
|
||||
2: result := RemoveBreakpoint(FDebugState32.__dr2, 2);
|
||||
3: result := RemoveBreakpoint(FDebugState32.__dr3, 3);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDarwinThread.BeforeContinue;
|
||||
var
|
||||
aKernResult: kern_return_t;
|
||||
old_StateCnt: mach_msg_Type_number_t;
|
||||
begin
|
||||
if FDebugStateRead and FDebugStateChanged then
|
||||
begin
|
||||
if Process.Mode=dm32 then
|
||||
begin
|
||||
old_StateCnt:=x86_DEBUG_STATE32_COUNT;
|
||||
aKernResult:=thread_set_state(Id, x86_DEBUG_STATE32, @FDebugState32, old_StateCnt);
|
||||
end
|
||||
else
|
||||
begin
|
||||
old_StateCnt:=x86_DEBUG_STATE64_COUNT;
|
||||
aKernResult:=thread_set_state(Id, x86_DEBUG_STATE64, @FDebugState64, old_StateCnt);
|
||||
end;
|
||||
|
||||
if aKernResult <> KERN_SUCCESS then
|
||||
Log('Failed to call thread_set_state for thread %d. Mach error: '+mach_error_string(aKernResult),[Id]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDarwinThread.LoadRegisterValues;
|
||||
begin
|
||||
if Process.Mode=dm32 then with FThreadState32 do
|
||||
@ -324,7 +483,6 @@ end;
|
||||
|
||||
function TDbgDarwinProcess.InitializeLoader: TDbgImageLoader;
|
||||
var
|
||||
FObjFileName: string;
|
||||
dSYMFilename: string;
|
||||
begin
|
||||
// JvdS: Mach-O binaries do not contain DWARF-debug info. Instead this info
|
||||
@ -385,7 +543,6 @@ end;
|
||||
class function TDbgDarwinProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory: string; AOnLog: TOnLog): TDbgProcess;
|
||||
var
|
||||
PID: TPid;
|
||||
stat: longint;
|
||||
AProcess: TProcess;
|
||||
AnExecutabeFilename: string;
|
||||
begin
|
||||
@ -505,7 +662,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDarwinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
|
||||
function TDbgDarwinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;
|
||||
var
|
||||
e: integer;
|
||||
begin
|
||||
@ -514,7 +671,9 @@ begin
|
||||
fpPTrace(PTRACE_CONT, ProcessID, nil, nil);
|
||||
{$endif linux}
|
||||
{$ifdef darwin}
|
||||
if (AThread.SingleStepping) or assigned(FCurrentBreakpoint) then
|
||||
AThread.NextIsSingleStep:=SingleStep;
|
||||
AThread.BeforeContinue;
|
||||
if SingleStep or assigned(FCurrentBreakpoint) then
|
||||
fpPTrace(PTRACE_SINGLESTEP, ProcessID, pointer(1), pointer(FExceptionSignal))
|
||||
else if FIsTerminating then
|
||||
fpPTrace(PTRACE_KILL, ProcessID, pointer(1), nil)
|
||||
@ -524,7 +683,7 @@ begin
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
writeln('Failed to continue process. Errcode: ',e);
|
||||
log('Failed to continue process. Errcode: '+inttostr(e));
|
||||
result := false;
|
||||
end
|
||||
else
|
||||
@ -557,17 +716,13 @@ begin
|
||||
end
|
||||
end;
|
||||
|
||||
function TDbgDarwinProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
|
||||
|
||||
var
|
||||
ExceptionAddr: TDBGPtr;
|
||||
function TDbgDarwinProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
|
||||
|
||||
begin
|
||||
FExceptionSignal:=0;
|
||||
if wifexited(FStatus) or wifsignaled(FStatus) then
|
||||
begin
|
||||
SetExitCode(wexitStatus(FStatus));
|
||||
writeln('Exit');
|
||||
// Clear all pending signals
|
||||
repeat
|
||||
until FpWaitPid(-1, FStatus, WNOHANG)<1;
|
||||
@ -576,7 +731,7 @@ begin
|
||||
end
|
||||
else if WIFSTOPPED(FStatus) then
|
||||
begin
|
||||
writeln('Stopped ',FStatus, ' signal: ',wstopsig(FStatus));
|
||||
//log('Stopped ',FStatus, ' signal: ',wstopsig(FStatus));
|
||||
TDbgDarwinThread(AThread).ReadThreadState;
|
||||
case wstopsig(FStatus) of
|
||||
SIGTRAP:
|
||||
@ -586,29 +741,8 @@ begin
|
||||
result := deCreateProcess;
|
||||
FProcessStarted:=true;
|
||||
end
|
||||
else if assigned(FCurrentBreakpoint) then
|
||||
begin
|
||||
FCurrentBreakpoint.SetBreak;
|
||||
FCurrentBreakpoint:=nil;
|
||||
if FMainThread.SingleStepping then
|
||||
result := deBreakpoint
|
||||
else
|
||||
result := deInternalContinue;
|
||||
end
|
||||
else
|
||||
result := deBreakpoint;
|
||||
|
||||
// Handle the breakpoint also if it is reached by single-stepping.
|
||||
ExceptionAddr:=GetInstructionPointerRegisterValue;
|
||||
if not (FMainThread.SingleStepping or assigned(FCurrentBreakpoint)) then
|
||||
begin
|
||||
TDbgDarwinThread(FMainThread).FNeedIPDecrement:=true;
|
||||
dec(ExceptionAddr);
|
||||
end
|
||||
else
|
||||
TDbgDarwinThread(FMainThread).FNeedIPDecrement:=false;
|
||||
if DoBreak(ExceptionAddr, FMainThread.ID) then
|
||||
result := deBreakpoint;
|
||||
end;
|
||||
SIGBUS:
|
||||
begin
|
||||
|
||||
@ -47,7 +47,7 @@ uses
|
||||
FpDbgWinExtra,
|
||||
strutils,
|
||||
FpDbgInfo,
|
||||
FpDbgLoader, FpdMemoryTools,
|
||||
FpDbgLoader,
|
||||
DbgIntfBaseTypes,
|
||||
LazLoggerBase;
|
||||
|
||||
@ -85,6 +85,7 @@ type
|
||||
FInfo: TCreateProcessDebugInfo;
|
||||
FPauseRequested: boolean;
|
||||
FProcProcess: TProcess;
|
||||
FJustStarted: boolean;
|
||||
function GetFullProcessImageName(AProcessHandle: THandle): string;
|
||||
function GetModuleFileName(AModuleHandle: THandle): string;
|
||||
function GetProcFilename(AProcess: TDbgProcess; lpImageName: LPVOID; fUnicode: word; hFile: handle): string;
|
||||
@ -105,9 +106,9 @@ type
|
||||
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
|
||||
|
||||
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory: string; AOnLog: TOnLog): TDbgProcess; override;
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
|
||||
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
|
||||
function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; override;
|
||||
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
|
||||
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
|
||||
|
||||
procedure StartProcess(const AThreadID: DWORD; const AInfo: TCreateProcessDebugInfo);
|
||||
@ -483,23 +484,23 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TDbgWinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
|
||||
function TDbgWinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread;
|
||||
SingleStep: boolean): boolean;
|
||||
begin
|
||||
if assigned(AThread) then
|
||||
begin
|
||||
AThread.NextIsSingleStep:=SingleStep;
|
||||
if SingleStep or assigned(FCurrentBreakpoint) then
|
||||
TDbgWinThread(AThread).SetSingleStep;
|
||||
AThread.BeforeContinue;
|
||||
end;
|
||||
|
||||
case MDebugEvent.Exception.ExceptionRecord.ExceptionCode of
|
||||
EXCEPTION_BREAKPOINT,
|
||||
EXCEPTION_SINGLE_STEP: begin
|
||||
if assigned(AThread) then begin
|
||||
// The thread is not assigned if the current process is not the main
|
||||
// process. (Only the main process is being 'debugged')
|
||||
if (AThread.SingleStepping) or assigned(FCurrentBreakpoint) then
|
||||
TDbgWinThread(AThread).SetSingleStep;
|
||||
AThread.BeforeContinue;
|
||||
end;
|
||||
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
|
||||
end
|
||||
else begin
|
||||
if assigned(AThread) then
|
||||
AThread.BeforeContinue;
|
||||
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
|
||||
end;
|
||||
end;
|
||||
@ -513,7 +514,7 @@ begin
|
||||
ThreadIdentifier:=MDebugEvent.dwThreadId;
|
||||
end;
|
||||
|
||||
function TDbgWinProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
|
||||
function TDbgWinProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
|
||||
|
||||
procedure HandleException(const AEvent: TDebugEvent);
|
||||
const
|
||||
@ -781,61 +782,16 @@ begin
|
||||
//DumpEvent('EXCEPTION_DEBUG_EVENT');
|
||||
case MDebugEvent.Exception.ExceptionRecord.ExceptionCode of
|
||||
EXCEPTION_BREAKPOINT: begin
|
||||
if DoBreak(TDbgPtr(MDebugEvent.Exception.ExceptionRecord.ExceptionAddress), MDebugEvent.dwThreadId)
|
||||
then
|
||||
result := deBreakpoint
|
||||
else if assigned(AThread) and assigned(AThread.HiddenBreakpoint) then begin
|
||||
AThread.HiddenBreakpoint.Hit(AThread.ID);
|
||||
if AThread.Stepping and AThread.CompareStepInfo then
|
||||
result := deInternalContinue
|
||||
else
|
||||
result := deBreakpoint;
|
||||
end else if FPauseRequested
|
||||
then begin
|
||||
result := deBreakpoint;
|
||||
FPauseRequested:=false;
|
||||
end
|
||||
else begin
|
||||
// Unknown breakpoint.
|
||||
if (MDebugEvent.Exception.dwFirstChance <> 0) and (MDebugEvent.Exception.ExceptionRecord.ExceptionFlags = 0)
|
||||
then begin
|
||||
// First chance and breakpoint is continuable -> silently ignore.
|
||||
result := deInternalContinue
|
||||
end else begin
|
||||
// Or else, show an exception
|
||||
result := deException;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
EXCEPTION_SINGLE_STEP: begin
|
||||
if assigned(FCurrentBreakpoint) then
|
||||
if FJustStarted and (MDebugEvent.Exception.dwFirstChance <> 0) and (MDebugEvent.Exception.ExceptionRecord.ExceptionFlags = 0) then
|
||||
begin
|
||||
FCurrentBreakpoint.SetBreak;
|
||||
FCurrentBreakpoint:=nil;
|
||||
if FMainThread.SingleStepping then
|
||||
result := deBreakpoint
|
||||
else
|
||||
result := deInternalContinue;
|
||||
FJustStarted:=false;
|
||||
result := deInternalContinue;
|
||||
end
|
||||
else
|
||||
result := deBreakpoint;
|
||||
|
||||
if AThread.Stepping then
|
||||
begin
|
||||
if AThread.CompareStepInfo then
|
||||
result := deInternalContinue
|
||||
else
|
||||
result := deBreakpoint;
|
||||
end;
|
||||
|
||||
// If there is a breakpoint on this location, handle the breakpoint.
|
||||
// Or else the int3-interrupt instruction won't be cleared and the
|
||||
// breakpoint will be triggered again. (Notice that the location of
|
||||
// the eip-register does not have to be decremented in this case,
|
||||
// see TDbgWinThread.ResetInstructionPointerAfterBreakpoint)
|
||||
if DoBreak(TDbgPtr(MDebugEvent.Exception.ExceptionRecord.ExceptionAddress), MDebugEvent.dwThreadId)
|
||||
then
|
||||
result := deBreakpoint;
|
||||
end;
|
||||
EXCEPTION_SINGLE_STEP: begin
|
||||
result := deBreakpoint;
|
||||
end
|
||||
else begin
|
||||
HandleException(MDebugEvent);
|
||||
@ -853,6 +809,7 @@ begin
|
||||
CREATE_PROCESS_DEBUG_EVENT: begin
|
||||
//DumpEvent('CREATE_PROCESS_DEBUG_EVENT');
|
||||
StartProcess(MDebugEvent.dwThreadId, MDebugEvent.CreateProcessInfo);
|
||||
FJustStarted := true;
|
||||
result := deCreateProcess;
|
||||
end;
|
||||
EXIT_THREAD_DEBUG_EVENT: begin
|
||||
@ -1082,9 +1039,6 @@ begin
|
||||
end;
|
||||
|
||||
function TDbgWinThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
|
||||
var
|
||||
i: integer;
|
||||
|
||||
function SetBreakpoint(var dr: {$ifdef cpui386}DWORD{$else}DWORD64{$endif}; ind: byte): boolean;
|
||||
begin
|
||||
if (Dr=0) and ((GCurrentContext^.Dr7 and (1 shl ind))=0) then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user