unit FPDbgController; {$mode objfpc}{$H+} {$TYPEDADDRESS on} {$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF} interface uses Classes, SysUtils, Maps, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazClasses, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgDisasX86, FpDbgClasses, FpDbgCallContextInfo, FpDbgUtil, {$ifdef windows} FpDbgWinClasses, {$endif} {$ifdef darwin} FpDbgDarwinClasses, {$endif} {$ifdef linux} FpDbgLinuxClasses, {$endif} FpDbgInfo, FpDbgDwarf, FpdMemoryTools, FpErrorMessages; type TDbgController = class; TDbgControllerCmd = class; TOnCreateProcessEvent = procedure(var continue: boolean) of object; TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TFpDbgBreakpoint; AnEventType: TFPDEvent; AMoreHitEventsPending: Boolean) of object; TOnExceptionEvent = procedure(var continue: boolean; const ExceptionClass, ExceptionMessage: string) of object; TOnProcessExitEvent = procedure(ExitCode: DWord) of object; TOnLibraryLoadedEvent = procedure(var continue: boolean; ALibraryArray: TDbgLibraryArr) of object; TOnLibraryUnloadedEvent = procedure(var continue: boolean; ALibraryArray: TDbgLibraryArr) of object; TOnProcessLoopCycleEvent = procedure(var AFinishLoopAndSendEvents: boolean; var AnEventType: TFPDEvent; var ACurCommand: TDbgControllerCmd; var AnIsFinished: boolean) of object; { TDbgControllerCmd } TDbgControllerCmd = class private procedure SetThread(AValue: TDbgThread); protected FController: TDbgController; FThread: TDbgThread; FProcess: TDbgProcess; FThreadRemoved: boolean; FIsInitialized: Boolean; FNextInstruction: TDbgAsmInstruction; procedure Init; virtual; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); virtual; abstract; public constructor Create(AController: TDbgController); virtual; destructor Destroy; override; procedure DoBeforeLoopStart; function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual; abstract; procedure ResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); function NextInstruction: TDbgAsmInstruction; inline; property Thread: TDbgThread read FThread write SetThread; end; { TDbgControllerContinueCmd } (* Same as no command, but holds the thread that is being debugged / "run" do perform "step to finally/except" *) TDbgControllerContinueCmd = class(TDbgControllerCmd) protected procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; public function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override; end; { TDbgControllerStepIntoInstructionCmd } TDbgControllerStepIntoInstructionCmd = class(TDbgControllerCmd) protected procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; public function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override; end; { TDbgControllerHiddenBreakStepBaseCmd } TDbgControllerHiddenBreakStepBaseCmd = class(TDbgControllerCmd) private FStackFrameInfo: TDbgStackFrameInfo; FHiddenBreakpoint: TFpInternalBreakpoint; FHiddenBreakAddr, FHiddenBreakInstrPtr, FHiddenBreakStackPtrAddr: TDBGPtr; function GetIsSteppedOut: Boolean; protected function IsAtHiddenBreak: Boolean; inline; function HasHiddenBreak: Boolean; inline; function IsAtLastHiddenBreakAddr: Boolean; inline; function IsAtOrOutOfHiddenBreakFrame: Boolean; inline; // Stopped in/out-of the origin frame, maybe by a breakpoint after an exception procedure SetHiddenBreak(AnAddr: TDBGPtr); procedure RemoveHiddenBreak; function CheckForCallAndSetBreak: boolean; // True, if break is newly set procedure InitStackFrameInfo; inline; procedure CallProcessContinue(ASingleStep: boolean; ASkipCheckNextInstr: Boolean = False); procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); virtual; abstract; public destructor Destroy; override; function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override; property StoredStackFrameInfo: TDbgStackFrameInfo read FStackFrameInfo; property IsSteppedOut: Boolean read GetIsSteppedOut; end; { TDbgControllerStepOverInstructionCmd } TDbgControllerStepOverInstructionCmd = class(TDbgControllerHiddenBreakStepBaseCmd) protected procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; end; { TDbgControllerLineStepBaseCmd } TDbgControllerLineStepBaseCmd = class(TDbgControllerHiddenBreakStepBaseCmd) private FWasAtJumpInstruction: Boolean; FStartedInFuncName: String; FStepInfoUpdatedForStepOut, FStepInfoUnavailAfterStepOut: Boolean; FStoreStepInfoAtInit: Boolean; protected procedure Init; override; procedure UpdateThreadStepInfoAfterStepOut(ANextOnlyStopOnStartLine: Boolean); function HasReachedEndLineForStep: boolean; virtual; function HasReachedEndLineOrSteppedOut(ANextOnlyStopOnStartLine: Boolean): boolean; // Call only, if in original frame (or updated frame) procedure StoreWasAtJumpInstruction; function IsAtJumpPad: Boolean; public constructor Create(AController: TDbgController; AStoreStepInfoAtInit: Boolean = False); function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override; property StartedInFuncName: String read FStartedInFuncName; end; { TDbgControllerStepIntoLineCmd } TDbgControllerStepIntoLineCmd = class(TDbgControllerLineStepBaseCmd) private FState: (siSteppingCurrent, siSteppingIn, siSteppingNested, siRunningStepOut); FStepCount, FNestDepth: Integer; protected procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; public constructor Create(AController: TDbgController); end; { TDbgControllerStepOverLineCmd } TDbgControllerStepOverLineCmd = class(TDbgControllerLineStepBaseCmd) protected procedure Init; override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; public constructor Create(AController: TDbgController); end; { TDbgControllerCallRoutineCmd } // This command is used to call a function of the debugee. // First the state of the debugee is preserved, then the function is // called from the current location of the instruction pointer and afterwards // the debugee is restored into the original state. // The provided context is used to store the register values just after // the call has been made. This way it is possible to evaluate expressions to // gather the function-result, using this context. TDbgControllerCallRoutineCmd = class(TDbgControllerCmd) protected // Calling the function is done in two steps: // - first execute one instruction so that the debugee jumps into the function (sSingleStep) // - then run until the function has been completed (sRunRoutine) type TStep = (sSingleStepInto, sRunRoutine, sSingleStepOver); protected FOriginalCode: array of byte; FOriginalInstructionPointer: TDBGPtr; FNewCodeAddress, FReturnAddress, FReturnStackPointer: TDBGPtr; FRoutineAddress: TDBGPtr; FStep: TStep; FHiddenBreakpoint: TFpInternalBreakpoint; FCallContext: TFpDbgInfoCallContext; FHasOrigCodeRead, FHasInstPtr: Boolean; FInitError: Boolean; procedure Init; override; procedure InsertCallInstructionCode; procedure RestoreOriginalCode; procedure SetHiddenBreakpointAtReturnAddress(AnAddress: TDBGPtr); procedure RemoveHiddenBreakpointAtReturnAddress(); procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; procedure StoreInstructionPointer; procedure RestoreInstructionPointer; procedure StoreRoutineResult; procedure StoreRegisters; procedure RestoreRegisters; procedure HandleUnrecoverable; procedure RestoreState; public constructor Create(AController: TDbgController; const ARoutineAddress: TFpDbgMemLocation; ACallContext:TFpDbgInfoCallContext); destructor Destroy; override; function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override; end; { TDbgControllerStepOutCmd } TDbgControllerStepOutCmd = class(TDbgControllerLineStepBaseCmd) // TODO: do not store the initial line info private FStepCount: Integer; FWasOutsideFrame: boolean; protected function GetOutsideFrame(var AnOutside: Boolean): Boolean; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; public procedure SetReturnAdressBreakpoint(AProcess: TDbgProcess; AnOutsideFrame: Boolean); end; { TDbgControllerRunToCmd } TDbgControllerRunToCmd = class(TDbgControllerHiddenBreakStepBaseCmd) private FLocation: TDBGPtrArray; protected procedure Init; override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; public constructor Create(AController: TDbgController; ALocation: TDBGPtrArray); end; { TDbgControllerStepToCmd } TDbgControllerStepToCmd = class(TDbgControllerLineStepBaseCmd) private FTargetFilename: String; FTargetLineNumber: Integer; FTargetExists: Boolean; FStoreStepStartAddr, FStoreStepEndAddr: TDBGPtr; protected procedure Init; override; function HasReachedEndLineForStep: boolean; override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; public constructor Create(AController: TDbgController; const ATargetFilename: String; ATargetLineNumber: Integer); end; { TDbgController } TDbgController = class private FLastError: TFpError; FMemManager: TFpDbgMemManager; FDefaultContext: TFpDbgLocationContext; FStoredDefaultContext: TFpDbgLocationContext; // while function eval calling FOnLibraryLoadedEvent: TOnLibraryLoadedEvent; FOnLibraryUnloadedEvent: TOnLibraryUnloadedEvent; FOnThreadBeforeProcessLoop: TNotifyEvent; FOnThreadDebugOutputEvent: TDebugOutputEvent; FOnThreadProcessLoopCycleEvent: TOnProcessLoopCycleEvent; FOsDbgClasses: TOSDbgClasses; FRunning, FPauseRequest: cardinal; FAttachToPid: Integer; FDetaching: cardinal; FEnvironment: TStrings; FExecutableFilename: string; FForceNewConsoleWin: boolean; FNextOnlyStopOnStartLine: boolean; FOnCreateProcessEvent: TOnCreateProcessEvent; FOnDebugInfoLoaded: TNotifyEvent; FOnExceptionEvent: TOnExceptionEvent; FOnHitBreakpointEvent: TOnHitBreakpointEvent; FOnProcessExitEvent: TOnProcessExitEvent; FProcessMap: TMap; FPDEvent: TFPDEvent; FParams: TStringList; FConsoleTty: string; FRedirectConsoleOutput: boolean; FWorkingDirectory: string; // This only holds a reference to the LazDebugger instance FProcessConfig: TDbgProcessConfig; function GetCurrentThreadId: Integer; function GetDefaultContext: TFpDbgLocationContext; procedure SetCurrentThreadId(AValue: Integer); procedure SetEnvironment(AValue: TStrings); procedure SetExecutableFilename(const AValue: string); procedure DoOnDebugInfoLoaded(Sender: TObject); procedure SetOnThreadDebugOutputEvent(AValue: TDebugOutputEvent); procedure SetParams(AValue: TStringList); procedure CheckExecutableAndLoadClasses; protected FMainProcess: TDbgProcess; FCurrentProcess: TDbgProcess; FCurrentThread: TDbgThread; FCommand, FCommandToBeFreed: TDbgControllerCmd; function GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean; public constructor Create(AMemManager: TFpDbgMemManager); virtual; destructor Destroy; override; (* InitializeCommand: set new command Not called if command is replaced by OnThreadProcessLoopCycleEvent *) procedure InitializeCommand(ACommand: TDbgControllerCmd); procedure AbortCurrentCommand(AForce: Boolean = False); // AForce: either if in debug-thread, or if thread not needed function Run: boolean; procedure Stop; procedure &ContinueRun; procedure StepIntoInstr; procedure StepOverInstr; procedure Next; procedure Step; function Call(const FunctionAddress: TFpDbgMemLocation; const ABaseContext: TFpDbgLocationContext; const AMemReader: TFpDbgMemReaderBase; const AMemConverter: TFpDbgMemConvertor): TFpDbgInfoCallContext; procedure StepOut(AForceStoreStepInfo: Boolean = False); function Pause: boolean; function Detach: boolean; procedure ProcessLoop; procedure SendEvents(out continue: boolean); property CurrentCommand: TDbgControllerCmd read FCommand; property OsDbgClasses: TOSDbgClasses read FOsDbgClasses; property MemManager: TFpDbgMemManager read FMemManager; property DefaultContext: TFpDbgLocationContext read GetDefaultContext; // CurrentThread, TopStackFrame property LastError: TFpError read FLastError; property Event: TFPDEvent read FPDEvent; property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename; property AttachToPid: Integer read FAttachToPid write FAttachToPid; property CurrentProcess: TDbgProcess read FCurrentProcess; property CurrentThread: TDbgThread read FCurrentThread; property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId; property MainProcess: TDbgProcess read FMainProcess; property Params: TStringList read FParams write SetParams; property Environment: TStrings read FEnvironment write SetEnvironment; property WorkingDirectory: string read FWorkingDirectory write FWorkingDirectory; property RedirectConsoleOutput: boolean read FRedirectConsoleOutput write FRedirectConsoleOutput; property ForceNewConsoleWin: boolean read FForceNewConsoleWin write FForceNewConsoleWin; // windows only property ConsoleTty: string read FConsoleTty write FConsoleTty; // With this parameter set a 'next' will only stop if the current // instruction is the first instruction of a line according to the // debuginfo. // Due to a bug in fpc's debug-info, the line info for the first instruction // of a line, sometimes points the the prior line. This setting hides the // results of that bug. It seems like it that GDB does something similar. property NextOnlyStopOnStartLine: boolean read FNextOnlyStopOnStartLine write FNextOnlyStopOnStartLine; property OnCreateProcessEvent: TOnCreateProcessEvent read FOnCreateProcessEvent write FOnCreateProcessEvent; (* OnHitBreakpointEvent( var continue: boolean; // Passed in value always defaults to false. // Returned value indicated, if the debugger should continue running. // I.e., the current Command (e.g. Stepping) will be kept for continuation, if possible. // Returned value may be ignored (treated as "False") where indicated. const Breakpoint: TFpDbgBreakpoint; // Break or Watch, if avail AnEventType: TFPDEvent; // reason: See below AMoreHitEventsPending: Boolean // The debugger stopped for more than one reason. // There will be further calls to OnHitBreakpointEvent // This will NOT be set for the final "pause-requested" event. ) will be called as follows. Currently only ONE watchpoint, and only ONE breakpoint can be reported. This may change. 1) Step In/Over/Out ended. - Up to THREE calls may be made. (A 4th call for "pause-request" may also happen) - The value for "continue" will be ignored. (The value of "continue" from the final call will however affect, if a call for "pause-request" is made) * If the step ended at a breakpoint and/or triggered a watchpoint additional calls are made upfront. The debugger should handle the break/watchpoint, but not yet pause. => OnHitBreakpointEvent(Continue, WatchPoint, deFinishedStep, True); => OnHitBreakpointEvent(Continue, BreakPoint, deFinishedStep, True); * ALWAYS for the ended step => OnHitBreakpointEvent(Continue, nil, deFinishedStep, False); 2) BreakPoint/WatchPoint/HardcodedBreakPoint was hit. - Up to THREE calls may be made. (A 4th call for "pause-request" may also happen) - The value for "continue" after each call will be be kept, and passed to each subsequent call. * For a hardcoded-BreakPoint (int3) => OnHitBreakpointEvent(Continue, nil, deHardCodedBreakpoint, True_If_More_events); * For a WatchPoint => OnHitBreakpointEvent(Continue, WatchPoint, deBreakpoint, True_If_More_events); * For a BreakPoint => OnHitBreakpointEvent(Continue, BreakPoint, deBreakpoint, False); 3) If there was a pause request (TDbgController.Pause). This call to OnHitBreakpointEvent can happen after any event. That is this can happen, after a step or breakpoint was reported according to the above details. But it can also happen after an exceptedion or other event. (except deExitProcess). This call will only be made, if any prior call returned "continue = true". => OnHitBreakpointEvent(Continue, nil, deInternalContinue, False); *) property OnHitBreakpointEvent: TOnHitBreakpointEvent read FOnHitBreakpointEvent write FOnHitBreakpointEvent; property OnProcessExitEvent: TOnProcessExitEvent read FOnProcessExitEvent write FOnProcessExitEvent; property OnExceptionEvent: TOnExceptionEvent read FOnExceptionEvent write FOnExceptionEvent; property OnDebugInfoLoaded: TNotifyEvent read FOnDebugInfoLoaded write FOnDebugInfoLoaded; property OnLibraryLoadedEvent: TOnLibraryLoadedEvent read FOnLibraryLoadedEvent write FOnLibraryLoadedEvent; property OnLibraryUnloadedEvent: TOnLibraryUnloadedEvent read FOnLibraryUnloadedEvent write FOnLibraryUnloadedEvent; (* Events fired inside the debug thread. The "continue" param, is true by default. It is treated as: "continue to sent this event in procedure "SendEvents" By setting "continue" to false, the event can be hidden. That is, the debug thread will not interrupt for "SendEvents" *) property OnThreadBeforeProcessLoop: TNotifyEvent read FOnThreadBeforeProcessLoop write FOnThreadBeforeProcessLoop; property OnThreadProcessLoopCycleEvent: TOnProcessLoopCycleEvent read FOnThreadProcessLoopCycleEvent write FOnThreadProcessLoopCycleEvent; property OnThreadDebugOutputEvent: TDebugOutputEvent read FOnThreadDebugOutputEvent write SetOnThreadDebugOutputEvent; // Intermediate between FpDebugger and TDbgProcess. Created by FPDebugger, so not owned by controller property ProcessConfig: TDbgProcessConfig read FProcessConfig write FProcessConfig; end; implementation uses FpImgReaderBase, FpDbgCommon; var DBG_VERBOSE, DBG_WARNINGS, FPDBG_COMMANDS, FPDBG_FUNCCALL: PLazLoggerLogGroup; { TDbgControllerCallRoutineCmd } constructor TDbgControllerCallRoutineCmd.Create(AController: TDbgController; const ARoutineAddress: TFpDbgMemLocation; ACallContext: TFpDbgInfoCallContext ); begin inherited Create(AController); {$IFNDEF Linux} {$IFNDEF Windows} raise Exception.Create('Calling functions is only supported on Linux'); {$ENDIF} {$ENDIF} FRoutineAddress := LocToAddr(ARoutineAddress); FCallContext := ACallContext; StoreRegisters; end; destructor TDbgControllerCallRoutineCmd.Destroy; begin ReleaseRefAndNil(FController.FStoredDefaultContext); RemoveHiddenBreakpointAtReturnAddress; inherited Destroy; end; procedure TDbgControllerCallRoutineCmd.Init; begin debugln(FPDBG_FUNCCALL, ['CallRoutine INIT - Cmd.Init - ProcessLoop starts']); inherited Init; FController.FStoredDefaultContext := FController.FDefaultContext; if FController.FStoredDefaultContext <> nil then FController.FStoredDefaultContext.AddReference; FStep := sSingleStepInto; StoreInstructionPointer; if not FCallContext.WriteStack then begin FInitError := True; exit; end; InsertCallInstructionCode; end; procedure TDbgControllerCallRoutineCmd.InsertCallInstructionCode; const TEMP_CODE_LEN = 5; // is the size of the instruction we are about to add. var InsertAddr : TDBGPtr; Buf: array [0..TEMP_CODE_LEN] of Byte; RelAddr: Int32; DW: PInt32; begin // Get the address of the current instruction. InsertAddr := FController.CurrentThread.GetInstructionPointerRegisterValue; FReturnStackPointer := FController.CurrentThread.GetStackPointerRegisterValue; // Store the address where the debugee should return at after the function // finished. It is used to determine if the call has been completed succesfully. FReturnAddress := InsertAddr; // Insert 5 bytes before InsertAddr := InsertAddr - TEMP_CODE_LEN; FNewCodeAddress := InsertAddr; // Store the original code of the current instruction (* TODO: if there is an error, try using: Current_IP + len_of_instr_at_IP - TEMP_CODE_LEN Ensure the breakpoint at FReturnAddress is at the start of an intruction *) SetLength(FOriginalCode, TEMP_CODE_LEN); if not FProcess.ReadData(InsertAddr, TEMP_CODE_LEN, FOriginalCode[0]) then begin FCallContext.SetError('Failed to read code from mem'); FInitError := True; exit; end; FHasOrigCodeRead := True; // Calculate the relative offset between the address of the current instruction // and the address of the function we want to call. {$PUSH}{$Q-}{$R-} if Abs(Int64(FRoutineAddress-(InsertAddr+TEMP_CODE_LEN))) >= High(Int32) then begin FCallContext.SetError('Calling this function is not supported. Offset to the function that is to be called is too high.'); FInitError := True; exit; end; RelAddr := Int64(FRoutineAddress-(InsertAddr+TEMP_CODE_LEN)); // TEMP_CODE_LEN is the size of the instruction we are about to add. {$POP} // Construct the code to call the function. Buf[0] := $e8; // CALL DW := pointer(@Buf[1]); DW^ := RelAddr; // Overwrite the current code with the new code to call the function if not FProcess.WriteInstructionCode(InsertAddr, TEMP_CODE_LEN, Buf[0]) then begin FCallContext.SetError('Failed to write code to mem'); FInitError := True; exit; end; FController.CurrentThread.SetInstructionPointerRegisterValue(InsertAddr); end; function TDbgControllerCallRoutineCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; begin Result := not FInitError; if not Result then begin // Code and InstrPtr should not be modified yet. RestoreState; exit; end; case FStep of sSingleStepInto, sSingleStepOver: AProcess.Continue(AProcess, AThread, True); // Single step into the function sRunRoutine: AProcess.Continue(AProcess, AThread, False); // Continue running the function end; end; procedure TDbgControllerCallRoutineCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); var CurrentIP: TDBGPtr; ACanCont: Boolean; begin if FInitError then begin assert(False, 'TDbgControllerCallRoutineCmd.DoResolveEvent: False / should never be here'); if not IsError(FCallContext.LastError) then FCallContext.SetError('Failed to setup call'); FThread.ClearExceptionSignal; RestoreState; Finished := True; exit; end; case FStep of sSingleStepInto: begin // The debugee is in the routine now. Restore the original code. // (Remove the code that made the debugee jump into this routine) RestoreOriginalCode; // Set a breakpoint at the return-adres, so the debugee stops when the // routine has been completed. if AnEvent=deBreakpoint then begin SetHiddenBreakpointAtReturnAddress(FReturnAddress); AnEvent := deInternalContinue; Finished := false; FStep := sRunRoutine; end else begin assert(False, 'TDbgControllerCallRoutineCmd.DoResolveEvent: False / failed single step, should never happen'); FCallContext.SetError('Failed to make call'); FThread.ClearExceptionSignal; RestoreState; Finished := True; end; end; sSingleStepOver: begin FStep := sRunRoutine; if AnEvent=deBreakpoint then begin AnEvent := deInternalContinue; Finished := false; end else begin assert(False, 'TDbgControllerCallRoutineCmd.DoResolveEvent: False / failed single step, should never happen'); FCallContext.SetError('Failed to make call'); FThread.ClearExceptionSignal; RestoreState; Finished := True; end; end; sRunRoutine: begin // Now the debugee has stopped while running the routine. if AnEvent in [deInternalContinue, deLoadLibrary, deUnloadLibrary] then begin AnEvent := deInternalContinue; Finished := false; exit; end; if not (AnEvent in [deException, deBreakpoint, deHardCodedBreakpoint, deExitProcess]) then begin //deCreateProcess, deFinishedStep // Bail out. It can be anything, even deExitProcess. Maybe that handling // some events can be implemented somewhere in the future. FCallContext.SetError('Internal error'); HandleUnrecoverable; Finished := True; Exit; end; CurrentIP := FController.CurrentThread.GetInstructionPointerRegisterValue; if CurrentIP<>FReturnAddress then begin // If we are not at the return-adres, the debugee has stopped due to some // unforeseen reason. Skip setting up the call-context, but assign an // error instead. if (AnEvent = deBreakpoint) and (FProcess.CurrentBreakpoint <> nil) then begin ACanCont := False; if FCallContext.OnCallRoutineHitBreapoint <> nil then FCallContext.OnCallRoutineHitBreapoint(CurrentIP, ACanCont); if ACanCont then begin AnEvent := deInternalContinue; Finished := false; FStep := sSingleStepOver; // step over breakpoint exit; end else begin FCallContext.SetError('The function stopped unexpectedly. (Breakpoint, Exception, etc)'); end; end else if (AnEvent in [deHardCodedBreakpoint, deExitProcess]) then // Note that deBreakpoint does not necessarily mean that it it stopped // at an actual breakpoint. FCallContext.SetError('The function stopped unexpectedly. (Breakpoint, Exception, etc)') else begin // Clear any (pending) signals that were sent to the application during // the function-call. AnEventThread.ClearExceptionSignal; FCallContext.SetError('The function stopped due to an exception.') end; end else begin if (FThread.GetStackPointerRegisterValue < FReturnStackPointer) then begin // TODO: check for FCurrentProcess.CurrentBreakpoint ?? // in recursion AnEvent := deInternalContinue; Finished := false; FStep := sSingleStepOver; // step over breakpoint exit; end; end; // We are at the return-adres. (Phew...) // Store the necessary data into the context to obtain the function-result // later StoreRoutineResult(); //remove the hidden breakpoint. RemoveHiddenBreakpointAtReturnAddress; // Restore the debugee in the original state. So debugging can continue... RestoreState; Finished := true; end else begin RestoreState; Finished := True; end end; end; procedure TDbgControllerCallRoutineCmd.RestoreOriginalCode; begin debugln(FPDBG_FUNCCALL, ['CallRoutine -- << Restore orig Code']); if not FHasOrigCodeRead then exit; FHasOrigCodeRead := False; if not FProcess.WriteInstructionCode(FNewCodeAddress, Length(FOriginalCode), FOriginalCode[0]) then begin // There is no recovery from here. Attempt to exti somewhat graceful HandleUnrecoverable; FCallContext.SetError('Failed to restore target app after call. Terminating'); end; end; procedure TDbgControllerCallRoutineCmd.SetHiddenBreakpointAtReturnAddress(AnAddress: TDBGPtr); begin assert(FHiddenBreakpoint = nil, 'TDbgControllerCallRoutineCmd.SetHiddenBreakpointAtReturnAddress: FHiddenBreakpoint = nil'); FHiddenBreakpoint.Free; FHiddenBreakpoint := FProcess.AddInternalBreak(AnAddress); end; procedure TDbgControllerCallRoutineCmd.StoreInstructionPointer; begin debugln(FPDBG_FUNCCALL, ['CallRoutine -- >> Store IP']); FOriginalInstructionPointer := FController.CurrentThread.GetInstructionPointerRegisterValue; FHasInstPtr := True; end; procedure TDbgControllerCallRoutineCmd.RestoreInstructionPointer; begin if not FHasInstPtr then exit; debugln(FPDBG_FUNCCALL, ['CallRoutine -- << Restore IP']); {$ifdef cpui386} FController.CurrentThread.SetRegisterValue('eip', FOriginalInstructionPointer); {$else} if FController.CurrentProcess.Mode <> dm64 then FController.CurrentThread.SetRegisterValue('eip', FOriginalInstructionPointer) else FController.CurrentThread.SetRegisterValue('rip', FOriginalInstructionPointer); {$endif} end; procedure TDbgControllerCallRoutineCmd.StoreRoutineResult; begin FCallContext.SetRegisterValue(0, FController.CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(0).NumValue); end; procedure TDbgControllerCallRoutineCmd.RestoreRegisters; begin debugln(FPDBG_FUNCCALL, ['CallRoutine -- << RestoreRegisters']); FController.CurrentThread.RestoreRegisters; end; procedure TDbgControllerCallRoutineCmd.HandleUnrecoverable; begin // There is no recovery from here. Attempt to exti somewhat graceful FController.Stop; FProcess.TerminateProcess; end; procedure TDbgControllerCallRoutineCmd.RestoreState; begin ReleaseRefAndNil(FController.FStoredDefaultContext); try RestoreOriginalCode; RestoreInstructionPointer(); RestoreRegisters(); except HandleUnrecoverable; end; end; procedure TDbgControllerCallRoutineCmd.RemoveHiddenBreakpointAtReturnAddress(); begin FreeAndNil(FHiddenBreakpoint); end; procedure TDbgControllerCallRoutineCmd.StoreRegisters; begin debugln(FPDBG_FUNCCALL, ['CallRoutine -- >> StoreRegisters']); FController.CurrentThread.StoreRegisters; end; { TDbgControllerCmd } procedure TDbgControllerCmd.SetThread(AValue: TDbgThread); begin if FThread = AValue then Exit; FThread := AValue; if AValue = nil then FThreadRemoved := True; // Only get here if FThread was <> nil; end; procedure TDbgControllerCmd.Init; begin // end; constructor TDbgControllerCmd.Create(AController: TDbgController); begin FController := AController; FProcess := FController.CurrentProcess; FThread := FController.CurrentThread; end; destructor TDbgControllerCmd.Destroy; begin inherited Destroy; ReleaseRefAndNil(FNextInstruction); end; procedure TDbgControllerCmd.DoBeforeLoopStart; begin if not FIsInitialized then Init; FIsInitialized := True; end; procedure TDbgControllerCmd.ResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); var dummy: TDbgThread; begin ReleaseRefAndNil(FNextInstruction); // instruction from last pause Finished := FThreadRemoved; if Finished then exit; if AnEventThread = nil then exit; if FThread <> nil then begin // ResolveDebugEvent will have removed the thread, but not yet destroyed it // Finish, if the thread has gone. FThreadRemoved := (not FProcess.GetThread(FThread.ID, dummy)) or (FThread <> dummy); Finished := FThreadRemoved; if Finished then exit; // Only react to events for the correct thread. (Otherwise return Finished = False) if FThread <> AnEventThread then exit; end; DoResolveEvent(AnEvent, AnEventThread, Finished); end; function TDbgControllerCmd.NextInstruction: TDbgAsmInstruction; begin if FNextInstruction = nil then begin FNextInstruction := FProcess.Disassembler.GetInstructionInfo(FThread.GetInstructionPointerRegisterValue); FNextInstruction.AddReference; end; Result := FNextInstruction; end; { TDbgControllerContinueCmd } function TDbgControllerContinueCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; begin assert(FProcess=AProcess, 'TDbgControllerContinueCmd.DoContinue: FProcess=AProcess'); AProcess.Continue(AProcess, AThread, False); Result := True; end; procedure TDbgControllerContinueCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); begin Finished := False; end; { TDbgControllerStepIntoInstructionCmd } function TDbgControllerStepIntoInstructionCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; begin assert(FProcess=AProcess, 'TDbgControllerStepIntoInstructionCmd.DoContinue: FProcess=AProcess'); FProcess.Continue(FProcess, FThread, True); Result := True; end; procedure TDbgControllerStepIntoInstructionCmd.DoResolveEvent( var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); begin Finished := (AnEvent<>deInternalContinue); if Finished then AnEvent := deFinishedStep; end; { TDbgControllerHiddenBreakStepBaseCmd } function TDbgControllerHiddenBreakStepBaseCmd.GetIsSteppedOut: Boolean; begin Result := (FStackFrameInfo <> nil) and FStackFrameInfo.HasSteppedOut; end; function TDbgControllerHiddenBreakStepBaseCmd.IsAtHiddenBreak: Boolean; begin Result := (FHiddenBreakpoint <> nil) and (FThread.GetInstructionPointerRegisterValue = FHiddenBreakAddr) and // FHiddenBreakpoint.HasLocation() (FThread.GetStackPointerRegisterValue >= FHiddenBreakStackPtrAddr); // if SP > FStackPtrRegVal >> then the brk was hit stepped out (should not happen) debugln(FPDBG_COMMANDS and Result, ['BreakStepBaseCmd.IsAtHiddenBreak: At Hidden break = true']); end; function TDbgControllerHiddenBreakStepBaseCmd.HasHiddenBreak: Boolean; begin Result := FHiddenBreakpoint <> nil; end; function TDbgControllerHiddenBreakStepBaseCmd.IsAtLastHiddenBreakAddr: Boolean; begin Result := (FThread.GetInstructionPointerRegisterValue = FHiddenBreakAddr); debugln(FPDBG_COMMANDS and Result, ['BreakStepBaseCmd.IsAtLastHiddenBreakAddr : At LAST Hidden break ADDR = true']); end; function TDbgControllerHiddenBreakStepBaseCmd.IsAtOrOutOfHiddenBreakFrame: Boolean; begin Result := HasHiddenBreak; if not Result then exit; (* This is to check, if we have returned from a "call" instruction. Back to the original frame. *) Result := (FHiddenBreakStackPtrAddr <= FThread.GetStackPointerRegisterValue); debugln(FPDBG_COMMANDS and Result and (FHiddenBreakpoint <> nil), ['BreakStepBaseCmd.IsAtOrOutOfHiddenBreakFrame: Gone past hidden break = true']); end; procedure TDbgControllerHiddenBreakStepBaseCmd.SetHiddenBreak(AnAddr: TDBGPtr); begin assert(FHiddenBreakpoint = nil, 'TDbgControllerHiddenBreakStepBaseCmd.SetHiddenBreak: FHiddenBreakpoint = nil'); FHiddenBreakpoint.Free; // The callee may not setup a stackfram (StackBasePtr unchanged). So we use SP to detect recursive hits FHiddenBreakStackPtrAddr := FThread.GetStackPointerRegisterValue; FHiddenBreakInstrPtr := FThread.GetInstructionPointerRegisterValue; FHiddenBreakAddr := AnAddr; FHiddenBreakpoint := FProcess.AddInternalBreak(AnAddr); end; procedure TDbgControllerHiddenBreakStepBaseCmd.RemoveHiddenBreak; begin if assigned(FHiddenBreakpoint) then FreeAndNil(FHiddenBreakpoint); end; function TDbgControllerHiddenBreakStepBaseCmd.CheckForCallAndSetBreak: boolean; begin Result := FHiddenBreakpoint = nil; if not Result then exit; Result := NextInstruction.IsCallInstruction; if Result then {$PUSH}{$Q-}{$R-} SetHiddenBreak(FThread.GetInstructionPointerRegisterValue + NextInstruction.InstructionLength); {$POP} end; procedure TDbgControllerHiddenBreakStepBaseCmd.InitStackFrameInfo; begin FStackFrameInfo := FThread.GetCurrentStackFrameInfo; end; procedure TDbgControllerHiddenBreakStepBaseCmd.CallProcessContinue( ASingleStep: boolean; ASkipCheckNextInstr: Boolean); begin if (FStackFrameInfo <> nil) and (not ASkipCheckNextInstr) then FStackFrameInfo.CheckNextInstruction(NextInstruction, ASingleStep); FProcess.Continue(FProcess, FThread, ASingleStep); end; destructor TDbgControllerHiddenBreakStepBaseCmd.Destroy; begin RemoveHiddenBreak; FreeAndNil(FStackFrameInfo); inherited Destroy; end; function TDbgControllerHiddenBreakStepBaseCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; begin Result := True; if (AThread <> FThread) then begin FProcess.Continue(FProcess, AThread, False); exit; end; InternalContinue(AProcess, AThread); end; { TDbgControllerStepOverInstructionCmd } procedure TDbgControllerStepOverInstructionCmd.InternalContinue( AProcess: TDbgProcess; AThread: TDbgThread); begin assert(FProcess=AProcess, 'TDbgControllerStepOverInstructionCmd.DoContinue: FProcess=AProcess'); CheckForCallAndSetBreak; CallProcessContinue(FHiddenBreakpoint = nil); end; procedure TDbgControllerStepOverInstructionCmd.DoResolveEvent( var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); begin if FHiddenBreakpoint <> nil then Finished := IsAtOrOutOfHiddenBreakFrame else Finished := not (AnEvent in [deInternalContinue, deLoadLibrary]); if Finished then begin AnEvent := deFinishedStep; RemoveHiddenBreak; end else if AnEvent = deFinishedStep then AnEvent := deInternalContinue; end; { TDbgControllerLineStepBaseCmd } procedure TDbgControllerLineStepBaseCmd.Init; begin InitStackFrameInfo; if FStoreStepInfoAtInit then begin FThread.StoreStepInfo; FStartedInFuncName := FThread.StoreStepFuncName; end; inherited Init; end; procedure TDbgControllerLineStepBaseCmd.UpdateThreadStepInfoAfterStepOut( ANextOnlyStopOnStartLine: Boolean); begin if FStepInfoUpdatedForStepOut or not IsSteppedOut then exit; if not ANextOnlyStopOnStartLine then exit; FStepInfoUnavailAfterStepOut := not IsAtLastHiddenBreakAddr; if not FStepInfoUnavailAfterStepOut then begin {$PUSH}{$Q-}{$R-} FThread.StoreStepInfo(FThread.GetInstructionPointerRegisterValue - 1); {$POP} end; FStepInfoUpdatedForStepOut := True; end; function TDbgControllerLineStepBaseCmd.HasReachedEndLineForStep: boolean; var CompRes: TFPDCompareStepInfo; begin CompRes := FThread.CompareStepInfo; if CompRes in [dcsiSameLine, dcsiZeroLine] then begin DebugLn((DBG_VERBOSE or FPDBG_COMMANDS) and (CompRes=dcsiZeroLine), ['LineInfo with number=0']); Result := False; exit; end; if CompRes = dcsiNoLineInfo then begin // only get here, if the original did have line info, so no line info should not happen // check if the next asm is on the same line, otherwise treat as new line {$PUSH}{$Q-}{$R-} CompRes := FThread.CompareStepInfo(FThread.GetInstructionPointerRegisterValue); {$POP} Result := not(CompRes in [dcsiNewLine, dcsiSameLine]); // Step once more, maybe we do a jmp.... DebugLn(DBG_VERBOSE or FPDBG_COMMANDS, ['UNEXPECTED absence of debug info @',FThread.GetInstructionPointerRegisterValue, ' Res:', Result]); exit; end; Result := True; end; function TDbgControllerLineStepBaseCmd.HasReachedEndLineOrSteppedOut( ANextOnlyStopOnStartLine: Boolean): boolean; begin Result := IsSteppedOut; if Result then begin Result := (not ANextOnlyStopOnStartLine); if Result then exit; // If stepped out, do not step out again Result := NextInstruction.IsLeaveStackFrame or NextInstruction.IsReturnInstruction; if Result then exit; if FStepInfoUnavailAfterStepOut then begin Result := FController.FCurrentThread.IsAtStartOfLine; exit; end; end; Result := HasReachedEndLineForStep; end; procedure TDbgControllerLineStepBaseCmd.StoreWasAtJumpInstruction; begin FWasAtJumpInstruction := NextInstruction.IsJumpInstruction; end; function TDbgControllerLineStepBaseCmd.IsAtJumpPad: Boolean; begin Result := FWasAtJumpInstruction and NextInstruction.IsJumpInstruction(False) and not FController.FCurrentThread.IsAtStartOfLine; // TODO: check for lines with line=0 end; constructor TDbgControllerLineStepBaseCmd.Create(AController: TDbgController; AStoreStepInfoAtInit: Boolean); begin FStoreStepInfoAtInit := AStoreStepInfoAtInit; inherited Create(AController); end; function TDbgControllerLineStepBaseCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; begin Result := True; if AThread = FThread then FWasAtJumpInstruction := False; inherited DoContinue(AProcess, AThread); end; { TDbgControllerStepIntoLineCmd } procedure TDbgControllerStepIntoLineCmd.InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); begin assert(FProcess=AProcess, 'TDbgControllerStepIntoLineCmd.DoContinue: FProcess=AProcess'); if (FState = siSteppingCurrent) then begin if CheckForCallAndSetBreak then begin FState := siSteppingIn; CallProcessContinue(true); exit; end; end; if (FState <> siRunningStepOut) then StoreWasAtJumpInstruction; CallProcessContinue(FState <> siRunningStepOut, FState = siSteppingNested); end; constructor TDbgControllerStepIntoLineCmd.Create(AController: TDbgController); begin inherited Create(AController, True); end; procedure TDbgControllerStepIntoLineCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); var CompRes: TFPDCompareStepInfo; begin UpdateThreadStepInfoAfterStepOut(True); if IsAtOrOutOfHiddenBreakFrame then begin RemoveHiddenBreak; FState := siSteppingCurrent; end; assert((FHiddenBreakpoint<>nil) xor (FState=siSteppingCurrent), 'TDbgControllerStepIntoLineCmd.DoResolveEvent: (FHiddenBreakpoint<>nil) xor (FState=siSteppingCurrent)'); if (FState = siSteppingCurrent) then begin Finished := HasReachedEndLineOrSteppedOut(True); if Finished then Finished := not IsAtJumpPad; end else begin // we stepped into CompRes := FThread.CompareStepInfo; Finished := CompRes = dcsiNewLine; end; if Finished then AnEvent := deFinishedStep else if AnEvent in [deFinishedStep] then AnEvent:=deInternalContinue; If (FState = siSteppingCurrent) or Finished then exit; // Currently stepped into some method assert(FHiddenBreakpoint <> nil, 'TDbgControllerStepIntoLineCmd.DoResolveEvent: Stepping: FHiddenBreakpoint <> nil'); if FState = siSteppingIn then begin FState := siSteppingNested; FStepCount := 0; FNestDepth := 0; end; inc(FStepCount); if NextInstruction.IsCallInstruction then inc(FNestDepth); // FNestDepth = 2 => About to step into 3rd level nested if (FStepCount > 5) or (FNestDepth > 1) then begin FState := siRunningStepOut; // run to breakpoint exit; end; // Just step and see if we find line info end; { TDbgControllerStepOverLineCmd } procedure TDbgControllerStepOverLineCmd.InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); begin assert(FProcess=AProcess, 'TDbgControllerStepOverLineCmd.DoContinue: FProcess=AProcess'); CheckForCallAndSetBreak; if FHiddenBreakpoint = nil then StoreWasAtJumpInstruction; CallProcessContinue(FHiddenBreakpoint = nil); end; constructor TDbgControllerStepOverLineCmd.Create(AController: TDbgController); begin inherited Create(AController, True); end; procedure TDbgControllerStepOverLineCmd.Init; begin FThread.StoreStepInfo; inherited Init; end; procedure TDbgControllerStepOverLineCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); begin UpdateThreadStepInfoAfterStepOut(True); if IsAtOrOutOfHiddenBreakFrame then RemoveHiddenBreak; if FHiddenBreakpoint <> nil then begin Finished := False; end else begin Finished := HasReachedEndLineOrSteppedOut(True); if Finished then Finished := not IsAtJumpPad; end; if Finished then AnEvent := deFinishedStep else if AnEvent in [deFinishedStep] then AnEvent:=deInternalContinue; end; { TDbgControllerStepOutCmd } function TDbgControllerStepOutCmd.GetOutsideFrame(var AnOutside: Boolean ): Boolean; begin Result := FProcess.Disassembler.GetFunctionFrameInfo(FThread.GetInstructionPointerRegisterValue, AnOutside); end; procedure TDbgControllerStepOutCmd.SetReturnAdressBreakpoint( AProcess: TDbgProcess; AnOutsideFrame: Boolean); var AStackPointerValue, StepOutStackPos, ReturnAddress: TDBGPtr; begin FWasOutsideFrame := AnOutsideFrame; {$PUSH}{$Q-}{$R-} if AnOutsideFrame then begin StepOutStackPos:=FController.CurrentThread.GetStackPointerRegisterValue; end else begin AStackPointerValue:=FController.CurrentThread.GetStackBasePointerRegisterValue; StepOutStackPos:=AStackPointerValue+DBGPTRSIZE[FController.FCurrentProcess.Mode]; end; {$POP} debugln(FPDBG_COMMANDS, ['StepOutCmd.SetReturnAdressBreakpoint NoFrame=',AnOutsideFrame, ' ^RetIP=',dbghex(StepOutStackPos),' SP=',dbghex(FController.CurrentThread.GetStackPointerRegisterValue),' BP=',dbghex(FController.CurrentThread.GetStackBasePointerRegisterValue)]); if AProcess.ReadAddress(StepOutStackPos, ReturnAddress) then SetHiddenBreak(ReturnAddress) else debugln(DBG_WARNINGS or FPDBG_COMMANDS, ['Failed to read return-address from stack', ReturnAddress]); end; procedure TDbgControllerStepOutCmd.InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); var Outside: Boolean; begin assert(FProcess=AProcess, 'TDbgControllerStepOutCmd.DoContinue: FProcess=AProcess'); if (AThread = FThread) then begin if IsSteppedOut then begin CheckForCallAndSetBreak; end else if not assigned(FHiddenBreakpoint) then begin if GetOutsideFrame(Outside) then begin SetReturnAdressBreakpoint(AProcess, Outside); end else if FStepCount < 12 then begin // During the prologue and epiloge of a procedure the call-stack might not been // setup already. To avoid problems in these cases, start with a few (max // 12) single steps. Inc(FStepCount); if NextInstruction.IsCallInstruction or NextInstruction.IsLeaveStackFrame then // asm "call" // set break before "leave" or the frame becomes unavail begin SetReturnAdressBreakpoint(AProcess, False); end else if NextInstruction.IsReturnInstruction then // asm "ret" begin FStepCount := MaxInt; // Do one more single-step, and we're finished. CallProcessContinue(True); exit; end; end else begin // Enough with the single-stepping SetReturnAdressBreakpoint(AProcess, False); end; end; end; CallProcessContinue(FHiddenBreakpoint = nil); end; procedure TDbgControllerStepOutCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); begin Finished := False; // If we stepped out, without a frame, then IsSteppedOut will not detect it // The Stack will be popped for the return address. if FWasOutsideFrame and (not IsSteppedOut) and (FHiddenBreakStackPtrAddr < FThread.GetStackPointerRegisterValue) then FStackFrameInfo.FlagAsSteppedOut; if IsSteppedOut or IsAtHiddenBreak then begin UpdateThreadStepInfoAfterStepOut(FController.NextOnlyStopOnStartLine); if IsAtOrOutOfHiddenBreakFrame then RemoveHiddenBreak; if FHiddenBreakpoint <> nil then Finished := False else Finished := HasReachedEndLineOrSteppedOut(FController.NextOnlyStopOnStartLine); end; if Finished then AnEvent := deFinishedStep else if AnEvent in [deFinishedStep] then AnEvent:=deInternalContinue; end; { TDbgControllerRunToCmd } constructor TDbgControllerRunToCmd.Create(AController: TDbgController; ALocation: TDBGPtrArray); begin FLocation:=ALocation; inherited create(AController); end; procedure TDbgControllerRunToCmd.InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); begin assert(FProcess=AProcess, 'TDbgControllerRunToCmd.DoContinue: FProcess=AProcess'); CallProcessContinue(False); end; procedure TDbgControllerRunToCmd.Init; begin inherited Init; FHiddenBreakpoint := FProcess.AddInternalBreak(FLocation); end; procedure TDbgControllerRunToCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); begin Finished := (FHiddenBreakpoint = nil) or FHiddenBreakpoint.HasLocation(FThread.GetInstructionPointerRegisterValue); if Finished then begin RemoveHiddenBreak; AnEvent := deFinishedStep; end; end; { TDbgControllerStepToCmd } procedure TDbgControllerStepToCmd.Init; var r: TDBGPtrArray; begin // FThread.StoreStepInfo; FTargetExists := FProcess.DbgInfo.GetLineAddresses(FTargetFilename, FTargetLineNumber, r); FTargetExists := FTargetExists and (Length(r) > 0); FStepInfoUnavailAfterStepOut := True; // always check for IsAtStartOfLine inherited Init; end; function TDbgControllerStepToCmd.HasReachedEndLineForStep: boolean; var AnAddr: TDBGPtr; sym: TFpSymbol; begin Result := False; AnAddr := FThread.GetInstructionPointerRegisterValue; if (AnAddr >= FStoreStepStartAddr) and (AnAddr < FStoreStepEndAddr) then exit; sym := FProcess.FindProcSymbol(AnAddr); if not assigned(sym) then exit; if sym is TFpSymbolDwarfDataProc then begin FStoreStepStartAddr := TFpSymbolDwarfDataProc(sym).LineStartAddress; FStoreStepEndAddr := TFpSymbolDwarfDataProc(sym).LineEndAddress; end else begin FStoreStepStartAddr := AnAddr; FStoreStepEndAddr := AnAddr; end; Result := (sym.Line = FTargetLineNumber) and (ExtractFileName(sym.FileName) = FTargetFilename); sym.ReleaseReference; end; procedure TDbgControllerStepToCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); begin // UpdateThreadStepInfoAfterStepOut(True); if IsAtOrOutOfHiddenBreakFrame then RemoveHiddenBreak; if not FTargetExists then begin Finished := True; // should not even have been started end else if FHiddenBreakpoint <> nil then begin Finished := False; end else begin Finished := HasReachedEndLineOrSteppedOut(True); //if Finished then // Finished := not IsAtJumpPad; end; if Finished then AnEvent := deFinishedStep else if AnEvent in [deFinishedStep] then AnEvent:=deInternalContinue; end; procedure TDbgControllerStepToCmd.InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); begin assert(FProcess=AProcess, 'TDbgControllerStepToCmd.DoContinue: FProcess=AProcess'); CheckForCallAndSetBreak; if FHiddenBreakpoint = nil then StoreWasAtJumpInstruction; CallProcessContinue(FHiddenBreakpoint = nil); end; constructor TDbgControllerStepToCmd.Create(AController: TDbgController; const ATargetFilename: String; ATargetLineNumber: Integer); begin FTargetFilename := ExtractFileName(ATargetFilename); FTargetLineNumber := ATargetLineNumber; inherited Create(AController, False); end; { TDbgController } procedure TDbgController.DoOnDebugInfoLoaded(Sender: TObject); begin if Assigned(FOnDebugInfoLoaded) then FOnDebugInfoLoaded(Self); end; procedure TDbgController.SetOnThreadDebugOutputEvent(AValue: TDebugOutputEvent); begin if FOnThreadDebugOutputEvent = AValue then Exit; FOnThreadDebugOutputEvent := AValue; if FMainProcess <> nil then FMainProcess.OnDebugOutputEvent := AValue; end; procedure TDbgController.SetParams(AValue: TStringList); begin if FParams=AValue then Exit; FParams.Assign(AValue); end; procedure TDbgController.CheckExecutableAndLoadClasses; var source: TDbgFileLoader; imgReader: TDbgImageReader; ATargetInfo: TTargetDescriptor; begin ATargetInfo := hostDescriptor; if (FExecutableFilename <> '') and FileExists(FExecutableFilename) then begin DebugLn(DBG_VERBOSE, 'TDbgController.CheckExecutableAndLoadClasses'); source := nil; imgReader := nil; try source := TDbgFileLoader.Create(FExecutableFilename); imgReader := GetImageReader(source, nil, 0, false); // If the file-format of the 'executable' is not recognized, imgReader is // nil. It can be anything, executable (some script) or non-executable ( // a jpeg-image). So use the default host-descriptor and see what happens... if Assigned(imgReader) then ATargetInfo := imgReader.TargetInfo; finally FreeAndNil(imgReader); // TODO: Store object reference, it will be needed again FreeAndNil(source); end; end; FOsDbgClasses := FpDbgClasses.GetDbgProcessClass(ATargetInfo); end; procedure TDbgController.SetExecutableFilename(const AValue: string); begin if FExecutableFilename=AValue then Exit; FExecutableFilename:=AValue; end; procedure TDbgController.SetEnvironment(AValue: TStrings); begin if FEnvironment=AValue then Exit; FEnvironment.Assign(AValue); end; function TDbgController.GetCurrentThreadId: Integer; begin Result := FCurrentThread.ID; end; function TDbgController.GetDefaultContext: TFpDbgLocationContext; begin Result := FStoredDefaultContext; if Result <> nil then exit; if FDefaultContext = nil then begin FDefaultContext := TFpDbgSimpleLocationContext.Create(MemManager, FCurrentThread.GetInstructionPointerRegisterValue, DBGPTRSIZE[CurrentProcess.Mode], CurrentThread.ID, 0 ); end; Result := FDefaultContext; end; procedure TDbgController.SetCurrentThreadId(AValue: Integer); var ExistingThread: TDbgThread; begin if FCurrentThread.ID = AValue then Exit; if not FCurrentProcess.GetThread(AValue, ExistingThread) then begin debugln(DBG_WARNINGS, ['SetCurrentThread() unknown thread id: ', AValue]); // raise ... exit; end; FCurrentThread := ExistingThread; end; destructor TDbgController.Destroy; var it: TMapIterator; p: TDbgProcess; begin ReleaseRefAndNil(FDefaultContext); if FCommand <> nil then begin FCommand.FProcess := nil; FCommand.FThread := nil; FCommand.Free; end; if FCommandToBeFreed <> nil then begin FCommandToBeFreed.FProcess := nil; FCommandToBeFreed.FThread := nil; FCommandToBeFreed.Free; end; if Assigned(FMainProcess) then begin FProcessMap.Delete(FMainProcess.ProcessID); FMainProcess.Free; end; it := TMapIterator.Create(FProcessMap); while not it.EOM do begin it.GetData(p); p.Free; it.Next; end; it.Free; FProcessMap.Free; FParams.Free; FEnvironment.Free; inherited Destroy; end; procedure TDbgController.AbortCurrentCommand(AForce: Boolean); begin if AForce then begin FreeAndNil(FCommand); exit; end; if FCommand = nil then exit; assert(FCommandToBeFreed=nil, 'TDbgController.AbortCurrentCommand: FCommandToBeFreed=nil'); FCommandToBeFreed := FCommand; FCommand := nil; end; procedure TDbgController.InitializeCommand(ACommand: TDbgControllerCmd); begin if assigned(FCommand) then raise exception.create('Prior command not finished yet.'); DebugLn(FPDBG_COMMANDS, 'Initialized command '+ACommand.ClassName); FCommand := ACommand; end; function TDbgController.Run: boolean; var Flags: TStartInstanceFlags; begin result := False; FLastError := NoError; if assigned(FMainProcess) then begin DebugLn(DBG_WARNINGS, 'The debuggee is already running'); Exit; end; if FExecutableFilename = '' then begin DebugLn(DBG_WARNINGS, 'No filename given to execute.'); Exit; end; if not FileExists(FExecutableFilename) then begin DebugLn(DBG_WARNINGS, 'File %s does not exist.',[FExecutableFilename]); Exit; end; // Get exe info, load classes CheckExecutableAndLoadClasses; if not Assigned(OsDbgClasses) then begin result := false; DebugLn(DBG_WARNINGS, 'Error - No support registered for debug target'); Exit; end; Flags := []; if RedirectConsoleOutput then Include(Flags, siRediretOutput); if ForceNewConsoleWin then Include(Flags, siForceNewConsole); FCurrentProcess := OSDbgClasses.DbgProcessClass.Create(FExecutableFilename, OsDbgClasses, MemManager, ProcessConfig); if not Assigned(FCurrentProcess) then begin Result := false; DebugLn(DBG_WARNINGS, 'Error - could not create TDbgProcess'); Exit; end; if AttachToPid <> 0 then Result := FCurrentProcess.AttachToInstance(AttachToPid, FLastError) else Result := FCurrentProcess.StartInstance(Params, Environment, WorkingDirectory, FConsoleTty, Flags, FLastError); if Result then begin FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess); DebugLn(DBG_VERBOSE, 'Got PID: %d, TID: %d', [FCurrentProcess.ProcessID, FCurrentProcess.ThreadID]); end else begin Result := false; FreeAndNil(FCurrentProcess); end; end; procedure TDbgController.Stop; begin if assigned(FMainProcess) then FMainProcess.TerminateProcess else raise Exception.Create('Failed to stop debugging. No main process.'); end; procedure TDbgController.&ContinueRun; begin InitializeCommand(TDbgControllerContinueCmd.Create(self)); end; procedure TDbgController.StepIntoInstr; begin InitializeCommand(TDbgControllerStepIntoInstructionCmd.Create(self)); end; procedure TDbgController.StepOverInstr; begin InitializeCommand(TDbgControllerStepOverInstructionCmd.Create(self)); end; procedure TDbgController.Next; begin InitializeCommand(TDbgControllerStepOverLineCmd.Create(self)); end; procedure TDbgController.Step; begin InitializeCommand(TDbgControllerStepIntoLineCmd.Create(self)); end; procedure TDbgController.StepOut(AForceStoreStepInfo: Boolean); begin InitializeCommand(TDbgControllerStepOutCmd.Create(self, AForceStoreStepInfo)); end; function TDbgController.Pause: boolean; begin InterLockedExchange(FPauseRequest, 1); Result := InterLockedExchangeAdd(FRunning, 0) = 0; // not running if not Result then Result := FCurrentProcess.Pause; end; function TDbgController.Detach: boolean; begin InterLockedExchange(FDetaching, 1); Result := Pause; end; procedure TDbgController.ProcessLoop; function MaybeDetach: boolean; begin Result := InterLockedExchange(FDetaching, 0) <> 0; if not Result then exit; if Assigned(FCommand) then FreeAndNil(FCommand); FPDEvent := deFinishedStep; // go to pause, if detach fails if FCurrentProcess.Detach(FCurrentProcess, FCurrentThread) then FPDEvent := deExitProcess; end; var AProcessIdentifier: THandle; AThreadIdentifier: THandle; AExit: boolean; IsFinished, b, DidContinue: boolean; EventProcess: TDbgProcess; DummyThread: TDbgThread; CurCmd: TDbgControllerCmd; ALib: TDbgLibrary; begin AExit:=false; if FCurrentProcess = nil then begin DebugLn(DBG_WARNINGS, 'Error: Processloop has no process'); exit; end; FreeAndNil(FCommandToBeFreed); FCurrentProcess.DoBeforeProcessLoop; if FCommand <> nil then FCommand.DoBeforeLoopStart; if MaybeDetach then exit; // Do not clear callstack of threads: TDbgControllerCallRoutineCmd is considered remaining in pause. // TODO: if the IP of another thread changes, send notifications if (FCommand = nil) or not (FCommand is TDbgControllerCallRoutineCmd) then FCurrentProcess.ThreadsClearCallStack; if Assigned(FOnThreadBeforeProcessLoop) then FOnThreadBeforeProcessLoop(Self); repeat ReleaseRefAndNil(FDefaultContext); DidContinue := True; if assigned(FCurrentProcess) and not assigned(FMainProcess) then begin // IF there is a pause-request, we will hit a deCreateProcess. // No need to indicate FRunning FMainProcess:=FCurrentProcess; if FMainProcess <> nil then FMainProcess.OnDebugOutputEvent := FOnThreadDebugOutputEvent; end else begin InterLockedExchange(FRunning, 1); // if Pause() is called right here, an Interrupt-Event is scheduled, even though we do not run (yet) if InterLockedExchangeAdd(FPauseRequest, 0) = 1 then begin FPDEvent := deBreakpoint; InterLockedExchange(FRunning, 0); break; // no event handling. Keep Process/Thread from last run end else begin if not assigned(FCommand) then begin DebugLnEnter(FPDBG_COMMANDS, 'Continue process without command.'); FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False) end else begin DebugLnEnter(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName); DidContinue := FCommand.DoContinue(FCurrentProcess, FCurrentThread); end; // TODO: replace the dangling pointer with the next best value.... // There is still a race condition, for another thread to access it... if (FCurrentThread <> nil) and not FCurrentProcess.GetThread(FCurrentThread.ID, DummyThread) then begin if (FCommand <> nil) and (FCommand.FThread = FCurrentThread) then FCommand.Thread := nil; FreeAndNil(FCurrentThread); end; DebugLnExit(FPDBG_COMMANDS); end; end; if not DidContinue then begin FPDEvent := deFailed; break; end; if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then Continue; InterLockedExchange(FRunning, 0); (* Do not change CurrentProcess/Thread, unless the debugger can actually controll/debug those processes - If FCurrentProcess is not set to FMainProcess then Pause will fail (because a process that is not debugged, can not be paused, and if it were debugged, *all* debugged processes may need to be paused) - The LazFpDebugger may try to access FCurrentThread. If that is nil, it may crash. e.g. TFPThreads.RequestMasterData This may need 3 threads: main, user-selected (thread win), current-event deExitProcess relies on only the main process receiving this. *) //FCurrentProcess := nil; //FCurrentThread := nil; EventProcess := nil; // if not GetProcess(AProcessIdentifier, FCurrentProcess) then if not GetProcess(AProcessIdentifier, EventProcess) then begin // A second/third etc process has been started. (* A process was created/forked However the debugger currently does not attach to it on all platforms so maybe other processes should be ignored? It seems on windows/linux it does NOT attach. On Mac, it may attempt to attach. If the process is not debugged, it may not receive an deExitProcess *) (* As above, currently do not change those variables, just continue the process-loop (as "FCurrentProcess<>FMainProcess" would do) *) //FCurrentProcess := OSDbgClasses.DbgProcessClass.Create('', AProcessIdentifier, AThreadIdentifier, OnLog); //FProcessMap.Add(AProcessIdentifier, FCurrentProcess); Continue; // ***** This will swallow all FPDEvent for unknow processes ***** end; if EventProcess<>FMainProcess then //if FCurrentProcess<>FMainProcess then // Just continue the process. Only the main-process is being debugged. Continue; if not FCurrentProcess.GetThread(AThreadIdentifier, FCurrentThread) then FCurrentThread := FCurrentProcess.AddThread(AThreadIdentifier); (* TODO: ExitThread ********** at least the winprocess handles exitthread in the next line. this will remove CurrentThread form the list of threads CurrentThread is then destroyed in the next call to continue.... *) FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread); if FCurrentThread <> nil then DebugLn(DBG_VERBOSE, 'Process stopped with event %s. IP=%s, SP=%s, BSP=%s. HasBreak: %s', [FPDEventNames[FPDEvent], FCurrentProcess.FormatAddress(FCurrentThread.GetInstructionPointerRegisterValue), FCurrentProcess.FormatAddress(FCurrentThread.GetStackPointerRegisterValue), FCurrentProcess.FormatAddress(FCurrentThread.GetStackBasePointerRegisterValue), dbgs(CurrentProcess.CurrentBreakpoint<>nil)]); if MaybeDetach then break; case FPDEvent of deLoadLibrary: for ALib in EventProcess.LastLibrariesLoaded do EventProcess.UpdateBreakpointsForLibraryLoaded(ALib); deUnloadLibrary: for ALib in EventProcess.LastLibrariesUnloaded do EventProcess.UpdateBreakpointsForLibraryUnloaded(ALib); end; IsFinished:=false; if FPDEvent=deExitProcess then begin FreeAndNil(FCommand); if assigned(FOnThreadProcessLoopCycleEvent) then begin CurCmd := nil; FOnThreadProcessLoopCycleEvent(AExit, FPDEvent, CurCmd, IsFinished); FreeAndNil(CurCmd); FPDEvent := deExitProcess; end; break; end else if assigned(FCommand) then begin FCommand.ResolveEvent(FPDEvent, FCurrentThread, IsFinished); DebugLn(FPDBG_COMMANDS, 'Command %s: IsFinished=%s', [FCommand.ClassName, dbgs(IsFinished)]) end; AExit:=true; if not IsFinished then begin case FPDEvent of deInternalContinue: AExit := False; deBreakpoint: begin b := FCurrentProcess.GetAndClearPauseRequested; AExit := (FCurrentProcess.CurrentBreakpoint <> nil) or ( (FCurrentProcess.CurrentWatchpoint <> nil) and (FCurrentProcess.CurrentWatchpoint <> Pointer(-1)) ) or ( (FCurrentThread <> nil) and FCurrentThread.PausedAtHardcodeBreakPoint) or (b and (InterLockedExchangeAdd(FPauseRequest, 0) = 1)); 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); end; if GBreakOnLibraryLoad then GState := dsPause; end; } end; {case} end; if assigned(FOnThreadProcessLoopCycleEvent) then begin CurCmd := FCommand; FOnThreadProcessLoopCycleEvent(AExit, FPDEvent, CurCmd, IsFinished); if CurCmd = FCommand then begin if IsFinished then FreeAndNil(FCommand); end else begin FreeAndNil(FCommand); FCommand := CurCmd; if FCommand <> nil then FCommand.DoBeforeLoopStart; end; end else if IsFinished then FreeAndNil(FCommand); until AExit or (InterLockedExchangeAdd(FPauseRequest, 0) = 1); end; procedure TDbgController.SendEvents(out continue: boolean); var HasPauseRequest: Boolean; CurWatch: TFpInternalWatchpoint; begin // reset pause request. If Pause() is called after this, it will be seen in the next loop HasPauseRequest := InterLockedExchange(FPauseRequest, 0) = 1; CurWatch := nil; if (FCurrentProcess.CurrentWatchpoint <> nil) and (FCurrentProcess.CurrentWatchpoint <> Pointer(-1)) then CurWatch := TFpInternalWatchpoint(FCurrentProcess.CurrentWatchpoint); case FPDEvent of deCreateProcess: begin (* Only events for the main process get here / See ProcessLoop *) if not Assigned(FCurrentProcess.DbgInfo) then FCurrentProcess.LoadInfo; DebugLn(DBG_WARNINGS and (not Assigned(FCurrentProcess.DbgInfo) or not(FCurrentProcess.DbgInfo.HasInfo)), ['TDbgController.SendEvents called - deCreateProcess - No debug info. [CurrentProcess=',dbgsname(FCurrentProcess),',DbgInfo=',dbgsname(FCurrentProcess.DbgInfo),']']); DebugLn(DBG_VERBOSE, Format(' Target.MachineType = %d', [FCurrentProcess.DbgInfo.TargetInfo.machineType])); DebugLn(DBG_VERBOSE, Format(' Target.Bitness = %d', [FCurrentProcess.DbgInfo.TargetInfo.bitness])); DebugLn(DBG_VERBOSE, Format(' Target.byteOrder = %d', [FCurrentProcess.DbgInfo.TargetInfo.byteOrder])); DebugLn(DBG_VERBOSE, Format(' Target.OS = %d', [FCurrentProcess.DbgInfo.TargetInfo.OS])); DoOnDebugInfoLoaded(self); continue:=true; if assigned(OnCreateProcessEvent) then OnCreateProcessEvent(continue); end; deFinishedStep: begin if assigned(OnHitBreakpointEvent) then begin // if there is a breakpoint at the stepping end, execute its actions continue:=false; if (CurWatch <> nil) then OnHitBreakpointEvent(continue, CurWatch, deFinishedStep, True); continue:=false; if assigned(FCurrentProcess.CurrentBreakpoint) then OnHitBreakpointEvent(continue, FCurrentProcess.CurrentBreakpoint, deFinishedStep, True); continue:=false; OnHitBreakpointEvent(continue, nil, deFinishedStep, False); HasPauseRequest := False; end; continue:=false; end; deBreakpoint, deHardCodedBreakpoint: begin // If there is no breakpoint AND no pause-request then this is a deferred, allready handled pause request if assigned(OnHitBreakpointEvent) and ( // If no break event of any kind is hit, then pause will be called further down. Keep HasPauseRequest=True ((FCurrentThread <> nil) and (FCurrentThread.PausedAtHardcodeBreakPoint)) or (CurWatch <> nil) or (FCurrentProcess.CurrentBreakpoint <> nil) ) then begin continue := False; if (FCurrentThread <> nil) and (FCurrentThread.PausedAtHardcodeBreakPoint) then OnHitBreakpointEvent(continue, nil, deHardCodedBreakpoint, (CurWatch <> nil) or (FCurrentProcess.CurrentBreakpoint <> nil)); if (CurWatch <> nil) then OnHitBreakpointEvent(continue, CurWatch, deBreakpoint, (FCurrentProcess.CurrentBreakpoint <> nil)); if assigned(FCurrentProcess.CurrentBreakpoint) then OnHitBreakpointEvent(continue, FCurrentProcess.CurrentBreakpoint, deBreakpoint, False); if not continue then HasPauseRequest := False; // The debugger will enter Pause, so the internal-pause is handled. end; end; deExitProcess: begin (* Only events for the main process get here / See ProcessLoop *) if FCurrentProcess = FMainProcess then FMainProcess := nil; FCurrentProcess.GotExitProcess := True; if assigned(OnProcessExitEvent) then OnProcessExitEvent(FCurrentProcess.ExitCode); FProcessMap.Delete(FCurrentProcess.ProcessID); FCurrentProcess.Free; FCurrentProcess := nil; HasPauseRequest := False; continue := false; end; deException: begin continue:=false; if assigned(OnExceptionEvent) then OnExceptionEvent(continue, FCurrentProcess.ExceptionClass, FCurrentProcess.ExceptionMessage ); if not continue then HasPauseRequest := False; end; deLoadLibrary: begin continue:=true; if assigned(OnLibraryLoadedEvent) and (Length(FCurrentProcess.LastLibrariesLoaded)>0) then OnLibraryLoadedEvent(continue, FCurrentProcess.LastLibrariesLoaded); end; deUnloadLibrary: begin continue:=true; if assigned(OnLibraryUnloadedEvent) and (Length(FCurrentProcess.LastLibrariesUnloaded)>0) then OnLibraryUnloadedEvent(continue, FCurrentProcess.LastLibrariesUnloaded); end; deInternalContinue: begin continue := true; end; else raise exception.create('Unknown debug controler state'); end; if HasPauseRequest then begin continue := False; if assigned(OnHitBreakpointEvent) then OnHitBreakpointEvent(continue, nil, deInternalContinue, False); end; if (not &continue) and (FCommand <> nil) and not (FCommand is TDbgControllerCallRoutineCmd) then begin assert(FCommandToBeFreed=nil, 'TDbgController.SendEvents: FCommandToBeFreed=nil'); FCommandToBeFreed := FCommand; FCommand := nil; end; end; function TDbgController.GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean; begin Result := FProcessMap.GetData(AProcessIdentifier, AProcess) and (AProcess <> nil); end; constructor TDbgController.Create(AMemManager: TFpDbgMemManager); begin FMemManager := AMemManager; FParams := TStringList.Create; FEnvironment := TStringList.Create; FProcessMap := TMap.Create(itu4, SizeOf(TDbgProcess)); FNextOnlyStopOnStartLine := true; end; function TDbgController.Call(const FunctionAddress: TFpDbgMemLocation; const ABaseContext: TFpDbgLocationContext; const AMemReader: TFpDbgMemReaderBase; const AMemConverter: TFpDbgMemConvertor ): TFpDbgInfoCallContext; var Context: TFpDbgInfoCallContext; begin debugln(FPDBG_FUNCCALL, ['CallRoutine BEGIN']); Result := nil; if (FPDEvent in [deExitProcess, deFailed]) or (FMainProcess = nil) or (FCurrentProcess = nil) or (FCurrentThread = nil) or (not FCurrentProcess.CanContinueForWatchEval(FCurrentThread)) then exit; Context := TFpDbgInfoCallContext.Create(ABaseContext, AMemReader, AMemConverter, FCurrentProcess, FCurrentThread); Context.AddReference; InitializeCommand(TDbgControllerCallRoutineCmd.Create(self, FunctionAddress, Context)); Result := Context; end; initialization DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} ); DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} ); FPDBG_COMMANDS := DebugLogger.FindOrRegisterLogGroup('FPDBG_COMMANDS' {$IFDEF FPDBG_COMMANDS} , True {$ENDIF} ); FPDBG_FUNCCALL := DebugLogger.FindOrRegisterLogGroup('FPDBG_FUNCCALL' {$IFDEF FPDBG_FUNCCALL} , True {$ENDIF} ); end.