FpDebug: Win64 SEH finally sub-routines, find the symbol for the procedure actually owning the finally block

components/fpdebug/fpdbgclasses.pp

@@ -1201,6 +1201,11 @@ begin
       FSymbol := FThread.Process.FindProcSymbol(FAnAddress - 1) // -1 => inside the call instruction
     else
       FSymbol := FThread.Process.FindProcSymbol(FAnAddress);
+
+    if FSymbol is TFpSymbolDwarfDataProc then
+      FSymbol := TFpSymbolDwarfDataProc(FSymbol).ResolveInternalFinallySymbol(FThread.Process);
+
+
     FIsSymbolResolved := FSymbol <> nil
   end;
   result := FSymbol;

components/fpdebug/fpdbgdwarf.pas

@@ -961,6 +961,8 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     function GetValueObject: TFpValue; override;
     function GetValueAddress(AValueObj: TFpValueDwarf; out
       AnAddress: TFpDbgMemLocation): Boolean; override;
+
+    property ProcAddress: TDBGPtr read FAddress;
   public
     constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo = nil); overload;
     destructor Destroy; override;
@@ -968,6 +970,9 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
     // TODO members = locals ?
     function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpValueDwarf;
+
+    function ResolveInternalFinallySymbol(Process: Pointer): TFpSymbol; virtual; // so it can be overriden by the fpc classes
+
     // Contineous (sub-)part of the line
     property LineStartAddress: TDBGPtr read GetLineStartAddress;
     property LineEndAddress: TDBGPtr read GetLineEndAddress;
@@ -6038,6 +6043,12 @@ begin
   InfoEntry.ReleaseReference;
 end;
 
+function TFpSymbolDwarfDataProc.ResolveInternalFinallySymbol(Process: Pointer
+  ): TFpSymbol;
+begin
+  Result := Self;
+end;
+
 { TFpSymbolDwarfTypeProc }
 
 procedure TFpSymbolDwarfTypeProc.CreateMembers;

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -8,7 +8,7 @@ interface
 uses
   Classes, SysUtils, Types, math,
   FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo,
-  FpDbgUtil, FpDbgDwarfConst, FpErrorMessages, FpdMemoryTools,
+  FpDbgUtil, FpDbgDwarfConst, FpErrorMessages, FpdMemoryTools, FpDbgClasses,
   DbgIntfBaseTypes,
   {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazStringUtils;
 
@@ -36,8 +36,9 @@ type
     function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
     function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
       ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
-    //class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
-    //  AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
+    function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
+      AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo
+      ): TDbgDwarfSymbolBase; override;
 
     function GetInstanceClassNameFromPVmt(APVmt: TDbgPtr;
       AContext: TFpDbgLocationContext; ASizeOfAddr: Integer;
@@ -244,6 +245,12 @@ type
     function GetAsWideString: WideString; override;
   end;
 
+  { TFpSymbolDwarfFreePascalDataProc }
+
+  TFpSymbolDwarfFreePascalDataProc = class(TFpSymbolDwarfDataProc)
+  public
+    function ResolveInternalFinallySymbol(Process: Pointer): TFpSymbol; override;
+  end;
   {%EndRegion }
 
 implementation
@@ -367,6 +374,7 @@ begin
     DW_TAG_structure_type,
     DW_TAG_class_type:       Result := TFpSymbolDwarfFreePascalTypeStructure;
     DW_TAG_array_type:       Result := TFpSymbolDwarfFreePascalSymbolTypeArray;
+    DW_TAG_subprogram:       Result := TFpSymbolDwarfFreePascalDataProc;
     else                     Result := inherited GetDwarfSymbolClass(ATag);
   end;
 end;
@@ -378,6 +386,13 @@ begin
   Result := TFpDwarfFreePascalSymbolScope.Create(ALocationContext, ASymbol, ADwarf);
 end;
 
+function TFpDwarfFreePascalSymbolClassMap.CreateProcSymbol(
+  ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo;
+  AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase;
+begin
+  Result := TFpSymbolDwarfFreePascalDataProc.Create(ACompilationUnit, AInfo, AAddress, ADbgInfo);
+end;
+
 function TFpDwarfFreePascalSymbolClassMap.GetInstanceClassNameFromPVmt(
   APVmt: TDbgPtr; AContext: TFpDbgLocationContext; ASizeOfAddr: Integer; out
   AClassName: String; out AnError: TFpError): boolean;
@@ -1513,6 +1528,102 @@ begin
   end;
 end;
 
+{ TFpSymbolDwarfFreePascalDataProc }
+
+function TFpSymbolDwarfFreePascalDataProc.ResolveInternalFinallySymbol(
+  Process: Pointer): TFpSymbol;
+{$IfDef WINDOWS}
+var
+  StartPC, EndPC: TDBGPtr;
+  HelpSymbol, HelpSymbol2: TFpSymbolDwarf;
+  AnAddresses: TDBGPtrArray;
+  FndLine, i: Integer;
+  IsDone: Boolean;
+{$EndIf}
+begin
+  Result := Self;
+
+  {$IfDef WINDOWS}
+  // On Windows: If in an SEH finally block, try to get the real procedure
+  // Look for the line, before the finally statement.
+  // TODO: This needs to move to a win-specific class, and ideally a FPC specific class too.
+  if ('$fin' = copy(Name,1, 4) ) then begin
+    IsDone := False;
+    if CompilationUnit.GetProcStartEnd(ProcAddress, StartPC, EndPC) and
+       (StartPC <> 0)
+    then begin
+      // TODO: use the assembler to skip the prologue
+      StartPC := StartPC + 9; // fpc puts the first 9 bytes on "end"
+
+      if StartPC = ProcAddress then begin
+        TFpSymbol(HelpSymbol) := Result;
+        HelpSymbol.AddReference;
+      end
+      else
+        TFpSymbol(HelpSymbol) := TDbgProcess(Process).FindProcSymbol(StartPC);
+
+      if not ( (HelpSymbol <> nil) and  HelpSymbol.InheritsFrom(TFpSymbolDwarf) ) then begin
+        HelpSymbol.ReleaseReference;
+        exit;
+      end;
+
+      AnAddresses := nil;
+      if HelpSymbol.CompilationUnit.GetLineAddresses(HelpSymbol.FileName, HelpSymbol.Line, AnAddresses, fsBefore, @FndLine)
+      then begin
+        if (FndLine = HelpSymbol.Line) then begin
+          if Length(AnAddresses) > 1 then begin // may be an internal finally on the begin/end line, sharing a line number
+            for i := 0 to Length(AnAddresses) - 1 do
+              if (AnAddresses[i] > StartPC) or (AnAddresses[i] < StartPC - 9) then begin
+                TFpSymbol(HelpSymbol2) := TDbgProcess(Process).FindProcSymbol(AnAddresses[i]);
+                if not HelpSymbol2.InheritsFrom(TFpSymbolDwarf) then begin
+                  HelpSymbol2.ReleaseReference;
+                  HelpSymbol2 := nil;
+                end;
+                if (HelpSymbol2 <> nil) then begin
+                  if ('$fin' = copy(HelpSymbol2.Name,1, 4) ) then begin
+                    HelpSymbol2.ReleaseReference;
+                  end
+                  else begin
+                    Result.ReleaseReference;
+                    TFpSymbol(Result) := HelpSymbol2;
+                    IsDone := True;
+                    break;
+                  end;
+                end;
+              end;
+          end;
+
+          AnAddresses := nil;
+          if not IsDone then
+            if not HelpSymbol.CompilationUnit.GetLineAddresses(HelpSymbol.FileName, HelpSymbol.Line-1, AnAddresses, fsBefore)
+            then
+              AnAddresses := nil;
+        end;
+      end
+      else begin
+        AnAddresses := nil;
+        if not HelpSymbol.CompilationUnit.GetLineAddresses(HelpSymbol.FileName, HelpSymbol.Line-1, AnAddresses, fsBefore)
+        then
+          AnAddresses := nil;
+      end;
+
+      if (not IsDone) and
+         (AnAddresses <> nil)
+      then begin
+        HelpSymbol.ReleaseReference;
+        TFpSymbol(HelpSymbol) := TDbgProcess(Process).FindProcSymbol(AnAddresses[0]);
+        if (HelpSymbol <> nil) and  HelpSymbol.InheritsFrom(TFpSymbolDwarf) then begin
+          Result.ReleaseReference;
+          Result := HelpSymbol;
+          HelpSymbol := nil;
+        end;
+      end;
+      HelpSymbol.ReleaseReference;
+    end;
+  end;
+  {$EndIf}
+end;
+
 initialization
   DwarfSymbolClassMapList.AddMap(TFpDwarfFreePascalSymbolClassMapDwarf2);
   DwarfSymbolClassMapList.AddMap(TFpDwarfFreePascalSymbolClassMapDwarf3);