From e7779bd4761fcb99ee4f14fbfad407c3438ddb87 Mon Sep 17 00:00:00 2001 From: joost Date: Wed, 30 Apr 2014 20:44:22 +0000 Subject: [PATCH] LazDebuggerFp (pure): Implemented step-into git-svn-id: trunk@44862 - --- components/fpdebug/app/fpd/fpdcommand.pas | 13 ++ components/fpdebug/fpdbgclasses.pp | 80 +++++++++++- components/fpdebug/fpdbgcontroller.pas | 24 ++-- components/fpdebug/fpdbgwinclasses.pas | 120 ++++++++++++++---- .../lazdebuggerfp/fpdebugdebugger.pas | 10 +- 5 files changed, 208 insertions(+), 39 deletions(-) diff --git a/components/fpdebug/app/fpd/fpdcommand.pas b/components/fpdebug/app/fpd/fpdcommand.pas index 6b48fb83c5..761602afc5 100644 --- a/components/fpdebug/app/fpd/fpdcommand.pas +++ b/components/fpdebug/app/fpd/fpdcommand.pas @@ -308,6 +308,18 @@ begin CallProcessLoop:=true; end; +procedure HandleStep(AParams: String; out CallProcessLoop: boolean); +begin + CallProcessLoop:=false; + if not assigned(GController.MainProcess) + then begin + WriteLN('The process is not paused'); + Exit; + end; + GController.Step; + CallProcessLoop:=true; +end; + procedure HandleStepOut(AParams: String; out CallProcessLoop: boolean); begin CallProcessLoop:=false; @@ -766,6 +778,7 @@ begin MCommands.AddCommand(['step-inst', 'si'], @HandleStepInst, 'step-inst: Steps-into one instruction'); MCommands.AddCommand(['next-inst', 'ni'], @HandleNextInst, 'next-inst: Steps-over one instruction'); MCommands.AddCommand(['next', 'n'], @HandleNext, 'next: Steps one line'); + MCommands.AddCommand(['step', 'st'], @HandleStep, 'step: Steps one line into procedure'); MCommands.AddCommand(['step-out', 'so'], @HandleStepOut, 'step-out: Steps out of current procedure'); MCommands.AddCommand(['list', 'l'], @HandleList, 'list [|]: Lists the source for or '); MCommands.AddCommand(['memory', 'mem', 'm'], @HandleMemory, 'memory [-] [ | ]: Dump (default: 1) from memory or (default: current) of (default: 4) bytes, where size is 1,2,4,8 or 16.'); diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index acd62a59f2..21bba2885d 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -113,19 +113,28 @@ 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 constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); virtual; function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract; + procedure BeforeContinue; virtual; + function AddWatchpoint(AnAddr: TDBGPtr): integer; virtual; + function RemoveWatchpoint(AnId: integer): boolean; virtual; procedure AfterHitBreak; - procedure ClearHiddenBreakpoint; + procedure ClearHWBreakpoint; destructor Destroy; override; function SingleStep: Boolean; virtual; - function StepOver: 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; @@ -258,6 +267,7 @@ type function GetInstructionPointerRegisterValue: TDbgPtr; virtual; abstract; function GetStackBasePointerRegisterValue: TDbgPtr; virtual; abstract; + function GetStackPointerRegisterValue: TDbgPtr; virtual; abstract; procedure TerminateProcess; virtual; abstract; procedure ClearRunToBreakpoint; @@ -820,7 +830,11 @@ begin begin // If the procedure changed, also check if the current instruction // is at the start of a new sourceline. (Dwarf only) - if sym is TDbgDwarfSymbolBase then + // Don't do this while stepping into a procedure, only when stepping out. + // 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 begin CU := TDbgDwarfSymbolBase(sym).CompilationUnit; if cu.GetLineAddress(sym.FileName, sym.Line)<>AnAddr then @@ -857,7 +871,7 @@ end; function TDbgThread.IntNext: Boolean; begin - result := StepOver; + result := StepLine; FStepping:=result; end; @@ -867,19 +881,50 @@ begin FHandle := AHandle; FProcess := AProcess; FRegisterValueList:=TDbgRegisterValueList.Create; + FHiddenWatchpointInto:=-1; + FHiddenWatchpointOut:=-1; inherited Create; end; +procedure TDbgThread.BeforeContinue; +begin + // Do nothing +end; + +function TDbgThread.AddWatchpoint(AnAddr: TDBGPtr): integer; +begin + FProcess.log('Hardware watchpoints are nog available.'); + result := -1; +end; + +function TDbgThread.RemoveWatchpoint(AnId: integer): boolean; +begin + FProcess.log('Hardware watchpoints are nog available.'); + result := false; +end; + procedure TDbgThread.AfterHitBreak; begin FStepping:=false; + FInto:=false; + FIntoDepth:=false; FStepOut:=false; + FreeAndNil(FHiddenBreakpoint); end; -procedure TDbgThread.ClearHiddenBreakpoint; +procedure TDbgThread.ClearHWBreakpoint; begin - FreeAndNil(FHiddenBreakpoint); + 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; @@ -895,7 +940,7 @@ begin Result := true; end; -function TDbgThread.StepOver: Boolean; +function TDbgThread.StepLine: Boolean; var CodeBin: array[0..20] of byte; @@ -905,6 +950,14 @@ var 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 @@ -917,6 +970,11 @@ begin 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; @@ -930,6 +988,14 @@ begin result := IntNext; end; +function TDbgThread.StepInto: Boolean; +begin + StoreStepInfo; + FInto:=true; + FIntoDepth:=false; + result := IntNext; +end; + function TDbgThread.StepOut: Boolean; begin result := next; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 8671dedbf7..af181ebd75 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -51,6 +51,7 @@ type procedure StepIntoInstr; procedure StepOverInstr; procedure Next; + procedure Step; procedure StepOut; procedure Pause; procedure ProcessLoop; @@ -144,7 +145,7 @@ end; procedure TDbgController.StepOverInstr; begin - FCurrentThread.StepOver; + FCurrentThread.StepLine; end; procedure TDbgController.Next; @@ -152,6 +153,11 @@ begin FCurrentThread.Next; end; +procedure TDbgController.Step; +begin + FCurrentThread.StepInto; +end; + procedure TDbgController.StepOut; begin FCurrentThread.StepOut; @@ -203,10 +209,9 @@ begin if assigned(FCurrentThread) then begin FCurrentThread.SingleStepping:=false; - if FPDEvent<>deInternalContinue then + if not (FPDEvent in [deInternalContinue, deLoadLibrary]) then FCurrentThread.AfterHitBreak; - if assigned(FCurrentThread.HiddenBreakpoint) then - FCurrentThread.ClearHiddenBreakpoint; + FCurrentThread.ClearHWBreakpoint; end; case FPDEvent of deCreateProcess : @@ -222,9 +227,9 @@ begin FCurrentProcess.Free; FCurrentProcess := nil; end; - deLoadLibrary : +{ deLoadLibrary : begin - {if FCurrentProcess.GetLib(FCurrentProcess.LastEventProcessIdentifier, ALib) + if FCurrentProcess.GetLib(FCurrentProcess.LastEventProcessIdentifier, ALib) and (GImageInfo <> iiNone) then begin WriteLN('Name: ', ALib.Name); @@ -233,13 +238,14 @@ begin end; if GBreakOnLibraryLoad then GState := dsPause; - } - end; + + end;} deBreakpoint : begin debugln('Reached breakpoint at %s.',[FormatAddress(FCurrentProcess.GetInstructionPointerRegisterValue)]); end; - deInternalContinue : + deInternalContinue, + deLoadLibrary: begin if assigned(FCurrentThread) and FCurrentThread.Stepping then FCurrentThread.IntNext; diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index 8e01654219..cc8e423df3 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/components/fpdebug/fpdbgwinclasses.pas @@ -55,9 +55,13 @@ type TDbgWinThread = class(TDbgThread) protected + FThreadContextChanged: boolean; procedure LoadRegisterValues; override; public procedure SetSingleStep; + function AddWatchpoint(AnAddr: TDBGPtr): integer; override; + function RemoveWatchpoint(AnId: integer): boolean; override; + procedure BeforeContinue; override; function ResetInstructionPointerAfterBreakpoint: boolean; override; function ReadThreadState: boolean; end; @@ -101,6 +105,7 @@ type function GetInstructionPointerRegisterValue: TDbgPtr; override; function GetStackBasePointerRegisterValue: TDbgPtr; override; + function GetStackPointerRegisterValue: TDbgPtr; override; function Pause: boolean; override; procedure TerminateProcess; override; @@ -423,10 +428,14 @@ begin EXCEPTION_SINGLE_STEP: begin if (AThread.SingleStepping) or assigned(FCurrentBreakpoint) then TDbgWinThread(AThread).SetSingleStep; + AThread.BeforeContinue; Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE); end - else - Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_EXCEPTION_NOT_HANDLED); + else begin + if assigned(AThread) then + AThread.BeforeContinue; + Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_EXCEPTION_NOT_HANDLED); + end; end; result := true; end; @@ -893,6 +902,15 @@ begin {$endif} end; +function TDbgWinProcess.GetStackPointerRegisterValue: TDbgPtr; +begin +{$ifdef cpui386} + Result := GCurrentContext^.Esp; +{$else} +// Result := GCurrentContext^.Rdi; +{$endif} +end; + function DebugBreakProcess(Process:HANDLE): WINBOOL; external 'kernel32' name 'DebugBreakProcess'; function TDbgWinProcess.Pause: boolean; @@ -991,32 +1009,89 @@ begin end; procedure TDbgWinThread.SetSingleStep; -var - _UC: record - C: TContext; - D: array[1..16] of Byte; - end; - Context: PContext; begin - Context := AlignPtr(@_UC, $10); - Context^.ContextFlags := CONTEXT_CONTROL; - if not GetThreadContext(Handle, Context^) - then begin - Log('Thread %u: Unable to get context', [ID]); - Exit; - end; - - Context^.ContextFlags := CONTEXT_CONTROL; {$ifdef cpui386} - Context^.EFlags := Context^.EFlags or FLAG_TRACE_BIT; + GCurrentContext^.EFlags := GCurrentContext^.EFlags or FLAG_TRACE_BIT; {$else} {$warning singlestep not ready for 64 bit} {$endif} + FThreadContextChanged:=true; +end; - if not SetThreadContext(Handle, Context^) - then begin - Log('Thread %u: Unable to set context', [ID]); - Exit; +function TDbgWinThread.AddWatchpoint(AnAddr: TDBGPtr): integer; +var + i: integer; + + function SetBreakpoint(var dr: DWORD; ind: byte): boolean; + begin + if (Dr=0) and ((GCurrentContext^.Dr7 and (1 shl ind))=0) then + begin + GCurrentContext^.Dr7 := GCurrentContext^.Dr7 or (1 shl (ind*2)); + GCurrentContext^.Dr7 := GCurrentContext^.Dr7 or ($30000 shl (ind*4)); + Dr:=AnAddr; + FThreadContextChanged:=true; + Result := True; + end + else + result := False; + end; + +begin + result := -1; + if SetBreakpoint(GCurrentContext^.Dr0, 0) then + result := 0 + else if SetBreakpoint(GCurrentContext^.Dr1, 1) then + result := 1 + else if SetBreakpoint(GCurrentContext^.Dr2, 2) then + result := 2 + else if SetBreakpoint(GCurrentContext^.Dr3, 3) then + result := 3 + else + Process.Log('No hardware breakpoint available.'); +end; + +function TDbgWinThread.RemoveWatchpoint(AnId: integer): boolean; + + function RemoveBreakpoint(var dr: DWORD; ind: byte): boolean; + begin + if (Dr<>0) and ((GCurrentContext^.Dr7 and (1 shl (ind*2)))<>0) then + begin + GCurrentContext^.Dr7 := GCurrentContext^.Dr7 xor (1 shl (ind*2)); + GCurrentContext^.Dr7 := GCurrentContext^.Dr7 xor ($30000 shl (ind*4)); + Dr:=0; + FThreadContextChanged:=true; + Result := True; + end + else + begin + result := False; + Process.Log('HW watchpoint is not set.'); + end; + end; + +begin + case AnId of + 0: result := RemoveBreakpoint(GCurrentContext^.Dr0, 0); + 1: result := RemoveBreakpoint(GCurrentContext^.Dr1, 1); + 2: result := RemoveBreakpoint(GCurrentContext^.Dr2, 2); + 3: result := RemoveBreakpoint(GCurrentContext^.Dr3, 3); + end +end; + +procedure TDbgWinThread.BeforeContinue; +begin + if GCurrentContext^.Dr6 <> $ffff0ff0 then + begin + GCurrentContext^.Dr6:=$ffff0ff0; + FThreadContextChanged:=true; + end; + + if FThreadContextChanged then + begin + if SetThreadContext(Handle, GCurrentContext^) then + FThreadContextChanged:=false + else + Log('Thread %u: Unable to set context', [ID]) end; end; @@ -1060,6 +1135,7 @@ begin Log('Unable to set context'); Exit; end; + FThreadContextChanged:=false; Result := True; end; diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 36511799c5..e53790658e 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -837,6 +837,13 @@ begin StartDebugLoop; result := true; end; + dcStepInto: + begin + FDbgController.Step; + SetState(dsRun); + StartDebugLoop; + result := true; + end; dcStepOut: begin FDbgController.StepOut; @@ -950,7 +957,8 @@ end; function TFpDebugDebugger.GetSupportedCommands: TDBGCommands; begin - Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver, dcRunTo, dcPause, dcStepOut]; + Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver, + dcRunTo, dcPause, dcStepOut, dcStepInto]; end; end.