diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index c8039db355..d0bf52379d 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/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; - PNameUpper, PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue; +function TFpDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String; PNameUpper, + 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]; - assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]'); - if Result <> nil then - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF}; + ADbgValue := SelfParam.MemberByName[AName]; + assert(ADbgValue <> nil, 'FindSymbol: SelfParam.MemberByName[AName]'); + if ADbgValue <> nil then + 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 - Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry)); + if ADbgValue = nil then begin // Todo: abort the searh /SetError + 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)); - TFpDwarfSymbol(Result.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol); + ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry)); + 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); - // TODO: check error - if Result <> nil then - exit; + if FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry, Result) then + exit; // TODO: check error //InfoEntry.ScopeIndex := StartScopeIdx; end else if (StartScopeIdx = SubRoutine.InformationEntry.ScopeIndex) then begin // searching in subroutine - Result := FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry); - // TODO: check error - if Result <> nil then - exit; + if FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry, Result) then + exit; // TODO: check error //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) diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas index e239b0c502..3d4a20106f 100644 --- a/components/fpdebug/fpdbgdwarffreepascal.pas +++ b/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; - if Result <> nil then begin - AddRefToVal(Result); + ADbgValue := GetSelfParameter; + if ADbgValue <> nil then begin + AddRefToVal(ADbgValue); + Result := True; exit; end; end; StartScopeIdx := InfoEntry.ScopeIndex; - Result := inherited FindLocalSymbol(AName, PNameUpper, PNameLower, InfoEntry); - if Result <> nil then + Result := inherited FindLocalSymbol(AName, PNameUpper, PNameLower, InfoEntry, ADbgValue); + 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 diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index 75843617b0..e2ab0a4658 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/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 StackFrame: Integer read GetStackFrame; // experimental + property ThreadId: Integer read GetThreadId; + property StackFrame: Integer read GetStackFrame; property SizeOfAddress: Integer read GetSizeOfAddress; end; diff --git a/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp b/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp index b43208b48f..2965ff6558 100644 --- a/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp +++ b/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