diff --git a/components/fpdebug/fpdbgsymtable.pas b/components/fpdebug/fpdbgsymtable.pas index 88acb474f2..9614d61a20 100644 --- a/components/fpdebug/fpdbgsymtable.pas +++ b/components/fpdebug/fpdbgsymtable.pas @@ -6,34 +6,63 @@ unit fpDbgSymTable; interface uses - DbgIntfBaseTypes, - fgl, Classes; + DbgIntfBaseTypes, LazLoggerBase, FpDbgUtil, + fgl, generics.Collections, Classes, sysutils; type TfpLinkerSymbol = record - Addr: TDBGPtr; + Name: string; SectionEnd: TDBGPtr; // Max upper Addr bound + Next: integer; end; PfpLinkerSymbol = ^TfpLinkerSymbol; { TfpSymbolList } - // TODO: TFPGMapObject, if we store more data - TfpSymbolList= class(specialize TFPGMap) + TfpSymbolList= class(specialize TFPGMap) + private type + TNameDict = specialize TDictionary; + private const + LIST_INIT_WAITING = 0; + LIST_INIT_RUN = 1; + LIST_INIT_DONE = 2; private FHighAddr: TDBGPtr; FLowAddr: TDBGPtr; + FFirstAddr, FLastAddr: TDBGPtr; + FNameDict: TNameDict; + FInitSortState, FInitHashState: integer; + FThreadQueue: TFpGlobalThreadWorkerQueue; function GetDataPtr(const AIndex: Integer): PfpLinkerSymbol; - function GetKeyDataPtr(const AKey: string): PfpLinkerSymbol; + procedure InitSort; + procedure InitHashes; + procedure WaitForSortInit; + procedure WaitForHashInit; public + constructor Create; + destructor Destroy; override; + procedure SortAndHash; procedure SetAddressBounds(ALowAddr, AHighAddr: TDBGPtr); + function GetInfo(const AName: String; out AnAddr: TDBGPtr; out AFoundName: String; ACaseSense: Boolean = False): Boolean; + function GetInfo(AnAddr: TDBGPtr; out AFoundAddr: TDBGPtr; out AFoundName: String; AnExact: Boolean = True): Boolean; property LowAddr: TDBGPtr read FLowAddr; property HighAddr: TDBGPtr read FHighAddr; - function Add(const AKey: String; const AData: TDBGPtr): Integer; inline; overload; - function Add(const AKey: String; const AData, ASectionEnd: TDBGPtr): Integer; inline; overload; - property KeyDataPtr[const AKey: string]: PfpLinkerSymbol read GetKeyDataPtr; + function Add(const AName: String; const AnAddr: TDBGPtr; ASectionEnd: TDBGPtr = 0): Integer; inline; overload; property DataPtr[const AIndex: Integer]: PfpLinkerSymbol read GetDataPtr; + property FirstAddr: TDBGPtr read FFirstAddr; + property LastAddr: TDBGPtr read FLastAddr; + end; + + { TFpThreadWorkerSymbolList } + + TFpThreadWorkerSymbolList = class(TFpThreadWorkerItem) + strict private + FList: TfpSymbolList; + protected + procedure DoExecute; override; + public + constructor Create(AList: TfpSymbolList); end; implementation @@ -45,9 +74,110 @@ begin Result := PfpLinkerSymbol(TFPSMap(Self).Data[AIndex]); end; -function TfpSymbolList.GetKeyDataPtr(const AKey: string): PfpLinkerSymbol; +procedure TfpSymbolList.InitSort; +var + p: PfpLinkerSymbol; begin - Result := PfpLinkerSymbol(TFPSMap(Self).KeyData[@AKey]); + Sorted := True; + if Count = 0 then + exit; + FFirstAddr := Keys[0]; + + p := PfpLinkerSymbol(TFPSMap(Self).Data[Count-1]); + FLastAddr := Keys[Count-1]; + + if p ^.SectionEnd > FLastAddr then + FLastAddr := p ^.SectionEnd + else + FLastAddr := FLastAddr + 16000; // Just some bit after the last sym +end; + +procedure TfpSymbolList.InitHashes; +var + i, j: Integer; + p, p2: PfpLinkerSymbol; + s: String; +begin + FNameDict.Capacity := Count + Count div 2; + for i := 0 to Count - 1 do begin + p := PfpLinkerSymbol(TFPSMap(Self).Data[i]); + s := UpperCase(p^.Name); + if FNameDict.TryGetValue(s, j) then begin + p2 := PfpLinkerSymbol(TFPSMap(Self).Data[j]); + while p2^.Next >= 0 do + p2 := PfpLinkerSymbol(TFPSMap(Self).Data[p2^.Next]); + p2^.Next := i; + end + else + FNameDict.Add(s, i); + end; +end; + +procedure TfpSymbolList.WaitForSortInit; +begin + if FInitSortState = LIST_INIT_DONE then + exit; + + if InterlockedCompareExchange(FInitSortState, LIST_INIT_RUN, LIST_INIT_WAITING) = LIST_INIT_WAITING then begin + InitSort; + FInitSortState := LIST_INIT_DONE; + exit; + end; + + // might be called from within worker thread + ReadBarrier; + while FInitSortState <> LIST_INIT_DONE do begin + sleep(1); + ReadBarrier; + end; +end; + +procedure TfpSymbolList.WaitForHashInit; +begin + if FInitHashState = LIST_INIT_DONE then + exit; + + if InterlockedCompareExchange(FInitHashState, LIST_INIT_RUN, LIST_INIT_WAITING) = LIST_INIT_WAITING then begin + WaitForSortInit; + InitHashes; + FInitHashState := LIST_INIT_DONE; + exit; + end; + + ReadBarrier; + while FInitHashState <> LIST_INIT_DONE do begin + sleep(1); + ReadBarrier; + end; +end; + +constructor TfpSymbolList.Create; +begin + FNameDict := TNameDict.Create; + inherited; +end; + +destructor TfpSymbolList.Destroy; +begin + inherited Destroy; + if FThreadQueue <> nil then + FThreadQueue.DecRef; + FNameDict.Destroy; +end; + +procedure TfpSymbolList.SortAndHash; +var + w: TFpThreadWorkerSymbolList; +begin + FNameDict.Clear; + FInitSortState := LIST_INIT_WAITING; + ReadBarrier; + if FThreadQueue = nil then begin + FThreadQueue := FpDbgGlobalWorkerQueue; + FThreadQueue.AddRef; + end; + w := TFpThreadWorkerSymbolList.Create(Self); + FThreadQueue.PushItem(w); end; procedure TfpSymbolList.SetAddressBounds(ALowAddr, AHighAddr: TDBGPtr); @@ -56,23 +186,114 @@ begin FHighAddr := AHighAddr; end; -function TfpSymbolList.Add(const AKey: String; const AData: TDBGPtr): Integer; +function TfpSymbolList.GetInfo(const AName: String; out AnAddr: TDBGPtr; out AFoundName: String; + ACaseSense: Boolean): Boolean; var - d: TfpLinkerSymbol; + i: LongInt; + p: PfpLinkerSymbol; begin - d.Addr := AData; - d.SectionEnd := 0; - Result := Add(AKey, d); + WaitForHashInit; + + AnAddr := 0; + AFoundName := ''; + Result := FNameDict.TryGetValue(UpperCase(AName), i); + if not Result then + exit; + p := PfpLinkerSymbol(TFPSMap(Self).Data[i]); + + if ACaseSense then begin + while (p^.Name <> AName) do begin + if p^.Next < 0 then + exit(False); + i := p^.Next; + p := PfpLinkerSymbol(TFPSMap(Self).Data[i]); + end; + end; + + Result := i >= 0; + if Result then begin + AnAddr := Keys[i]; + AFoundName := p^.Name; + end; end; -function TfpSymbolList.Add(const AKey: String; const AData, ASectionEnd: TDBGPtr - ): Integer; +function TfpSymbolList.GetInfo(AnAddr: TDBGPtr; out AFoundAddr: TDBGPtr; out AFoundName: String; + AnExact: Boolean): Boolean; +var + L, H, M: Integer; + K: TDBGPtr; + p: PfpLinkerSymbol; +begin + WaitForSortInit; + + AFoundAddr := 0; + AFoundName := ''; + Result := False; + + H := Count-1; + if H < 0 then + exit; + L := 0; + while L AnAddr then begin + dec(L); + if L < 0 then + exit; + K := Keys[L]; + end; + + if AnExact and (K <> AnAddr) then + exit; + + p := PfpLinkerSymbol(TFPSMap(Self).Data[L]); + Result := (p^.SectionEnd = 0) or (AnAddr <= p^.SectionEnd); + if Result then begin + AFoundAddr := K; + AFoundName := p^.Name; + end; +end; + +function TfpSymbolList.Add(const AName: String; const AnAddr: TDBGPtr; + ASectionEnd: TDBGPtr): Integer; var d: TfpLinkerSymbol; begin - d.Addr := AData; + d.Name := AName; d.SectionEnd := ASectionEnd; - Result := Add(AKey, d); + d.Next := -1; + Result := Add(AnAddr, d); +end; + +{ TFpThreadWorkerSymbolList } + +procedure TFpThreadWorkerSymbolList.DoExecute; +begin + if InterlockedCompareExchange(FList.FInitSortState, FList.LIST_INIT_RUN, FList.LIST_INIT_WAITING) = FList.LIST_INIT_WAITING then begin + FList.InitSort; + WriteBarrier; + FList.FInitSortState := FList.LIST_INIT_DONE; + end; + + if InterlockedCompareExchange(FList.FInitHashState, FList.LIST_INIT_RUN, FList.LIST_INIT_WAITING) = FList.LIST_INIT_WAITING then begin + FList.WaitForSortInit; + FList.InitHashes; + WriteBarrier; + FList.FInitHashState := FList.LIST_INIT_DONE; + end; +end; + +constructor TFpThreadWorkerSymbolList.Create(AList: TfpSymbolList); +begin + FList := AList; + inherited Create; end; end. diff --git a/components/fpdebug/fpdbgsymtablecontext.pas b/components/fpdebug/fpdbgsymtablecontext.pas index f141f005ae..1ae2aa2112 100644 --- a/components/fpdebug/fpdbgsymtablecontext.pas +++ b/components/fpdebug/fpdbgsymtablecontext.pas @@ -148,14 +148,15 @@ end; function TFpSymbolContext.FindSymbol(const AName: String; const OnlyUnitName: String; AFindFlags: TFindExportedSymbolsFlags): TFpValue; var - i: integer; val: TFpDbgMemLocation; + a: TDBGPtr; + n: string; begin - i := FFpSymbolInfo.FSymbolList.IndexOf(AName); - if i > -1 then + // TODO: case sense? + if FFpSymbolInfo.FSymbolList.GetInfo(AName, a, n) then begin val := Default(TFpDbgMemLocation); - val.Address:=FFpSymbolInfo.FSymbolList.DataPtr[i]^.Addr; + val.Address:=a; val.MType:=mlfTargetMem; result := TFpValueConstAddress.Create(val); end @@ -166,8 +167,11 @@ end; { TFpSymbolInfo } function TFpSymbolInfo.GetSymbols(AnIndex: integer): TFpSymbol; +var + p: PfpLinkerSymbol; begin - Result := TFpSymbolTableProc.Create(FSymbolList.Keys[AnIndex], FSymbolList.DataPtr[AnIndex]^.Addr); + p := FSymbolList.DataPtr[AnIndex]; + Result := TFpSymbolTableProc.Create(p^.Name, FSymbolList.Keys[AnIndex]); end; constructor TFpSymbolInfo.Create(ALoaderList: TDbgImageLoaderList; @@ -182,8 +186,10 @@ begin for i := 0 to ALoaderList.Count-1 do ALoaderList[i].ParseSymbolTable(FSymbolList); FTargetInfo := ALoaderList.TargetInfo; - if FSymbolList.Count > 0 then + if FSymbolList.Count > 0 then begin SetHasInfo; + FSymbolList.SortAndHash; + end; end; constructor TFpSymbolInfo.Create(ALoaderList: TDbgImageLoaderList; @@ -209,22 +215,11 @@ end; function TFpSymbolInfo.FindProcSymbol(const AName: String; AIgnoreCase: Boolean ): TFpSymbol; var - s: String; - i: integer; + a: TDBGPtr; + n: string; begin - if AIgnoreCase then begin - s := UpperCase(AName); - i := FSymbolList.Count - 1; - while i >= 0 do begin - if UpperCase(FSymbolList.Keys[i]) = s then - break; - dec(i); - end; - end - else - i := FSymbolList.IndexOf(AName); - if i >= 0 then - Result := TFpSymbolTableProc.Create(AName, FSymbolList.DataPtr[i]^.Addr) + if FSymbolList.GetInfo(AName, a, n, not AIgnoreCase) then + Result := TFpSymbolTableProc.Create(n, a) else result := nil; end; @@ -232,11 +227,13 @@ end; function TFpSymbolInfo.FindProcSymbol(AnAdress: TDbgPtr): TFpSymbol; var CheckRange: Boolean; - i, NearestIdx: integer; - a, NearestAddr: TDBGPtr; - NPreFix: String; - d: PfpLinkerSymbol; + NPreFix, n: String; + a: TDBGPtr; begin + Result := nil; + if (AnAdress < FSymbolList.FirstAddr) or (AnAdress > FSymbolList.LastAddr) then + exit; + NPreFix := ''; if FLibName <> '' then NPreFix := FLibName+':'; @@ -244,29 +241,9 @@ begin (FSymbolList.HighAddr > FSymbolList.LowAddr) and (AnAdress >= FSymbolList.LowAddr) and (AnAdress < FSymbolList.HighAddr); - NearestIdx := -1; - NearestAddr := 0; - Result := nil; - i := FSymbolList.Count - 1; - while i >= 0 do begin - d := FSymbolList.DataPtr[i]; - a := d^.Addr; - if (a = AnAdress) then begin - Result := TFpSymbolTableProc.Create(NPreFix + FSymbolList.Keys[i], a); - exit; - end; - if CheckRange and (a <= AnAdress) and (a > NearestAddr) and - ( (d^.SectionEnd = 0) or (AnAdress <= d^.SectionEnd) ) - then begin - NearestIdx := i; - NearestAddr := a; - end; - dec(i); - end; - if NearestIdx >= 0 then begin - Result := TFpSymbolTableProc.Create(NPreFix + FSymbolList.Keys[NearestIdx], FSymbolList.DataPtr[NearestIdx]^.Addr); - end; + if FSymbolList.GetInfo(AnAdress, a, n, not CheckRange) then + Result := TFpSymbolTableProc.Create(NPreFix + n, a); end; function TFpSymbolInfo.SymbolCount: integer;