FPGDBMIDebugger:symulate gdb's ptype for very basic requests

git-svn-id: trunk@43136 -

components/fpdebug/fpdbgdwarf.pas

@@ -516,6 +516,7 @@ type
 //    function GetReference: TDbgSymbol; override;
     //function GetSize: Integer; override;
     property TypeInfo: TDbgDwarfTypeIdentifier read GetTypeInfo;
+    property InformationEntry: TDwarfInformationEntry read FInformationEntry;
   public
     constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry); virtual;
     destructor Destroy; override;
@@ -527,6 +528,8 @@ type
   TDbgDwarfIdentifierClass = class of TDbgDwarfIdentifier;
 
   TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ...
+  public
+    property TypeInfo;
   end;
 
   { TDbgDwarfTypeIdentifier }
@@ -554,6 +557,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
   TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier)
   private
   public
+    property TypeInfo;
   end;
 
   { TDbgDwarfProcSymbol }

debugger/fpgdbmidebugger.pp

@@ -5,8 +5,9 @@ unit FpGdbmiDebugger;
 interface
 
 uses
-  Classes, sysutils, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger, GDBMIMiscClasses, maps,
+  Classes, sysutils, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger, GDBMIMiscClasses,
-  FpDbgLoader, FpDbgDwarf, LazLoggerBase, LazLoggerProfiling;
+  GDBTypeInfo, maps, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst, LazLoggerBase,
+  LazLoggerProfiling;
 
 type
 
@@ -25,7 +26,10 @@ type
     procedure LoadDwarf;
     procedure UnLoadDwarf;
     function  RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
+
+    procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
     function  GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
+    procedure AddToGDBMICache(AThreadId, AStackFrame: Integer; AnIdent: TDbgSymbol);
   public
     class function Caption: String; override;
   public
@@ -210,14 +214,19 @@ function TFpGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand;
 var
   Ident: TDbgSymbol;
   Loc: TDBGPtr;
+  CurThread, CurStack: Integer;
 begin
-  if ACommand = dcEvaluate then begin
+  if HasDwarf and (ACommand = dcEvaluate) then begin
-     DebugLn(['## ', GetLocation.Address]);
+     GetCurrentContext(CurThread, CurStack);
      Loc := GetLocationForContext(-1, -1);
 
-     if HasDwarf and (Loc <> 0) then begin
+     if (Loc <> 0) then begin
        Ident := FDwarfInfo.FindIdentifier(Loc, String(AParams[0].VAnsiString));
-       Ident.ReleaseReference;
+
+       if Ident <> nil then
+         AddToGDBMICache(CurThread, CurStack, Ident);
+
+       ReleaseRefAndNil(Ident);
      end;
 
     //EvalFlags := [];
@@ -232,13 +241,8 @@ begin
     Result := inherited RequestCommand(ACommand, AParams);
 end;
 
-function TFpGDBMIDebugger.GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
+procedure TFpGDBMIDebugger.GetCurrentContext(out AThreadId, AStackFrame: Integer);
-var
-  t: TThreadEntry;
-  s: TCallStack;
-  f: TCallStackEntry;
 begin
-  Result := 0;
   if (AThreadId <= 0) and CurrentThreadIdValid then begin
     AThreadId := CurrentThreadId;
     AStackFrame := 0;
@@ -256,6 +260,22 @@ begin
   if (AStackFrame < 0) and (not CurrentStackFrameValid) then begin
     AStackFrame := 0;
   end;
+end;
+
+function TFpGDBMIDebugger.GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
+var
+  t: TThreadEntry;
+  s: TCallStack;
+  f: TCallStackEntry;
+begin
+  Result := 0;
+  if (AThreadId <= 0) then begin
+    GetCurrentContext(AThreadId, AStackFrame);
+  end
+  else
+  if (AStackFrame < 0) then begin
+    AStackFrame := 0;
+  end;
 
   t := Threads.CurrentThreads.EntryById[AThreadId];
   if t = nil then begin
@@ -284,6 +304,74 @@ begin
 
 end;
 
+type
+  TGDBMIDwarfTypeIdentifier = class(TDbgDwarfTypeIdentifier)
+  public
+    property InformationEntry;
+  end;
+
+procedure TFpGDBMIDebugger.AddToGDBMICache(AThreadId, AStackFrame: Integer;
+  AnIdent: TDbgSymbol);
+const
+  GdbCmdPType = 'ptype ';
+  GdbCmdWhatIs = 'whatis ';
+var
+  TypeIdent: TDbgDwarfTypeIdentifier;
+  VarName, TypeName: String;
+  AReq: TGDBPTypeRequest;
+begin
+  (* Simulate gdb answers *)
+  //TypeRequestCache
+
+  if AnIdent is TDbgDwarfValueIdentifier then begin
+    VarName := TDbgDwarfValueIdentifier(AnIdent).IdentifierName;
+    TypeIdent := TDbgDwarfValueIdentifier(AnIdent).TypeInfo;
+    if TypeIdent = nil then exit;
+    TypeName := TypeIdent.IdentifierName;
+
+    if TGDBMIDwarfTypeIdentifier(TypeIdent).InformationEntry.Abbrev.tag = DW_TAG_typedef
+    then
+      TypeIdent := TDbgDwarfValueIdentifier(TypeIdent).TypeInfo;
+
+    if TGDBMIDwarfTypeIdentifier(TypeIdent).InformationEntry.Abbrev.tag = DW_TAG_base_type
+    then begin
+      AReq.ReqType := gcrtPType;
+      AReq.Request := GdbCmdPType + VarName;
+      if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
+        AReq.Result := ParseTypeFromGdb(Format('type = %s', [TypeName]));
+        TypeRequestCache.Add(AThreadId, AStackFrame, AReq)
+      end;
+
+      AReq.ReqType := gcrtPType;
+      AReq.Request := GdbCmdWhatIs + VarName;
+      if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
+        AReq.Result := ParseTypeFromGdb(Format('type = %s', [TypeName]));
+        TypeRequestCache.Add(AThreadId, AStackFrame, AReq)
+      end;
+    end;
+
+  end;
+
+
+  (*
+
+      >> TCmdLineDebugger.SendCmdLn "ptype i"
+      << TCmdLineDebugger.ReadLn "&"ptype i\n""
+      << TCmdLineDebugger.ReadLn "~"type = LONGINT\n""
+      << TCmdLineDebugger.ReadLn "^done"
+      << TCmdLineDebugger.ReadLn "(gdb) "
+      >> TCmdLineDebugger.SendCmdLn "whatis i"
+      << TCmdLineDebugger.ReadLn "&"whatis i\n""
+      << TCmdLineDebugger.ReadLn "~"type = LONGINT\n""
+      << TCmdLineDebugger.ReadLn "^done"
+      << TCmdLineDebugger.ReadLn "(gdb) "
+      >> TCmdLineDebugger.SendCmdLn "-data-evaluate-expression i"
+      << TCmdLineDebugger.ReadLn "^done,value="0""
+      << TCmdLineDebugger.ReadLn "(gdb) "
+
+  *)
+end;
+
 function TFpGDBMIDebugger.CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging;
 begin
   Result := TFpGDBMIDebuggerCommandStartDebugging.Create(Self, AContinueCommand);

debugger/gdbmidebugger.pp

@@ -778,6 +778,8 @@ type
     property CurrentThreadId: Integer read FCurrentThreadId;
     property CurrentStackFrameValid: Boolean read FCurrentStackFrameValid;
     property CurrentThreadIdValid: Boolean read FCurrentThreadIdValid;
+
+    property TypeRequestCache: TGDBPTypeRequestCache read FTypeRequestCache;
   public
     class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
     class function Caption: String; override;