LazDebuggerFp (pure): Implemented step-into

git-svn-id: trunk@44862 -

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 [<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.');

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;

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.ClearHWBreakpoint;
-        FCurrentThread.ClearHiddenBreakpoint;
       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;

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,11 +428,15 @@ 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
+  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^)
+function TDbgWinThread.AddWatchpoint(AnAddr: TDBGPtr): integer;
-  then begin
+var
-    Log('Thread %u: Unable to set context', [ID]);
+  i: integer;
-    Exit;
+
+  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;
 

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.