LazDebuggerFp (pure): Implemented basic callstack

git-svn-id: trunk@44906 -

components/fpdebug/app/fpd/fpdcommand.pas

@@ -588,8 +588,8 @@ end;
 
 procedure HandleShowCallStack(AParams: String; out CallProcessLoop: boolean);
 var
-  Address, Frame, LastFrame: QWord;
-  Size, Count: integer;
+  ACallStack: TDbgCallstackEntryList;
+  i: Integer;
 begin
   CallProcessLoop:=false;
   if (GController.MainProcess = nil)
@@ -598,21 +598,19 @@ begin
     Exit;
   end;
 
-  Address := GController.CurrentProcess.GetInstructionPointerRegisterValue;
-  Frame := GController.CurrentProcess.GetStackBasePointerRegisterValue;;
-  Size := sizeof(pointer);
-
   WriteLN('Callstack:');
-  WriteLn(' ', FormatAddress(Address));
-  LastFrame := 0;
-  Count := 25;
-  while (Frame <> 0) and (Frame > LastFrame) do
-  begin
-    if not GController.CurrentProcess.ReadData(Frame + Size, Size, Address) or (Address = 0) then Break;
-    WriteLn(' ', FormatAddress(Address));
-    Dec(count);
-    if Count <= 0 then Exit;
-    if not GController.CurrentProcess.ReadData(Frame, Size, Frame) then Break;
+  ACallStack := GController.CurrentProcess.MainThread.CreateCallStackEntryList;
+  try
+    for i := 0 to ACallStack.Count-1 do
+    begin
+      write(' ', FormatAddress(ACallStack.Items[i].AnAddress),' ');
+      if ACallStack.Items[i].SourceFile<>'' then
+        writeln(ACallStack.Items[i].SourceFile,':',ACallStack.Items[i].Line)
+      else
+        writeln('unknown');
+    end;
+  finally
+    ACallStack.Free;
   end;
 end;
 

components/fpdebug/fpdbgclasses.pp

@@ -80,6 +80,29 @@ type
     function FindRegisterByDwarfIndex(AnIdx: cardinal): TDbgRegisterValue;
   end;
 
+  { TDbgCallstackEntry }
+  TDbgThread = class;
+
+  TDbgCallstackEntry = class
+  private
+    FAnAddress: TDBGPtr;
+    FFrameAdress: TDBGPtr;
+    FThread: TDbgThread;
+    FIsSymbolResolved: boolean;
+    FSymbol: TFpDbgSymbol;
+    function GetSymbol: TFpDbgSymbol;
+    function GetLine: integer;
+    function GetSourceFile: string;
+  public
+    constructor create(AThread: TDbgThread; AFrameAddress, AnAddress: TDBGPtr);
+    property AnAddress: TDBGPtr read FAnAddress;
+    property FrameAdress: TDBGPtr read FFrameAdress;
+    property SourceFile: string read GetSourceFile;
+    property Line: integer read GetLine;
+  end;
+
+  TDbgCallstackEntryList = specialize TFPGObjectList<TDbgCallstackEntry>;
+
   TDbgProcess = class;
 
   { TDbgMemReader }
@@ -128,6 +151,7 @@ type
     procedure BeforeContinue; virtual;
     function AddWatchpoint(AnAddr: TDBGPtr): integer; virtual;
     function RemoveWatchpoint(AnId: integer): boolean; virtual;
+    function CreateCallStackEntryList: TDbgCallstackEntryList; virtual;
     procedure AfterHitBreak;
     procedure ClearHWBreakpoint;
     destructor Destroy; override;
@@ -337,6 +361,44 @@ begin
   result := GOSDbgClasses;
 end;
 
+{ TDbgCallstackEntry }
+
+function TDbgCallstackEntry.GetSymbol: TFpDbgSymbol;
+begin
+  if not FIsSymbolResolved then
+    FSymbol := FThread.Process.FindSymbol(FAnAddress);
+  result := FSymbol;
+end;
+
+function TDbgCallstackEntry.GetLine: integer;
+var
+  Symbol: TFpDbgSymbol;
+begin
+  Symbol := GetSymbol;
+  if assigned(Symbol) then
+    result := Symbol.Line
+  else
+    result := -1;
+end;
+
+function TDbgCallstackEntry.GetSourceFile: string;
+var
+  Symbol: TFpDbgSymbol;
+begin
+  Symbol := GetSymbol;
+  if assigned(Symbol) then
+    result := Symbol.FileName
+  else
+    result := '';
+end;
+
+constructor TDbgCallstackEntry.create(AThread: TDbgThread; AFrameAddress, AnAddress: TDBGPtr);
+begin
+  FThread := AThread;
+  FFrameAdress:=AFrameAddress;
+  FAnAddress:=AnAddress;
+end;
+
 { TDbgMemReader }
 
 constructor TDbgMemReader.Create(ADbgProcess: TDbgProcess);
@@ -904,6 +966,34 @@ begin
   result := false;
 end;
 
+function TDbgThread.CreateCallStackEntryList: TDbgCallstackEntryList;
+var
+  Address, Frame, LastFrame: QWord;
+  Size, Count: integer;
+  AnEntry: TDbgCallstackEntry;
+begin
+  Address := Process.GetInstructionPointerRegisterValue;
+  Frame := Process.GetStackBasePointerRegisterValue;;
+  Size := sizeof(pointer);
+
+  result := TDbgCallstackEntryList.Create;
+  result.FreeObjects:=true;
+  AnEntry := TDbgCallstackEntry.create(Self, Frame, Address);
+  Result.Add(AnEntry);
+
+  LastFrame := 0;
+  Count := 25;
+  while (Frame <> 0) and (Frame > LastFrame) do
+  begin
+    if not Process.ReadData(Frame + Size, Size, Address) or (Address = 0) then Break;
+    AnEntry := TDbgCallstackEntry.create(Self, Frame, Address);
+    Result.Add(AnEntry);
+    Dec(count);
+    if Count <= 0 then Break;
+    if not Process.ReadData(Frame, Size, Frame) then Break;
+  end;
+end;
+
 procedure TDbgThread.AfterHitBreak;
 begin
   FStepping:=false;

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -8,6 +8,7 @@ uses
   Classes,
   SysUtils,
   Forms,
+  Maps,
   LazLogger,
   FpDbgClasses,
   FpDbgInfo,
@@ -57,6 +58,7 @@ type
     function CreateWatches: TWatchesSupplier; override;
     function CreateLocals: TLocalsSupplier; override;
     function  CreateRegisters: TRegisterSupplier; override;
+    function CreateCallStack: TCallStackSupplier; override;
     function CreateDisassembler: TDBGDisassembler; override;
     function CreateBreakPoints: TDBGBreakPoints; override;
     function  RequestCommand(const ACommand: TDBGCommand;
@@ -113,6 +115,19 @@ type
     destructor Destroy; override;
   end;
 
+  { TFPCallStackSupplier }
+
+  TFPCallStackSupplier = class(TCallStackSupplier)
+  private
+    FCallStack: TDbgCallstackEntryList;
+  protected
+    procedure DoStateLeavePause; override;
+  public
+    procedure RequestCount(ACallstack: TCallStackBase); override;
+    procedure RequestEntries(ACallstack: TCallStackBase); override;
+    destructor Destroy; override;
+  end;
+
   { TFPLocals }
 
   TFPLocals = class(TLocalsSupplier)
@@ -178,6 +193,68 @@ begin
   RegisterDebugger(TFpDebugDebugger);
 end;
 
+{ TFPCallStackSupplier }
+
+procedure TFPCallStackSupplier.DoStateLeavePause;
+begin
+  FreeAndNil(FCallStack);
+  inherited DoStateLeavePause;
+end;
+
+procedure TFPCallStackSupplier.RequestCount(ACallstack: TCallStackBase);
+var
+  Address, Frame, LastFrame: QWord;
+  Size, Count: integer;
+begin
+  if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause])
+  then begin
+    ACallstack.SetCountValidity(ddsInvalid);
+    exit;
+  end;
+  if not assigned(FCallStack) then
+    FCallStack := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.MainThread.CreateCallStackEntryList;
+
+  if FCallStack.Count = 0 then
+  begin
+    ACallstack.SetCountValidity(ddsInvalid);
+    ACallstack.SetHasAtLeastCountInfo(ddsInvalid);
+  end
+  else
+  begin
+    ACallstack.Count := FCallStack.Count;
+    ACallstack.SetCountValidity(ddsValid);
+  end;
+end;
+
+procedure TFPCallStackSupplier.RequestEntries(ACallstack: TCallStackBase);
+var
+  e: TCallStackEntry;
+  It: TMapIterator;
+begin
+  It := TMapIterator.Create(ACallstack.RawEntries);
+
+  if not It.Locate(ACallstack.LowestUnknown )
+  then if not It.EOM
+  then It.Next;
+
+  while (not IT.EOM) and (TCallStackEntry(It.DataPtr^).Index < ACallstack.HighestUnknown)
+  do begin
+    e := TCallStackEntry(It.DataPtr^);
+    if e.Validity = ddsRequested then
+    begin
+      e.Init(FCallStack[e.Index].AnAddress, nil, '', FCallStack[e.Index].SourceFile, '', FCallStack[e.Index].Line, ddsValid);
+    end;
+    It.Next;
+  end;
+  It.Free;
+end;
+
+destructor TFPCallStackSupplier.Destroy;
+begin
+  FCallStack.Free;
+  inherited Destroy;
+end;
+
 { TFPLocals }
 
 function TFPLocals.FpDebugger: TFpDebugDebugger;
@@ -711,6 +788,11 @@ begin
   Result := TFPRegisters.Create(Self);
 end;
 
+function TFpDebugDebugger.CreateCallStack: TCallStackSupplier;
+begin
+  Result:=TFPCallStackSupplier.Create(Self);
+end;
+
 function TFpDebugDebugger.CreateDisassembler: TDBGDisassembler;
 begin
   Result:=TFPDBGDisassembler.Create(Self);