From 843f23eafdeef921b90a9438fa7ff28d183ba3a2 Mon Sep 17 00:00:00 2001 From: joost Date: Fri, 20 Jun 2014 15:22:45 +0000 Subject: [PATCH] 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 - --- components/fpdebug/fpdbgclasses.pp | 202 +++++-------- components/fpdebug/fpdbgcontroller.pas | 345 ++++++++++++++++++---- components/fpdebug/fpdbgdarwinclasses.pas | 216 +++++++++++--- components/fpdebug/fpdbgwinclasses.pas | 90 ++---- 4 files changed, 561 insertions(+), 292 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 01cd4faa93..fabec7eea3 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -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; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 1b4d26ecbc..6dc667051a 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -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; diff --git a/components/fpdebug/fpdbgdarwinclasses.pas b/components/fpdebug/fpdbgdarwinclasses.pas index c1f522afdc..c5b79e9a69 100644 --- a/components/fpdebug/fpdbgdarwinclasses.pas +++ b/components/fpdebug/fpdbgdarwinclasses.pas @@ -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 diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index fbfece9f39..ebf8cd0077 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/components/fpdebug/fpdbgwinclasses.pas @@ -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