FpDebug: deal with parentfp for nested procs

git-svn-id: trunk@44639 -

components/fpdebug/fpdbgdwarf.pas

@@ -84,20 +84,22 @@ type
     function GetMemManager: TFpDbgMemManager; override;
 
     property Symbol: TFpDbgSymbol read FSymbol;
-    property Address: TDBGPtr read FAddress;
     property Dwarf: TFpDwarfInfo read FDwarf;
+    property Address: TDBGPtr read FAddress write FAddress;
+    property ThreadId: Integer read FThreadId write FThreadId;
+    property StackFrame: Integer read FStackFrame write FStackFrame;
 
     function SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue; inline;
     procedure AddRefToVal(AVal: TFpDbgValue); inline;
     function GetSelfParameter: TFpDbgValue; virtual;
 
     function FindExportedSymbolInUnits(const AName: String; PNameUpper, PNameLower: PChar;
-      SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue; inline;
+      SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpDbgValue): Boolean; inline;
     function FindSymbolInStructure(const AName: String; PNameUpper, PNameLower: PChar;
-      InfoEntry: TDwarfInformationEntry): TFpDbgValue; inline;
+      InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; inline;
     // FindLocalSymbol: for the subroutine itself
     function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
-      InfoEntry: TDwarfInformationEntry): TFpDbgValue; virtual;
+      InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; virtual;
   public
     constructor Create(AThreadId, AStackFrame: Integer; AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo);
     destructor Destroy; override;
@@ -994,15 +996,16 @@ begin
     TFpDwarfValueBase(Result).FContext := Self;
 end;
 
-function TFpDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String;
+function TFpDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String; PNameUpper,
-  PNameUpper, PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue;
+  PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpDbgValue): Boolean;
 var
   i, ExtVal: Integer;
   CU: TDwarfCompilationUnit;
   InfoEntry, FoundInfoEntry: TDwarfInformationEntry;
   s: String;
 begin
-  Result := nil;
+  Result := False;
+  ADbgValue := nil;
   InfoEntry := nil;
   FoundInfoEntry := nil;
   i := FDwarf.CompilationUnitsCount;
@@ -1024,7 +1027,7 @@ begin
     s := CU.UnitName;
     if (s <> '') and (CompareUtf8BothCase(PNameUpper, PNameLower, @s[1])) then begin
       ReleaseRefAndNil(FoundInfoEntry);
-      Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
+      ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
       break;
     end;
 
@@ -1040,28 +1043,30 @@ begin
         if InfoEntry.ReadValue(DW_AT_external, ExtVal) then
           if ExtVal <> 0 then
             break;
-        // Search for better result
+        // Search for better ADbgValue
       end;
     end;
   end;
 
   if FoundInfoEntry <> nil then begin;
-    Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, FoundInfoEntry));
+    ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, FoundInfoEntry));
     FoundInfoEntry.ReleaseReference;
   end;
 
   InfoEntry.ReleaseReference;
+  Result := ADbgValue <> nil;
 end;
 
 function TFpDwarfInfoAddressContext.FindSymbolInStructure(const AName: String; PNameUpper,
-  PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue;
+  PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
 var
   InfoEntryInheritance: TDwarfInformationEntry;
   FwdInfoPtr: Pointer;
   FwdCompUint: TDwarfCompilationUnit;
   SelfParam: TFpDbgValue;
 begin
-  Result := nil;
+  Result := False;
+  ADbgValue := nil;
   InfoEntry.AddReference;
 
   while True do begin
@@ -1075,18 +1080,19 @@ begin
         SelfParam := GetSelfParameter;
         if (SelfParam <> nil) then begin
           // TODO: only valid, as long as context is valid, because if context is freed, then self is lost too
-          Result := SelfParam.MemberByName[AName];
+          ADbgValue := SelfParam.MemberByName[AName];
-          assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
+          assert(ADbgValue <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
-          if Result <> nil then
+          if ADbgValue <> nil then
-            Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
+            ADbgValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
         end
 else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
         ;
-        if Result = nil then begin // Todo: abort the searh /SetError
+        if ADbgValue = nil then begin // Todo: abort the searh /SetError
-          Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
+          ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
         end;
         InfoEntry.ReleaseReference;
         InfoEntryInheritance.ReleaseReference;
+        Result := True;
         exit;
       end;
     end;
@@ -1103,18 +1109,21 @@ else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
   end;
 
   InfoEntry.ReleaseReference;
+  Result := ADbgValue <> nil;
 end;
 
 function TFpDwarfInfoAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
-  PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue;
+  PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
 begin
-  Result := nil;
+  Result := False;
+  ADbgValue := nil;
   if not InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then
     exit;
   if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
-    Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
+    ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
-    TFpDwarfSymbol(Result.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol);
+    TFpDwarfSymbol(ADbgValue.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol);
   end;
+  Result := ADbgValue <> nil;
 end;
 
 constructor TFpDwarfInfoAddressContext.Create(AThreadId, AStackFrame: Integer;
@@ -1188,19 +1197,15 @@ begin
 
       tg := InfoEntry.AbbrevTag;
       if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
-        Result := FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry);
+        if FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry, Result) then
-        // TODO: check error
+          exit; // TODO: check error
-        if Result <> nil then
-          exit;
         //InfoEntry.ScopeIndex := StartScopeIdx;
       end
 
       else
       if (StartScopeIdx = SubRoutine.InformationEntry.ScopeIndex) then begin // searching in subroutine
-        Result := FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry);
+        if FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry, Result) then
-        // TODO: check error
+          exit;        // TODO: check error
-        if Result <> nil then
-          exit;
         //InfoEntry.ScopeIndex := StartScopeIdx;
       end
           // TODO: nested subroutine
@@ -1218,7 +1223,7 @@ begin
       InfoEntry.GoParent;
     end;
 
-    Result := FindExportedSymbolInUnits(AName, PNameUpper, PNameLower, CU);
+    FindExportedSymbolInUnits(AName, PNameUpper, PNameLower, CU, Result);
 
   finally
     if (Result = nil) or (InfoEntry = nil)

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -5,7 +5,8 @@ unit FpDbgDwarfFreePascal;
 interface
 
 uses
-  Classes, SysUtils, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, FpDbgUtil, DbgIntfBaseTypes;
+  Classes, SysUtils, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, FpDbgUtil, DbgIntfBaseTypes,
+  LazLoggerBase;
 
 type
 
@@ -24,10 +25,14 @@ type
   { TFpDwarfFreePascalAddressContext }
 
   TFpDwarfFreePascalAddressContext = class(TFpDwarfInfoAddressContext)
+  private
+    FOuterNestContext: TFpDbgInfoContext;
+    FOuterNotFound: Boolean;
   protected
     function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
-      InfoEntry: TDwarfInformationEntry): TFpDbgValue; override;
+      InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; override;
   public
+    destructor Destroy; override;
   end;
 
 implementation
@@ -51,33 +56,111 @@ end;
 { TFpDwarfFreePascalAddressContext }
 
 function TFpDwarfFreePascalAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
-  PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue;
+  PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
 const
   parentfp: string = 'parentfp';
   selfname: string = 'self';
+  // TODO: get reg num via memreader name-to-num
+  {$IFDEF cpu64}
+  RegFp = 6;
+  RegPc = 16;
+  {$ELSE}
+  RegFp = 5;
+  RegPc = 8;
+  {$ENDIF}
 var
   StartScopeIdx: Integer;
+  ParentFpVal: TFpDbgValue;
+  SearchCtx: TFpDwarfFreePascalAddressContext;
+  pfp, fp, pc: TDbgPtr;
+  i: Integer;
+  ParentFpSym: TFpDwarfSymbol;
 begin
+  Result := False;
   if (Length(AName) = length(selfname)) and (CompareUtf8BothCase(PNameUpper, PNameLower, @selfname[1])) then begin
-    Result := GetSelfParameter;
+    ADbgValue := GetSelfParameter;
-    if Result <> nil then begin
+    if ADbgValue <> nil then begin
-      AddRefToVal(Result);
+      AddRefToVal(ADbgValue);
+      Result := True;
       exit;
     end;
   end;
 
   StartScopeIdx := InfoEntry.ScopeIndex;
-  Result := inherited FindLocalSymbol(AName, PNameUpper, PNameLower, InfoEntry);
+  Result := inherited FindLocalSymbol(AName, PNameUpper, PNameLower, InfoEntry, ADbgValue);
-  if Result <> nil then
+  if Result then
     exit;
 
+  if FOuterNotFound then
+    exit;
+
+  if FOuterNestContext <> nil then begin
+    ADbgValue := FOuterNestContext.FindSymbol(AName); // TODO: pass upper/lower
+    Result := True; // self, global was done by outer
+    exit;
+  end;
+
+
   InfoEntry.ScopeIndex := StartScopeIdx;
   // TODO: cache
-  if not InfoEntry.GoNamedChildEx(@parentfp, @parentfp) then
+  if not InfoEntry.GoNamedChildEx(@parentfp[1], @parentfp[1]) then begin
+    FOuterNotFound := True;
     exit;
+  end;
 
+  ParentFpSym := TFpDwarfSymbol.CreateSubClass(AName, InfoEntry);
+  ParentFpVal := ParentFpSym.Value;
+  //TFpDwarfSymbol(ADbgValue.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol);
+  if not (svfOrdinal in ParentFpVal.FieldFlags) then begin
+    DebugLn('no ordinal for parentfp');
+    ParentFpSym.ReleaseReference;
+    FOuterNotFound := True;
+    exit;
+  end;
 
-  // check $parentfp
+  pfp := ParentFpVal.AsCardinal;
+  ParentFpSym.ReleaseReference;
+    DebugLn(['pfp=',pfp]);
+  if pfp = 0 then begin
+    DebugLn('no ordinal for parentfp');
+    FOuterNotFound := True;
+    exit;
+  end;
+
+  i := StackFrame + 1;
+  SearchCtx := TFpDwarfFreePascalAddressContext.Create(ThreadId, i, 0, Symbol, Dwarf);
+
+  fp := 0;
+  while not (fp = pfp) do begin
+    SearchCtx.StackFrame := i;
+    // TODO: get reg num via memreader name-to-num
+    if not MemManager.ReadRegister(RegFp, fp, SearchCtx) then
+      break;
+    inc(i);
+    if i > StackFrame + 100 then break; // something wrong? // TODO better check
+  end;
+  dec(i);
+
+  if (pfp <> fp) or
+      not MemManager.ReadRegister(RegPc, pc, SearchCtx)
+  then begin
+    FOuterNotFound := True;
+    SearchCtx.ReleaseReference;
+    exit;
+  end;
+
+  SearchCtx.ReleaseReference;
+
+  FOuterNestContext := Dwarf.FindContext(ThreadId, i, pc);
+
+  ADbgValue := FOuterNestContext.FindSymbol(AName); // TODO: pass upper/lower
+  Result := True; // self, global was done by outer
+end;
+
+destructor TFpDwarfFreePascalAddressContext.Destroy;
+begin
+  FOuterNestContext.ReleaseReference;
+  inherited Destroy;
 end;
 
 initialization

components/fpdebug/fpdmemorytools.pas

@@ -36,8 +36,8 @@ type
     function GetSizeOfAddress: Integer; virtual; abstract;
   public
     property Address: TDbgPtr read GetAddress;
-    property ThreadId: Integer read GetThreadId;  // experimental
+    property ThreadId: Integer read GetThreadId;
-    property StackFrame: Integer read GetStackFrame;  // experimental
+    property StackFrame: Integer read GetStackFrame;
     property SizeOfAddress: Integer read GetSizeOfAddress;
   end;
 

components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp

@@ -367,6 +367,7 @@ begin
       exit;
   end;
   {$ENDIF}
+  assert(AContext <> nil, 'TFpGDBMIDbgMemReader.ReadRegister: AContext <> nil');
   Reg := FDebugger.Registers.CurrentRegistersList[AContext.ThreadId, AContext.StackFrame];
   for i := 0 to Reg.Count - 1 do
     if UpperCase(Reg[i].Name) = rname then
@@ -376,6 +377,7 @@ begin
           v := RegVObj.Value[rdDefault]
         else
           v := '';
+        if pos(' ', v) > 1 then v := copy(v, 1, pos(' ', v)-1);
 debugln(['TFpGDBMIDbgMemReader.ReadRegister ',rname, '  ', v]);
         Result := true;
         try