FpGdbmiDebugger: Add Locals

git-svn-id: trunk@44815 -

components/fpdebug/fpdbgdwarf.pas

@@ -77,6 +77,7 @@ type
     FlastResult: TFpDbgValue;
   protected
     function GetSymbolAtAddress: TFpDbgSymbol; override;
+    function GetProcedureAtAddress: TFpDbgValue; override;
     function GetAddress: TDbgPtr; override;
     function GetThreadId: Integer; override;
     function GetStackFrame: Integer; override;
@@ -813,6 +814,8 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
   TFpDwarfSymbolValueProc = class(TFpDwarfSymbolValue)
   private
     //FCU: TDwarfCompilationUnit;
+    FProcMembers: TRefCntObjList; // Locals
+    FLastMember: TFpDbgSymbol;
     FAddress: TDbgPtr;
     FAddressInfo: PDwarfAddressInfo;
     FStateMachine: TDwarfLineInfoStateMachine;
@@ -820,7 +823,12 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     FSelfParameter: TFpDwarfValue;
     function StateMachineValid: Boolean;
     function  ReadVirtuality(out AFlags: TDbgSymbolFlags): Boolean;
+    procedure CreateMembers;
   protected
+    function GetMember(AIndex: Int64): TFpDbgSymbol; override;
+    function GetMemberByName(AIndex: String): TFpDbgSymbol; override;
+    function GetMemberCount: Integer; override;
+
     function  GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
     procedure KindNeeded; override;
     procedure SizeNeeded; override;
@@ -941,6 +949,12 @@ begin
   Result := FSymbol;
 end;
 
+function TFpDwarfInfoAddressContext.GetProcedureAtAddress: TFpDbgValue;
+begin
+  Result := inherited GetProcedureAtAddress;
+  ApplyContext(Result);
+end;
+
 function TFpDwarfInfoAddressContext.GetAddress: TDbgPtr;
 begin
   Result := FAddress;
@@ -2989,7 +3003,7 @@ begin
   then begin
     if FMembers = nil then
       FMembers := TFpDbgCircularRefCntObjList.Create;
-    FMembers.Add(Result);
+    FMembers.Add(Result); //TODO: last member only?
   end;
 end;
 
@@ -4359,6 +4373,8 @@ end;
 
 destructor TFpDwarfSymbolValueProc.Destroy;
 begin
+  FreeAndNil(FProcMembers);
+  FLastMember.ReleaseReference(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember');
   FreeAndNil(FStateMachine);
   if FSelfParameter <> nil then begin
     //TDbgDwarfIdentifier(FSelfParameter.DbgSymbol).ParentTypeInfo := nil;
@@ -4458,6 +4474,68 @@ begin
   end;
 end;
 
+procedure TFpDwarfSymbolValueProc.CreateMembers;
+var
+  Info: TDwarfInformationEntry;
+  Info2: TDwarfInformationEntry;
+  sym: TFpDwarfSymbol;
+begin
+  if FProcMembers <> nil then
+    exit;
+  FProcMembers := TRefCntObjList.Create;
+  Info := InformationEntry.Clone;
+  Info.GoChild;
+
+  while Info.HasValidScope do begin
+    if ((Info.AbbrevTag = DW_TAG_formal_parameter) or (Info.AbbrevTag = DW_TAG_variable)) //and
+       //not(Info.IsArtificial)
+    then begin
+      Info2 := Info.Clone;
+      FProcMembers.Add(Info2);
+      Info2.ReleaseReference;
+    end;
+    Info.GoNext;
+  end;
+
+  Info.ReleaseReference;
+end;
+
+function TFpDwarfSymbolValueProc.GetMember(AIndex: Int64): TFpDbgSymbol;
+begin
+  CreateMembers;
+  FLastMember.ReleaseReference(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember');
+  FLastMember := TFpDwarfSymbol.CreateSubClass('', TDwarfInformationEntry(FProcMembers[AIndex]));
+  {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember');{$ENDIF}
+  Result := FLastMember;
+end;
+
+function TFpDwarfSymbolValueProc.GetMemberByName(AIndex: String): TFpDbgSymbol;
+var
+  Info: TDwarfInformationEntry;
+  s, s2: String;
+  i: Integer;
+begin
+  CreateMembers;
+  s2 := LowerCase(AIndex);
+  FLastMember.ReleaseReference(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember');
+  FLastMember := nil;;
+  for i := 0 to FProcMembers.Count - 1 do begin
+    Info := TDwarfInformationEntry(FProcMembers[i]);
+    if Info.ReadName(s) and (LowerCase(s) = s2) then begin
+      FLastMember := TFpDwarfSymbol.CreateSubClass('', Info);
+      {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember');{$ENDIF}
+      break;
+    end;
+  end;
+  Result := FLastMember;
+end;
+
+function TFpDwarfSymbolValueProc.GetMemberCount: Integer;
+begin
+  CreateMembers;
+  Result := FProcMembers.Count;
+end;
+
 function TFpDwarfSymbolValueProc.GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
 var
   Val: TByteDynArray;

components/fpdebug/fpdbginfo.pas

@@ -429,9 +429,11 @@ type
   TFpDbgInfoContext = class(TFpDbgAddressContext)
   protected
     function GetSymbolAtAddress: TFpDbgSymbol; virtual;
+    function GetProcedureAtAddress: TFpDbgValue; virtual;
     function GetMemManager: TFpDbgMemManager; virtual;
   public
     property SymbolAtAddress: TFpDbgSymbol read GetSymbolAtAddress;
+    property ProcedureAtAddress: TFpDbgValue read GetProcedureAtAddress;
     // search this, and all parent context
     function FindSymbol(const {%H-}AName: String): TFpDbgValue; virtual;
     property MemManager: TFpDbgMemManager read GetMemManager;
@@ -783,6 +785,11 @@ begin
   Result := nil;
 end;
 
+function TFpDbgInfoContext.GetProcedureAtAddress: TFpDbgValue;
+begin
+  Result := SymbolAtAddress.Value;
+end;
+
 function TFpDbgInfoContext.GetSymbolAtAddress: TFpDbgSymbol;
 begin
   Result := nil;

components/lazdebuggergdbmi/gdbmidebugger.pp

@@ -646,6 +646,23 @@ type
     destructor Destroy; override;
   end;
 
+  { TGDBMILocals }
+
+  TGDBMILocals = class(TLocalsSupplier)
+  private
+    FCommandList: TList;
+    procedure CancelEvaluation; deprecated;
+    procedure DoEvaluationDestroyed(Sender: TObject);
+  protected
+    procedure CancelAllCommands;
+    function  ForceQueuing: Boolean;
+  public
+    procedure Changed;
+    constructor Create(const ADebugger: TDebuggerIntf);
+    destructor Destroy; override;
+    procedure RequestData(ALocals: TLocals); override;
+  end;
+
   { TGDBMIDebugger }
 
   TGDBMIDebugger = class(TGDBMICmdLineDebugger) // TODO: inherit from TDebugger direct
@@ -951,22 +968,6 @@ type
     function DebugText: String; override;
   end;
 
-  { TGDBMILocals }
-
-  TGDBMILocals = class(TLocalsSupplier)
-  private
-    FCommandList: TList;
-    procedure CancelEvaluation; deprecated;
-    procedure DoEvaluationDestroyed(Sender: TObject);
-  protected
-    procedure CancelAllCommands;
-  public
-    procedure Changed;
-    constructor Create(const ADebugger: TDebuggerIntf);
-    destructor Destroy; override;
-    procedure RequestData(ALocals: TLocals); override;
-  end;
-
   {%endregion   ^^^^^  Locals  ^^^^^   }
 
   {%region      *****  LineSymbolInfo  *****   }
@@ -9925,9 +9926,16 @@ begin
   FCommandList.Clear;
 end;
 
+function TGDBMILocals.ForceQueuing: Boolean;
+begin
+  Result := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
+            and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
+            and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued)
+            and (Debugger.State <> dsInternalPause);
+end;
+
 procedure TGDBMILocals.RequestData(ALocals: TLocals);
 var
-  ForceQueue: Boolean;
   EvaluationCmdObj: TGDBMIDebuggerCommandLocals;
 begin
   if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
@@ -9936,12 +9944,8 @@ begin
   EvaluationCmdObj.OnDestroy   := @DoEvaluationDestroyed;
   EvaluationCmdObj.Priority := GDCMD_PRIOR_LOCALS;
   EvaluationCmdObj.Properties := [dcpCancelOnRun];
-  ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
-            and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
-            and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued)
-            and (Debugger.State <> dsInternalPause);
   FCommandList.add(EvaluationCmdObj);
-  TGDBMIDebugger(Debugger).QueueCommand(EvaluationCmdObj, ForceQueue);
+  TGDBMIDebugger(Debugger).QueueCommand(EvaluationCmdObj, ForceQueuing);
   (* DoEvaluationFinished may be called immediately at this point *)
 end;
 

components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp

@@ -79,6 +79,7 @@ type
     function CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; override;
     function CreateLineInfo: TDBGLineInfo; override;
     function  CreateWatches: TWatchesSupplier; override;
+    function  CreateLocals: TLocalsSupplier; override;
     procedure DoState(const OldState: TDBGState); override;
     function  HasDwarf: Boolean;
     procedure LoadDwarf;
@@ -153,6 +154,33 @@ type
   public
   end;
 
+  TFPGDBMILocals = class;
+
+  { TFpGDBMIDebuggerCommandLocals }
+
+  TFpGDBMIDebuggerCommandLocals = class(TGDBMIDebuggerCommand)
+  private
+    FOwner: TFPGDBMILocals;
+    FLocals: TLocals;
+  protected
+    function DoExecute: Boolean; override;
+    procedure DoLockQueueExecute; override;
+    procedure DoUnLockQueueExecute; override;
+  public
+    constructor Create(AOwner: TFPGDBMILocals; ALocals: TLocals);
+  end;
+
+  { TFPGDBMILocals }
+
+  TFPGDBMILocals = class(TGDBMILocals)
+  private
+    procedure ProcessLocals(ALocals: TLocals);
+  protected
+    function  FpDebugger: TFpGDBMIDebugger;
+  public
+    procedure RequestData(ALocals: TLocals); override;
+  end;
+
   { TFpGDBMILineInfo }
 
   TFpGDBMILineInfo = class(TDBGLineInfo) //class(TGDBMILineInfo)
@@ -183,6 +211,8 @@ begin
   UseGDB := (MenuCmd.MenuItem <> nil) and MenuCmd.MenuItem.Checked;
   if (CurrentDebugger <> nil) and (CurrentDebugger.Watches <> nil) then
     CurrentDebugger.Watches.CurrentWatches.ClearValues;
+  if (CurrentDebugger <> nil) and (CurrentDebugger.Locals <> nil) then
+    CurrentDebugger.Locals.CurrentLocalsList.Clear;
 end;
 
 // This Accessor hack is temporarilly needed / the final version will not show gdb data
@@ -193,6 +223,98 @@ begin
   TWatchValueHack(AWatchValue).DoDataValidityChanged(ddsRequested);
 end;
 
+{ TFpGDBMIDebuggerCommandLocals }
+
+function TFpGDBMIDebuggerCommandLocals.DoExecute: Boolean;
+begin
+  FOwner.ProcessLocals(FLocals);
+  Result := True;
+end;
+
+procedure TFpGDBMIDebuggerCommandLocals.DoLockQueueExecute;
+begin
+  //
+end;
+
+procedure TFpGDBMIDebuggerCommandLocals.DoUnLockQueueExecute;
+begin
+  //
+end;
+
+constructor TFpGDBMIDebuggerCommandLocals.Create(AOwner: TFPGDBMILocals; ALocals: TLocals);
+begin
+  inherited Create(AOwner.FpDebugger);
+  FOwner := AOwner;
+  FLocals := ALocals;
+  Priority := 1; // before watches
+end;
+
+{ TFPGDBMILocals }
+
+procedure TFPGDBMILocals.ProcessLocals(ALocals: TLocals);
+var
+  Ctx: TFpDbgInfoContext;
+  ProcVal: TFpDbgValue;
+  i: Integer;
+  m: TFpDbgValue;
+  n, v: String;
+begin
+  Ctx := FpDebugger.GetInfoContextForContext(ALocals.ThreadId, ALocals.StackFrame);
+  if (Ctx = nil) or (Ctx.SymbolAtAddress = nil) then begin
+    ALocals.SetDataValidity(ddsInvalid);
+    exit;
+  end;
+
+  ProcVal := Ctx.ProcedureAtAddress;
+
+  if (ProcVal = nil) then begin
+    ALocals.SetDataValidity(ddsInvalid);
+    exit;
+  end;
+  FpDebugger.FPrettyPrinter.AddressSize := ctx.SizeOfAddress;
+
+  ALocals.Clear;
+  for i := 0 to ProcVal.MemberCount - 1 do begin
+    m := ProcVal.Member[i];
+    if m <> nil then begin
+      if m.DbgSymbol <> nil then
+        n := m.DbgSymbol.Name
+      else
+        n := '';
+      FpDebugger.FPrettyPrinter.PrintValue(v, m);
+      ALocals.Add(n, v);
+    end;
+  end;
+  ALocals.SetDataValidity(ddsValid);
+end;
+
+function TFPGDBMILocals.FpDebugger: TFpGDBMIDebugger;
+begin
+  Result := TFpGDBMIDebugger(Debugger);
+end;
+
+procedure TFPGDBMILocals.RequestData(ALocals: TLocals);
+var
+  LocalsCmdObj: TFpGDBMIDebuggerCommandLocals;
+begin
+  if UseGDB then begin
+    inherited RequestData(ALocals);
+    exit;
+  end;
+
+  if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
+    Exit;
+  end;
+
+  FpDebugger.Threads.CurrentThreads.Count; // trigger threads, in case
+
+  // Join the queue, registers and threads are needed first
+  LocalsCmdObj := TFpGDBMIDebuggerCommandLocals.Create(Self, ALocals);
+  LocalsCmdObj.Properties := [dcpCancelOnRun];
+  // If a ExecCmd is running, then defer exec until the exec cmd is done
+  FpDebugger.QueueCommand(LocalsCmdObj, ForceQueuing);
+end;
+
 { TFpGDBMIDebuggerCommandEvaluate }
 
 function TFpGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
@@ -229,6 +351,7 @@ constructor TFpGDBMIDebuggerCommandEvaluate.Create(AOwner: TFPGDBMIWatches);
 begin
   inherited Create(AOwner.FpDebugger);
   FOwner := AOwner;
+  //Priority := 0;
 end;
 
 { TFpGDBMIAndWin32DbgMemReader }
@@ -475,7 +598,7 @@ begin
     Exit;
   end;
 
-  AWatchValue.AddFreeeNotification(@FpDebugger.DoWatchFreed); // we may call gdb
+  AWatchValue.AddFreeNotification(@FpDebugger.DoWatchFreed); // we may call gdb
   FpDebugger.FWatchEvalList.Add(pointer(AWatchValue));
 
   if FEvaluationCmdObj <> nil then exit;
@@ -1092,6 +1215,11 @@ begin
   Result := TFPGDBMIWatches.Create(Self);
 end;
 
+function TFpGDBMIDebugger.CreateLocals: TLocalsSupplier;
+begin
+  Result := TFPGDBMILocals.Create(Self);
+end;
+
 class function TFpGDBMIDebugger.Caption: String;
 begin
   Result := 'GNU debugger (with fpdebug)';