paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 19:16:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazDebuggerFp (pure): Implemented step-into

Browse Source 
git-svn-id: trunk@44862 -
This commit is contained in:
joost 2014-04-30 20:44:22 +00:00
parent 978eda5ac9
commit e7779bd476
5 changed files with 208 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/fpdebug/app/fpd/fpdcommand.pas
View File

@ -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 [<adress>|<location>]: Lists the source for <adress> or <location>');
MCommands.AddCommand(['memory', 'mem', 'm'], @HandleMemory, 'memory [-<size>] [<adress> <count>|<location> <count>]: Dump <count> (default: 1) from memory <adress> or <location> (default: current) of <size> (default: 4) bytes, where size is 1,2,4,8 or 16.');

80
components/fpdebug/fpdbgclasses.pp
View File

@ -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;

24
components/fpdebug/fpdbgcontroller.pas
View File

@ -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;

120
components/fpdebug/fpdbgwinclasses.pas
View File

@ -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;

10
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -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.