FpDebug: faster lookup for linker symbols (speeds up asm view)

components/fpdebug/fpdbgsymtable.pas

@@ -6,34 +6,63 @@ unit fpDbgSymTable;
 interface
 
 uses
-  DbgIntfBaseTypes,
+  DbgIntfBaseTypes, LazLoggerBase, FpDbgUtil,
-  fgl, Classes;
+  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<TDBGPtr, TfpLinkerSymbol>)
-  TfpSymbolList= class(specialize TFPGMap<String, TfpLinkerSymbol>)
+  private type
+    TNameDict = specialize TDictionary<String, Integer>;
+  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 AName: String; const AnAddr: TDBGPtr; ASectionEnd: TDBGPtr = 0): Integer; inline; overload;
-    function Add(const AKey: String; const AData, ASectionEnd: TDBGPtr): Integer; inline; overload;
-    property KeyDataPtr[const AKey: string]: PfpLinkerSymbol read GetKeyDataPtr;
     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;
+  WaitForHashInit;
-  d.SectionEnd := 0;
+
-  Result := Add(AKey, d);
+  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
+function TfpSymbolList.GetInfo(AnAddr: TDBGPtr; out AFoundAddr: TDBGPtr; out AFoundName: String;
-  ): Integer;
+  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<H do begin
+    M := (L + H) div 2;
+    K := Keys[M];
+    if K < AnAddr then
+      L := M+1
+    else
+      H := M;
+  end;
+  K := Keys[L];
+  if K > 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.

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);
+  // TODO: case sense?
-  if i > -1 then
+  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;
+  a: TDBGPtr;
-  i: integer;
+  n: string;
 begin
-  if AIgnoreCase then begin
+  if FSymbolList.GetInfo(AName, a, n, not AIgnoreCase) then
-    s := UpperCase(AName);
+    Result := TFpSymbolTableProc.Create(n, a)
-    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)
   else
     result := nil;
 end;
@@ -232,11 +227,13 @@ end;
 function TFpSymbolInfo.FindProcSymbol(AnAdress: TDbgPtr): TFpSymbol;
 var
   CheckRange: Boolean;
-  i, NearestIdx: integer;
+  NPreFix, n: String;
-  a, NearestAddr: TDBGPtr;
+  a: TDBGPtr;
-  NPreFix: String;
-  d: PfpLinkerSymbol;
 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;
+  if FSymbolList.GetInfo(AnAdress, a, n, not CheckRange) then
-  i := FSymbolList.Count - 1;
+    Result := TFpSymbolTableProc.Create(NPreFix + n, a);
-  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;
 end;
 
 function TFpSymbolInfo.SymbolCount: integer;