paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 06:00:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Use Dwarf Call Frame Information (CFI) for stack-tracing when available. Refactored some stuff to be able to place it in a separate unit.

Browse Source
This commit is contained in:
Joost van der Sluis 2022-06-26 15:41:31 +02:00
parent 2bc0a9b371
commit 62145cd833
10 changed files with 1122 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpdebug/app/fpdserver/debugthreadcommand.pas
View File

@ -629,7 +629,7 @@ begin
begin
FStackEntryArray[i].AnAddress:=ThreadCallStack[i].AnAddress;
FStackEntryArray[i].FrameAdress:=ThreadCallStack[i].FrameAdress;
FStackEntryArray[i].FunctionName:=ThreadCallStack[i].FunctionName+ThreadCallStack[i].GetParamsAsString(PrettyPrinter);
FStackEntryArray[i].FunctionName:=ThreadCallStack[i].FunctionName+GetParamsAsString(AController.CurrentProcess.MainThread, ThreadCallStack[i], AController.MemManager, DBGPTRSIZE[AController.CurrentProcess.Mode], PrettyPrinter);
FStackEntryArray[i].Line:=ThreadCallStack[i].Line;
FStackEntryArray[i].SourceFile:=ThreadCallStack[i].SourceFile;
end;

195
components/fpdebug/fpdbgclasses.pp
View File

@ -39,10 +39,10 @@ unit FpDbgClasses;
interface
uses
Classes, SysUtils, Maps, FpDbgDwarf, FpDbgUtil, FpDbgLoader, FpDbgInfo,
Classes, SysUtils, Maps, FpDbgUtil, FpDbgLoader, FpDbgInfo,
FpdMemoryTools, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazClasses, LazFileUtils, DbgIntfBaseTypes,
fgl, DbgIntfDebuggerBase, FpPascalBuilder, fpDbgSymTableContext,
FpDbgDwarfDataClasses, FpDbgCommon, FpErrorMessages, LazDebuggerIntf;
fgl, DbgIntfDebuggerBase, fpDbgSymTableContext,
FpDbgCommon, FpErrorMessages, LazDebuggerIntf;
type
TFPDEvent = (
@ -118,7 +118,6 @@ type
public
constructor create(AThread: TDbgThread; AnIndex: integer; AFrameAddress, AnAddress: TDBGPtr);
destructor Destroy; override;
function GetParamsAsString(APrettyPrinter: TFpPascalPrettyPrinter): string;
property AnAddress: TDBGPtr read FAnAddress;
property FrameAdress: TDBGPtr read FFrameAdress;
property SourceFile: string read GetSourceFile;
@ -808,6 +807,11 @@ procedure RegisterDbgOsClasses(ADbgOsClasses: TOSDbgClasses);
implementation
uses
FpDbgDwarfDataClasses,
FpDbgDwarfCFI,
FpDbgDwarf;
type
TOSDbgClassesList = class(specialize TFPGObjectList<TOSDbgClasses>)
public
@ -1265,45 +1269,6 @@ begin
result := '';
end;
function TDbgCallstackEntry.GetParamsAsString(
APrettyPrinter: TFpPascalPrettyPrinter): string;
var
ProcVal: TFpValue;
AContext: TFpDbgLocationContext;
m: TFpValue;
v: String;
i: Integer;
begin
result := '';
if assigned(ProcSymbol) then begin
ProcVal := ProcSymbol.Value;
if (ProcVal <> nil) then begin
AContext := TFpDbgSimpleLocationContext.Create(FThread.Process.MemManager,
LocToAddrOrNil(ProcSymbol.Address), DBGPTRSIZE[FThread.Process.Mode], FThread.ID, Index);
if AContext <> nil then begin
TFpValueDwarf(ProcVal).Context := AContext;
APrettyPrinter.Context := AContext;
APrettyPrinter.AddressSize := AContext.SizeOfAddress;
for i := 0 to ProcVal.MemberCount - 1 do begin
m := ProcVal.Member[i];
if (m <> nil) and (sfParameter in m.DbgSymbol.Flags) then begin
APrettyPrinter.PrintValue(v, m, wdfDefault, -1, [ppoStackParam]);
if result <> '' then result := result + ', ';
result := result + v;
end;
m.ReleaseReference;
end;
TFpValueDwarf(ProcVal).Context := nil;
AContext.ReleaseReference;
end;
ProcVal.ReleaseReference;
end;
if result <> '' then
result := '(' + result + ')';
end;
end;
function TDbgCallstackEntry.GetLine: integer;
var
Symbol: TFpSymbol;
@ -1786,6 +1751,7 @@ begin
FSymbolTableInfo := TFpSymbolInfo.Create(FLoaderList, MemManager)
else
FSymbolTableInfo := TFpSymbolInfo.Create(FLoaderList, MemManager, ExtractFileNameOnly(FFileName));
TFpDwarfInfo(FDbgInfo).LoadCallFrameInstructions;
end;
procedure TDbgInstance.SetFileName(const AValue: String);
@ -3018,13 +2984,15 @@ const
MAX_FRAMES = 50000; // safety net
var
Address, FrameBase, LastFrameBase, Dummy: QWord;
Size, CountNeeded, IP, BP, CodeReadErrCnt, SP: integer;
AnEntry: TDbgCallstackEntry;
Size, CountNeeded, IP, BP, CodeReadErrCnt, SP, i: integer;
AnEntry, NewEntry: TDbgCallstackEntry;
R: TDbgRegisterValue;
nIP, nBP, nSP: String;
NextIdx: LongInt;
OutSideFrame: Boolean;
StackPtr: TDBGPtr;
Row: TDwarfCallFrameInformationRow;
CIE: TDwarfCIE;
begin
// TODO: use AFrameRequired // check if already partly done
if FCallStackEntryList = nil then
@ -3064,12 +3032,8 @@ begin
if FCallStackEntryList.Count > 0 then begin
AnEntry := FCallStackEntryList[FCallStackEntryList.Count - 1];
R := AnEntry.RegisterValueList.FindRegisterByDwarfIndex(IP);
if R = nil then exit;
Address := R.NumValue;
R := AnEntry.RegisterValueList.FindRegisterByDwarfIndex(BP);
if R = nil then exit;
FrameBase := R.NumValue;
Address:=AnEntry.AnAddress;
FrameBase:=AnEntry.FrameAdress;
R := AnEntry.RegisterValueList.FindRegisterByDwarfIndex(SP);
if R = nil then exit;
StackPtr := R.NumValue;
@ -3079,10 +3043,18 @@ begin
FrameBase := GetStackBasePointerRegisterValue;
StackPtr := GetStackPointerRegisterValue;
AnEntry := TDbgCallstackEntry.create(Self, 0, FrameBase, Address);
// Top level could be without entry in registerlist / same as GetRegisterValueList / but some code tries to find it here ....
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
// Initialize register values
// Top level could do without entry in registerlist, but this way the
// same code can handle both cases.
i := 0;
R := RegisterValueList.FindRegisterByDwarfIndex(i);
while Assigned(R) do
begin
AnEntry.RegisterValueList.DbgRegisterAutoCreate[R.Name].SetValue(R.NumValue, R.StrValue, R.Size, R.DwarfIdx);
inc(i);
R := RegisterValueList.FindRegisterByDwarfIndex(i);
end;
FCallStackEntryList.Add(AnEntry);
end;
@ -3092,55 +3064,76 @@ begin
CountNeeded := AFrameRequired - FCallStackEntryList.Count;
LastFrameBase := 0;
CodeReadErrCnt := 0;
while (CountNeeded > 0) and (FrameBase <> 0) and (FrameBase > LastFrameBase) do
while (CountNeeded > 0) do
begin
OutSideFrame := False;
if not Process.Disassembler.GetFunctionFrameInfo(Address, OutSideFrame) then begin
if Process.Disassembler.LastErrorWasMemReadErr then begin
inc(CodeReadErrCnt);
if CodeReadErrCnt > 5 then break; // If the code cannot be read the stack pointer is wrong.
if NextIdx <= 1 then
OutSideFrame := True; // Maybe after "TProc(nil)();" call, then no frame could have been set up
end;
end;
LastFrameBase := FrameBase;
if (not OutSideFrame) and (NextIdx = 1) and (AnEntry.ProcSymbol <> nil) then begin
OutSideFrame := Address = LocToAddrOrNil(AnEntry.ProcSymbol.Address); // the top frame must be outside frame, if it is at entrypoint / needed for exceptions
end;
if OutSideFrame then begin
if not Process.ReadData(StackPtr, Size, Address) or (Address = 0) then Break;
if (not Process.ReadData(Address, 1, Dummy) or (Address = 0)) then begin
OutSideFrame := False;
if (Process.DbgInfo as TFpDwarfInfo).FindCallFrameInfo(Address, CIE, Row) and
TDwarfCallFrameInformation.TryObtainNextCallFrame(AnEntry, CIE, Size, NextIdx, Self, Row, Process, NewEntry) then
begin
if not Assigned(NewEntry) then
// Done.
Break;
FCallStackEntryList.Add(NewEntry);
Address := NewEntry.AnAddress;
AnEntry := NewEntry;
Dec(CountNeeded);
inc(NextIdx);
If (NextIdx > MAX_FRAMES) then
Break;
end
else begin
{$PUSH}{$R-}{$Q-}
StackPtr := StackPtr + 1 * Size; // After popping return-addr from "StackPtr"
LastFrameBase := LastFrameBase - 1; // Make the loop think thas LastFrameBase was smaller
{$POP}
// last stack has no frame
//AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(0, '0',Size, BP);
else if (FrameBase <> 0) and (FrameBase > LastFrameBase) then
begin
// CFI not available or contains unsupported structures. Fallback to
// old fashioned stack-tracing.
OutSideFrame := False;
if not Process.Disassembler.GetFunctionFrameInfo(Address, OutSideFrame) then begin
if Process.Disassembler.LastErrorWasMemReadErr then begin
inc(CodeReadErrCnt);
if CodeReadErrCnt > 5 then break; // If the code cannot be read the stack pointer is wrong.
if NextIdx <= 1 then
OutSideFrame := True; // Maybe after "TProc(nil)();" call, then no frame could have been set up
end;
end;
end;
if not OutSideFrame then begin
{$PUSH}{$R-}{$Q-}
StackPtr := FrameBase + 2 * Size; // After popping return-addr from "FrameBase + Size"
if not Process.ReadData(FrameBase + Size, Size, Address) or (Address = 0) then Break;
if not Process.ReadData(FrameBase, Size, FrameBase) then Break;
{$POP}
end;
AnEntry := TDbgCallstackEntry.create(Self, NextIdx, FrameBase, Address);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
FCallStackEntryList.Add(AnEntry);
Dec(CountNeeded);
inc(NextIdx);
CodeReadErrCnt := 0;
If (NextIdx > MAX_FRAMES) then
break;
LastFrameBase := FrameBase;
if (not OutSideFrame) and (NextIdx = 1) and (AnEntry.ProcSymbol <> nil) then begin
OutSideFrame := Address = LocToAddrOrNil(AnEntry.ProcSymbol.Address); // the top frame must be outside frame, if it is at entrypoint / needed for exceptions
end;
if OutSideFrame then begin
if not Process.ReadData(StackPtr, Size, Address) or (Address = 0) then Break;
if (not Process.ReadData(Address, 1, Dummy) or (Address = 0)) then begin
OutSideFrame := False;
end
else begin
{$PUSH}{$R-}{$Q-}
StackPtr := StackPtr + 1 * Size; // After popping return-addr from "StackPtr"
LastFrameBase := LastFrameBase - 1; // Make the loop think thas LastFrameBase was smaller
{$POP}
// last stack has no frame
//AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(0, '0',Size, BP);
end;
end;
if not OutSideFrame then begin
{$PUSH}{$R-}{$Q-}
StackPtr := FrameBase + 2 * Size; // After popping return-addr from "FrameBase + Size"
{$POP}
if not Process.ReadData(FrameBase + Size, Size, Address) or (Address = 0) then Break;
if not Process.ReadData(FrameBase, Size, FrameBase) then Break;
end;
AnEntry := TDbgCallstackEntry.create(Self, NextIdx, FrameBase, Address);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
AnEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
FCallStackEntryList.Add(AnEntry);
Dec(CountNeeded);
inc(NextIdx);
CodeReadErrCnt := 0;
If (NextIdx > MAX_FRAMES) then
break;
end
else
Break;
end;
if CountNeeded > 0 then // there was an error / not possible to read more frames
FCallStackEntryList.SetHasReadAllAvailableFrames;

729
components/fpdebug/fpdbgdwarfcfi.pas Normal file
View File

@ -0,0 +1,729 @@
{
---------------------------------------------------------------------------
FpDbgDwarfCFI.pas - Native Freepascal debugger - Call Frame Information
---------------------------------------------------------------------------
This unit contains classes to process the Dwarf Call Frame Information
information
---------------------------------------------------------------------------
@created(Wed Jun 16th WET 2022)
@lastmod($Date$)
@author(Joost van der Sluis <joost@@cnoc.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
unit FpDbgDwarfCFI;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
// LazUtils
Maps,
LazLogger,
// DebuggerIntf
DbgIntfBaseTypes,
// FpDebug
FpDbgCommon,
FpDbgUtil,
FpDbgDwarfConst,
FpDbgClasses;
type
PDwarfCIEEntryHeader32 = ^TDwarfCIEEntryHeader32;
TDwarfCIEEntryHeader32 = record
Length: LongWord;
CIEId: LongWord;
Version: Byte;
Augmentation: array[0..1023] of char;
end;
PDwarfCIEEntryHeader64 = ^TDwarfCIEEntryHeader64;
TDwarfCIEEntryHeader64 = record
Signature: LongWord;
Length: QWord;
CIEId: QWord;
Version: Byte;
Augmentation: array[0..1023] of char;
end;
PDwarfFDEEntryHeader32 = ^TDwarfFDEEntryHeader32;
TDwarfFDEEntryHeader32 = record
Length: LongWord;
CIEPointer: LongWord;
InitialLocation: LongWord;
Initialrange: LongWord;
end;
PDwarfFDEEntryHeader64 = ^TDwarfFDEEntryHeader64;
TDwarfFDEEntryHeader64 = record
Signature: LongWord;
Length: QWord;
CIEPointer: QWord;
InitialLocation: PQWord;
end;
TDwarfCallFrameInformationInstructions = array of Byte;
{ TDwarfCIE }
TDwarfCIE = class
private
FAddressSize: Byte;
FAugmentation: string;
FCodeAlignmentFactor: QWord;
FDataAlignmentFactor: Int64;
FInitialInstructions: TDwarfCallFrameInformationInstructions;
FReturnAddressRegister: QWord;
FSegmentSize: Byte;
FVersion: Byte;
public
constructor Create(AVersion: Byte; AnAugmentation: string);
property Version: Byte read FVersion;
property Augmentation: string read FAugmentation;
property AddressSize: Byte read FAddressSize write FAddressSize;
property SegmentSize: Byte read FSegmentSize write FSegmentSize;
property CodeAlignmentFactor: QWord read FCodeAlignmentFactor write FCodeAlignmentFactor;
property DataAlignmentFactor: Int64 read FDataAlignmentFactor write FDataAlignmentFactor;
property ReturnAddressRegister: QWord read FReturnAddressRegister write FReturnAddressRegister;
property InitialInstructions: TDwarfCallFrameInformationInstructions read FInitialInstructions write FInitialInstructions;
end;
TDwarfCallFrameInformationRegisterRule = (
cfiUndefined,
cfiSameValue,
cfiOffset,
cfiValOffset,
cfiRegister,
cfiExpression,
cfiValExpression,
cfiArchitectural
);
TDwarfCallFrameInformationCFARule = (
cfaUndefined,
cfaRegister,
cfaExpression
);
{ TDwarfCallFrameInformationRule }
TDwarfCallFrameInformationRule = record
Offset: Int64;
&Register: QWord;
// Dwarf-expressions are unsupported
// Expression: TDwarfLocationExpression;
case byte of
0: (RegisterRule: TDwarfCallFrameInformationRegisterRule);
1: (CFARule: TDwarfCallFrameInformationCFARule);
end;
TDwarfCallFrameInformationRow = record
// The DWARF CFI specification defines the Location and CFARule as the
// first two columns of the array.
// By keeping them separate, the code is much cleaner though.
Location: TDBGPtr;
CFARule: TDwarfCallFrameInformationRule;
RegisterArray: array of TDwarfCallFrameInformationRule;
end;
{ TDwarfFDE }
TDwarfFDE = class
private
FAddressRange: QWord;
FCIEPointer: QWord;
FInitialLocation: TDBGPtr;
FInstructions: TDwarfCallFrameInformationInstructions;
FSegmentSelector: TDBGPtr;
public
constructor Create(ACIEPointer: QWord; AnInitialLocation, ASegmentSelector: TDBGPtr; AnAddressRange: QWord);
property CIEPointer: QWord read FCIEPointer;
property InitialLocation: TDBGPtr read FInitialLocation;
property SegmentSelector: TDBGPtr read FSegmentSelector;
property AddressRange: QWord read FAddressRange;
property Instructions: TDwarfCallFrameInformationInstructions read FInstructions write FInstructions;
end;
{ TDwarfCallFrameInformation }
TDwarfCallFrameInformation = class
private
FFDEMap: TMap;
FCIEMap: TMap;
FInitialInstructionsCache: TDwarfCallFrameInformationRow;
FRowStack: array of TDwarfCallFrameInformationRow;
protected
function SetCallFrameInformationRegisterCell(var InformationRow: TDwarfCallFrameInformationRow; &Register: QWord; Rule: TDwarfCallFrameInformationRegisterRule; Offset: Int64; SourceRegister: Byte): Boolean;
function SetCallFrameInformationCFACell(var InformationRow: TDwarfCallFrameInformationRow; Rule: TDwarfCallFrameInformationCFARule; &Register: Byte; Offset: Int64): Boolean;
// Process Call Frame Instructions on a given (CFI) row. Return True if succesfull.
// When False returned the InformationRow can not be trusted.
function ProcessInstructions(const CIE: TDwarfCIE; var InformationRow: TDwarfCallFrameInformationRow; const Instructions: TDwarfCallFrameInformationInstructions; const InitialAddress, SearchAddress: TDBGPtr): Boolean;
procedure InitializeABIRules(TargetInfo: TTargetDescriptor; var Row: TDwarfCallFrameInformationRow);
function CloneRow(const SourceRow: TDwarfCallFrameInformationRow): TDwarfCallFrameInformationRow;
public
constructor Create;
destructor Destroy; override;
procedure AddCIE(AnOffset: QWord; ACIE: TDwarfCIE);
procedure AddFDE(AFDE: TDwarfFDE);
function FindFDEForAddress(AnAddress: TDBGPtr): TDwarfFDE;
function FindCIEForOffset(AnOffset: QWord): TDwarfCIE;
function GetRow(TargetInfo: TTargetDescriptor; AnAddress: TDBGPtr; out CIE: TDwarfCIE; out Row: TDwarfCallFrameInformationRow): Boolean;
class function TryObtainNextCallFrame(
CurrentCallStackEntry: TDbgCallstackEntry;
CIE: TDwarfCIE;
Size, NextIdx: Integer;
Thread: TDbgThread;
Row: TDwarfCallFrameInformationRow;
Process: TDbgProcess;
out NewCallStackEntry: TDbgCallstackEntry): Boolean;
end;
implementation
var
FPDBG_DWARF_CFI_WARNINGS: PLazLoggerLogGroup;
type
{ TCFIMap }
TCFIMap = class(TMap)
protected
procedure ReleaseData(ADataPtr: Pointer); override;
end;
{ TCFIMap }
procedure TCFIMap.ReleaseData(ADataPtr: Pointer);
begin
TObject(ADataPtr^).Free;
inherited ReleaseData(ADataPtr);
end;
{ TDwarfCallFrameInformation }
function TDwarfCallFrameInformation.SetCallFrameInformationRegisterCell(var InformationRow: TDwarfCallFrameInformationRow; &Register: QWord; Rule: TDwarfCallFrameInformationRegisterRule; Offset: Int64; SourceRegister: Byte): Boolean;
var
Row: Byte;
begin
Result := True;
if &Register > High(Byte) then
begin
DebugLn(FPDBG_DWARF_CFI_WARNINGS, ['Call frame instruction register-number out of bounds']);
Exit(False);
end;
Row := &Register;
if Length(InformationRow.RegisterArray) < Row+1 then
SetLength(InformationRow.RegisterArray, Row+1);
InformationRow.RegisterArray[Row].RegisterRule := Rule;
InformationRow.RegisterArray[Row].&Register := SourceRegister;
InformationRow.RegisterArray[Row].Offset := Offset;
end;
function TDwarfCallFrameInformation.SetCallFrameInformationCFACell(var InformationRow: TDwarfCallFrameInformationRow; Rule: TDwarfCallFrameInformationCFARule; &Register: Byte; Offset: Int64): Boolean;
begin
Result := True;
InformationRow.CFARule.CFARule := Rule;
InformationRow.CFARule.&Register := &Register;
InformationRow.CFARule.Offset := Offset;
end;
function TDwarfCallFrameInformation.ProcessInstructions(const CIE: TDwarfCIE; var InformationRow: TDwarfCallFrameInformationRow; const Instructions: TDwarfCallFrameInformationInstructions; const InitialAddress, SearchAddress: TDBGPtr): Boolean;
var
p: PByte;
pw: PWord absolute p;
pl: PLongWord absolute p;
Instruction: Byte;
CurrentLocation: TDBGPtr;
uparam1, uparam2: QWord;
sparam: Int64;
begin
Result := False;
p := @Instructions[0];
CurrentLocation:=InitialAddress;
while p < Length(Instructions)+@Instructions[0] do
begin
Instruction := p^;
Inc(p);
case Instruction of
DW_CFA_nop:
begin
end;
DW_CFA_set_loc:
begin
if not cie.AddressSize in [1, 2, 4, 8] then
DebugLn(FPDBG_DWARF_CFI_WARNINGS, ['Unsupported address size'])
else
CurrentLocation := ReadUnsignedFromExpression(p, CIE.AddressSize);
end;
DW_CFA_advance_loc1:
begin
Inc(CurrentLocation, p^);
if CurrentLocation>SearchAddress then
Exit(True);
Inc(p);
end;
DW_CFA_advance_loc2:
begin
Inc(CurrentLocation, pw^);
if CurrentLocation>SearchAddress then
Exit(True);
Inc(p,2);
end;
DW_CFA_advance_loc4:
begin
Inc(CurrentLocation, pl^);
if CurrentLocation>SearchAddress then
Exit(True);
Inc(p,4);
end;
DW_CFA_offset_extended:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
uparam2 := ULEB128toOrdinal(p); // Factored offset
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiOffset, uparam2*CIE.DataAlignmentFactor, 0) then
Exit;
end;
DW_CFA_offset_extended_sf:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
sparam := SLEB128toOrdinal(p); // Factored offset
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiOffset, sparam*CIE.DataAlignmentFactor, 0) then
Exit;
end;
DW_CFA_restore:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, FInitialInstructionsCache.RegisterArray[uparam1].RegisterRule, FInitialInstructionsCache.RegisterArray[uparam1].Offset, FInitialInstructionsCache.RegisterArray[uparam1].&Register) then
Exit;
end;
DW_CFA_val_offset:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
uparam2 := ULEB128toOrdinal(p); // Factored offset
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiValOffset, uparam2*CIE.DataAlignmentFactor, 0) then
Exit;
end;
DW_CFA_val_offset_sf:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
sparam := SLEB128toOrdinal(p); // Factored offset
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiValOffset, sparam*CIE.DataAlignmentFactor, 0) then
Exit;
end;
DW_CFA_undefined:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiUndefined, 0, 0) then
Exit;
end;
DW_CFA_same_value:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiSameValue, 0, 0) then
Exit;
end;
DW_CFA_register:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
uparam2 := ULEB128toOrdinal(p); // Register number
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiRegister, 0, uparam2) then
Exit;
end;
DW_CFA_remember_state:
begin
SetLength(FRowStack, Length(FRowStack) + 1);
FRowStack[High(FRowStack)] := CloneRow(InformationRow);
end;
DW_CFA_restore_state:
begin
InformationRow := FRowStack[High(FRowStack)];
SetLength(FRowStack, Length(FRowStack) - 1);
end;
DW_CFA_def_cfa:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
uparam2 := ULEB128toOrdinal(p); // Non-factored offset
if not SetCallFrameInformationCFACell(InformationRow, cfaRegister, uparam1, uparam2) then
Exit;
end;
DW_CFA_def_cfa_sf:
begin
uparam1 := ULEB128toOrdinal(p); // Register number
sparam := SLEB128toOrdinal(p); // Factored offset
if not SetCallFrameInformationCFACell(InformationRow, cfaRegister, uparam1, sparam*CIE.DataAlignmentFactor) then
Exit;
end;
DW_CFA_def_cfa_register:
begin
uparam1 := ULEB128toOrdinal(p); // Register
if InformationRow.CFARule.CFARule = cfaRegister then
begin
if not SetCallFrameInformationCFACell(InformationRow, cfaRegister, uparam1, InformationRow.CFARule.Offset) then
Exit;
end
else
DebugLn(FPDBG_DWARF_CFI_WARNINGS, ['Invalid DW_CFA_def_cfa_register rule']);
end;
DW_CFA_def_cfa_offset:
begin
uparam1 := ULEB128toOrdinal(p); // Non-factored offset
if InformationRow.CFARule.CFARule = cfaRegister then
begin
if not SetCallFrameInformationCFACell(InformationRow, cfaRegister, InformationRow.CFARule.&Register, uparam1) then
Exit;
end
else
DebugLn(FPDBG_DWARF_CFI_WARNINGS, ['Invalid DW_CFA_def_cfa_offset rule']);
end;
DW_CFA_def_cfa_offset_sf:
begin
sparam := SLEB128toOrdinal(p); // Factored offset
if InformationRow.CFARule.CFARule = cfaRegister then
begin
if not SetCallFrameInformationCFACell(InformationRow, cfaRegister, InformationRow.CFARule.&Register, sparam*CIE.DataAlignmentFactor) then
Exit;
end
else
DebugLn(FPDBG_DWARF_CFI_WARNINGS, ['Invalid DW_CFA_def_cfa_offset_sf rule']);
end;
else
begin
case Instruction and $c0 of
DW_CFA_advance_loc:
begin
Inc(CurrentLocation, (Instruction and $3f)*CIE.CodeAlignmentFactor);
if CurrentLocation>SearchAddress then
Exit(True);
end;
DW_CFA_offset:
begin
uparam1 := Instruction and $3f; // Register number
uparam2 := ULEB128toOrdinal(p); // Factored offset
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, cfiOffset, uparam2*CIE.DataAlignmentFactor, 0) then
Exit;
end;
DW_CFA_restore:
begin
uparam1 := Instruction and $3f; // Register number
if not SetCallFrameInformationRegisterCell(InformationRow, uparam1, FInitialInstructionsCache.RegisterArray[uparam1].RegisterRule, FInitialInstructionsCache.RegisterArray[uparam1].Offset, FInitialInstructionsCache.RegisterArray[uparam1].&Register) then
Exit;
end
else
DebugLn(FPDBG_DWARF_CFI_WARNINGS, ['Unsupported call frame instruction: ', Instruction]);
Exit;
end;
end;
end;
end;
// This function only proceeded if we reach this point. If the handling is aborted
// for any reason, the result is unreliable and can not be used.
Result := True;
end;
procedure TDwarfCallFrameInformation.InitializeABIRules(TargetInfo: TTargetDescriptor; var Row: TDwarfCallFrameInformationRow);
begin
if TargetInfo.machineType=mtX86_64 then
begin
// According to the x86_64 ABI the CFA (call frame address) is defined as
// "the value of %rsp at the call site in the previous frame"
// Register 7 is %rsp
SetCallFrameInformationRegisterCell(Row, 7, cfiValOffset, 0, 0);
// From the x86_64 ABI:
// "Registers %rbp, %rbx and %r12 through %r15 “belong” to the calling
// function and the called function is required to preserve their values."
// Register 3 is %rbx and 6 is %rbp
SetCallFrameInformationRegisterCell(Row, 3, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 6, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 12, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 13, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 14, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 15, cfiSameValue, 0, 0);
end
else if TargetInfo.machineType=mt386 then
begin
SetCallFrameInformationRegisterCell(Row, 4, cfiValOffset, 0, 0);
// The i386 ABI is not as clear as the x86_64 ABI. These are based on
// some educated guesses:
SetCallFrameInformationRegisterCell(Row, 3, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 5, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 6, cfiSameValue, 0, 0);
SetCallFrameInformationRegisterCell(Row, 7, cfiSameValue, 0, 0);
end;
end;
function TDwarfCallFrameInformation.CloneRow(const SourceRow: TDwarfCallFrameInformationRow): TDwarfCallFrameInformationRow;
begin
Result := SourceRow;
// Create a deep-copy of the array.
Result.RegisterArray := copy(SourceRow.RegisterArray, 0, Length(SourceRow.RegisterArray));
end;
constructor TDwarfCallFrameInformation.Create;
begin
FFDEMap := TCFIMap.Create(itu8, SizeOf(Pointer));
FCIEMap := TCFIMap.Create(itu8, SizeOf(Pointer));
end;
destructor TDwarfCallFrameInformation.Destroy;
begin
FFDEMap.Free;
FCIEMap.Free;
inherited Destroy;
end;
procedure TDwarfCallFrameInformation.AddCIE(AnOffset: QWord; ACIE: TDwarfCIE);
begin
FCIEMap.Add(AnOffset, ACIE);
end;
procedure TDwarfCallFrameInformation.AddFDE(AFDE: TDwarfFDE);
begin
FFDEMap.Add(AFDE.InitialLocation, AFDE);
end;
function TDwarfCallFrameInformation.FindFDEForAddress(AnAddress: TDBGPtr): TDwarfFDE;
var
Iter: TLockedMapIterator;
FDE: TDwarfFDE;
begin
Result := nil;
Iter := TLockedMapIterator.Create(FFDEMap);
try
if not Iter.Locate(AnAddress) then
begin
if not Iter.BOM then
Iter.Previous;
end;
if not Iter.BOM then
begin
// iter is at the closest defined address before AAddress
FDE := TDwarfFDE(Iter.DataPtr^);
if AnAddress <= FDE.InitialLocation + FDE.AddressRange then
begin
Result := FDE;
end;
end;
finally
Iter.Free;
end;
end;
function TDwarfCallFrameInformation.FindCIEForOffset(AnOffset: QWord): TDwarfCIE;
var
Iter: TLockedMapIterator;
begin
Result := nil;
Iter := TLockedMapIterator.Create(FCIEMap);
try
if not Iter.Locate(AnOffset) then
begin
if not Iter.BOM then
Iter.Previous;
end;
if not Iter.BOM then
begin
// iter is at the closest defined address before AAddress
Result := TDwarfCIE(Iter.DataPtr^);
end;
finally
Iter.Free;
end;
end;
function TDwarfCallFrameInformation.GetRow(TargetInfo: TTargetDescriptor; AnAddress: TDBGPtr; out CIE: TDwarfCIE; out Row: TDwarfCallFrameInformationRow): Boolean;
var
FDE: TDwarfFDE;
begin
Result := False;
FRowStack := [];
Row := Default(TDwarfCallFrameInformationRow);
FDE := FindFDEForAddress(AnAddress);
if Assigned(FDE) then
begin
InitializeABIRules(TargetInfo, Row);
CIE := FindCIEForOffset(FDE.CIEPointer);
if ProcessInstructions(CIE, Row, CIE.InitialInstructions, FDE.InitialLocation, AnAddress) then
begin
FInitialInstructionsCache := CloneRow(Row);
Result := ProcessInstructions(CIE, Row, FDE.Instructions, FDE.InitialLocation, AnAddress);
end;
end;
end;
class function TDwarfCallFrameInformation.TryObtainNextCallFrame(
CurrentCallStackEntry: TDbgCallstackEntry;
CIE: TDwarfCIE;
Size, NextIdx: Integer;
Thread: TDbgThread;
Row: TDwarfCallFrameInformationRow;
Process: TDbgProcess;
out NewCallStackEntry: TDbgCallstackEntry): Boolean;
function ProcessCFIColumn(Row: TDwarfCallFrameInformationRow; Column: Byte; CFA: QWord; AddressSize: Integer; Entry: TDbgCallstackEntry; out Value: TDbgPtr): Boolean;
var
Rule: TDwarfCallFrameInformationRule;
Reg: TDbgRegisterValue;
begin
Result := True;
Value := 0;
Rule := Row.RegisterArray[Column];
case Rule.RegisterRule of
cfiUndefined:
begin
Result := False;
end;
cfiSameValue:
begin
Reg := CurrentCallStackEntry.RegisterValueList.FindRegisterByDwarfIndex(Column);
if Assigned(Reg) then
Value := Reg.NumValue
else
Result := False;
end;
cfiOffset:
begin
Process.ReadData(CFA+Rule.Offset, AddressSize, Value);
end;
cfiValOffset:
begin
Value := CFA+Rule.Offset;
end;
cfiRegister:
begin
Reg := CurrentCallStackEntry.RegisterValueList.FindRegisterByDwarfIndex(Rule.&Register);
if Assigned(Reg) then
Value := Reg.NumValue
else
Result := False;
end
else
begin
DebugLn(FPDBG_DWARF_CFI_WARNINGS, 'Encountered unsupported CFI registerrule.');
Result := False;
end;
end; // case
end;
var
Rule: TDwarfCallFrameInformationRule;
Reg: TDbgRegisterValue;
i: Integer;
ReturnAddress, Value: TDbgPtr;
FrameBase: TDBGPtr;
begin
Result := False;
NewCallStackEntry := nil;
// Get CFA (framebase)
Rule := Row.CFARule;
case Rule.CFARule of
cfaRegister:
begin
Reg := CurrentCallStackEntry.RegisterValueList.FindRegisterByDwarfIndex(Rule.&Register);
if Assigned(Reg) then
begin
FrameBase := Reg.NumValue;
FrameBase := FrameBase + Rule.Offset;
end
else
begin
DebugLn(FPDBG_DWARF_CFI_WARNINGS, 'CFI requested a register [' +IntToStr(Rule.&Register)+ '] that is not available.');
Exit;
end;
end;
cfaExpression:
begin
DebugLn(FPDBG_DWARF_CFI_WARNINGS, 'CFI-expressions are not supported. Not possible to obtain the CFA.');
Exit;
end;
else
begin
DebugLn(FPDBG_DWARF_CFI_WARNINGS, 'CFI available but no rule to obtain the CFA.');
Exit;
end;
end; // case
Result := True;
// Get return ReturnAddress
if not ProcessCFIColumn(Row, CIE.ReturnAddressRegister, FrameBase, Size, CurrentCallStackEntry, ReturnAddress) then
// Yes, we were succesfull, but there is no return ReturnAddress, so keep
// NewCallStackEntry nil
begin
Result := True;
Exit;
end;
if ReturnAddress=0 then
// Yes, we were succesfull, but there is no frame left, so keep
// NewCallStackEntry nil
begin
Result := True;
Exit;
end;
// We do not strace-back to the return address, we need the calling-address.
// This is difficult though. But we assume that ReturnAddress-1 is part of
// the instruction that made the call.
NewCallStackEntry := TDbgCallstackEntry.create(Thread, NextIdx, FrameBase, ReturnAddress-1);
// Fill other registers
for i := 0 to High(Row.RegisterArray) do
begin
if ProcessCFIColumn(Row, i, FrameBase, Size, CurrentCallStackEntry, Value) then
NewCallStackEntry.RegisterValueList.DbgRegisterAutoCreate[IntToStr(i)].SetValue(Value, IntToStr(Value),Size, i);
end;
end;
{ TDwarfFDE }
constructor TDwarfFDE.Create(ACIEPointer: QWord; AnInitialLocation, ASegmentSelector: TDBGPtr; AnAddressRange: QWord);
begin
FCIEPointer := ACIEPointer;
FInitialLocation := AnInitialLocation;
FSegmentSelector := ASegmentSelector;
FAddressRange := AnAddressRange;
end;
{ TDwarfCIE }
constructor TDwarfCIE.Create(AVersion: Byte; AnAugmentation: string);
begin
FVersion := AVersion;
FAugmentation := AnAugmentation;
end;
initialization
FPDBG_DWARF_CFI_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_CFI_WARNINGS' {$IFDEF FPDBG_DWARF_CFI_WARNINGS} , True {$ENDIF} );
end.

241
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -45,7 +45,7 @@ uses
Classes, Types, SysUtils, contnrs, Math, Maps, LazClasses, LazFileUtils,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazUTF8, lazCollections,
// FpDebug
FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, FpDbgCommon,
FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, FpDbgCommon, FpDbgDwarfCFI,
FpDbgLoader, FpImgReaderBase, FpdMemoryTools, FpErrorMessages, DbgIntfBaseTypes;
type
@ -131,7 +131,7 @@ type
HeaderLength: QWord;
Info: TDwarfLNPInfoHeader;
end;
{$PACKRECORDS C}
{%endregion Dwarf Header Structures }
@ -784,6 +784,7 @@ type
TFpDwarfInfo = class(TDbgInfo)
strict private
FCompilationUnits: TList; // any access must be guarded by Item[n].WaitForScopeScan
FCallFrameInformationList: TList;
FWorkQueue: TFpGlobalThreadWorkerQueue;
FFiles: array of TDwarfDebugFile;
private
@ -802,11 +803,13 @@ type
function FindProcSymbol(AAddress: TDbgPtr): TFpSymbol; override; overload;
function FindProcStartEndPC(const AAddress: TDbgPtr; out AStartPC, AEndPC: TDBGPtr): boolean; override;
function FindLineInfo(AAddress: TDbgPtr): TFpSymbol; override;
function FindCallFrameInfo(AnAddress: TDBGPtr; out CIE: TDwarfCIE; out Row: TDwarfCallFrameInformationRow): Boolean; virtual;
//function FindSymbol(const AName: String): TDbgSymbol; override; overload;
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray;
AFindSibling: TGetLineAddrFindSibling = fsNone; AFoundLine: PInteger = nil): Boolean; override;
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
procedure LoadCallFrameInstructions;
function LoadCompilationUnits: Integer;
function CompilationUnitsCount: Integer; inline;
property CompilationUnits[AIndex: Integer]: TDwarfCompilationUnit read GetCompilationUnit;
@ -875,9 +878,6 @@ type
property IsDwAtFrameBase: Boolean read FIsDwAtFrameBase write FIsDwAtFrameBase;
end;
function ULEB128toOrdinal(var p: PByte): QWord;
function SLEB128toOrdinal(var p: PByte): Int64;
function Dbgs(AInfoData: Pointer; ACompUnit: TDwarfCompilationUnit): String; overload;
function Dbgs(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String; overload;
function Dbgs(AInfoEntry: TDwarfInformationEntry; ACompUnit: TDwarfCompilationUnit): String; overload;
@ -896,7 +896,7 @@ var
FPDBG_DWARF_VERBOSE_LOAD: PLazLoggerLogGroup;
var
TheDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList;
TheDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList = nil;
CachedRtlEvent: PRTLEvent = nil;
const
@ -904,6 +904,8 @@ const
function GetDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList;
begin
if not Assigned(TheDwarfSymbolClassMapList) then
TheDwarfSymbolClassMapList := TFpSymbolDwarfClassMapList.Create;
Result := TheDwarfSymbolClassMapList;
end;
@ -967,40 +969,6 @@ begin
end;
end;
function ULEB128toOrdinal(var p: PByte): QWord;
var
n: Byte;
Stop: Boolean;
begin
Result := 0;
n := 0;
repeat
Stop := (p^ and $80) = 0;
Result := Result + QWord(p^ and $7F) shl n;
Inc(n, 7);
Inc(p);
until Stop or (n > 128);
end;
function SLEB128toOrdinal(var p: PByte): Int64;
var
n: Byte;
Stop: Boolean;
begin
Result := 0;
n := 0;
repeat
Stop := (p^ and $80) = 0;
Result := Result + Int64(p^ and $7F) shl n;
Inc(n, 7);
Inc(p);
until Stop or (n > 128);
// sign extend when msbit = 1
if ((p[-1] and $40) <> 0) and (n < 64) // only supports 64 bit
then Result := Result or (Int64(-1) shl n);
end;
function SkipEntryDataForForm(var AEntryData: Pointer; AForm: Cardinal; AddrSize: Byte; IsDwarf64: boolean; Version: word): Boolean; inline;
var
UValue: QWord;
@ -2221,30 +2189,6 @@ var
SetError;
end;
function ReadUnsignedFromExpression(var CurInstr: Pointer; ASize: Integer): TDbgPtr;
begin
case ASize of
1: Result := PByte(CurInstr)^;
2: Result := PWord(CurInstr)^;
4: Result := PLongWord(CurInstr)^;
8: Result := PQWord(CurInstr)^;
0: Result := ULEB128toOrdinal(CurInstr);
end;
inc(CurInstr, ASize);
end;
function ReadSignedFromExpression(var CurInstr: Pointer; ASize: Integer): TDbgPtr;
begin
case ASize of
1: Int64(Result) := PShortInt(CurInstr)^;
2: Int64(Result) := PSmallInt(CurInstr)^;
4: Int64(Result) := PLongint(CurInstr)^;
8: Int64(Result) := PInt64(CurInstr)^;
0: Int64(Result) := SLEB128toOrdinal(CurInstr);
end;
inc(CurInstr, ASize);
end;
var
NewLoc, Loc: TFpDbgMemLocation;
NewValue: TDbgPtr;
@ -3648,6 +3592,7 @@ begin
inherited Create(ALoaderList, AMemManager);
FTargetInfo := ALoaderList.TargetInfo;
FCompilationUnits := TList.Create;
FCallFrameInformationList := TObjectList.Create(True);
FImageBase := ALoaderList.ImageBase;
FRelocationOffset := ALoaderList.RelocationOffset;
@ -3676,6 +3621,7 @@ begin
for n := 0 to FCompilationUnits.Count - 1 do
TObject(FCompilationUnits[n]).Free;
FreeAndNil(FCompilationUnits);
FreeAndNil(FCallFrameInformationList);
inherited Destroy;
end;
@ -3870,6 +3816,22 @@ begin
end;
end;
function TFpDwarfInfo.FindCallFrameInfo(AnAddress: TDBGPtr; out CIE: TDwarfCIE; out Row: TDwarfCallFrameInformationRow): Boolean;
var
n: Integer;
CFI: TDwarfCallFrameInformation;
begin
Result := False;
for n := 0 to FCallFrameInformationList.Count - 1 do
begin
CFI := TDwarfCallFrameInformation(FCallFrameInformationList[n]);
Result := CFI.GetRow(FTargetInfo, AnAddress, CIE, Row);
if Result then
Break;
end;
end;
function TFpDwarfInfo.FindDwarfUnitSymbol(AAddress: TDbgPtr
): TDbgDwarfSymbolBase;
var
@ -3923,6 +3885,155 @@ begin
Result := nil;
end;
procedure TFpDwarfInfo.LoadCallFrameInstructions;
var
i: Integer;
var
inf: TDwarfSectionInfo;
function LoadCiE(Version: Byte; Augmentation: PChar; SizeLeft: QWord): TDwarfCIE;
var
p: Pointer;
Instructions: TDwarfCallFrameInformationInstructions;
begin
if Version > 4 then
DebugLn(FPDBG_DWARF_WARNINGS, ['Unsupported DWARF CFI version (' +IntToStr(Version)+ '). Only versions 1-4 are supported.']);
Result := TDwarfCIE.Create(Version, String(Augmentation));
p := Augmentation;
Inc(p, Length(Result.Augmentation)+1);
if Version > 3 then
begin
Result.AddressSize := PByte(p)^;
Inc(p);
Result.SegmentSize := PByte(p)^;
Inc(p);
end
else
begin
case TargetInfo.bitness of
b32: Result.AddressSize := 4;
b64: Result.AddressSize := 8;
end;
end;
Result.CodeAlignmentFactor := ULEB128toOrdinal(p);
Result.DataAlignmentFactor := SLEB128toOrdinal(p);
if Version < 3 then
begin
Result.ReturnAddressRegister := PByte(p)^;
Inc(p);
end
else
Result.ReturnAddressRegister := ULEB128toOrdinal(p);
// Calculate how many bytes are left. (DwarfDump calls this the 'bytes of
// initial instructions')
Dec(SizeLeft, p-Augmentation);
SetLength(Instructions, SizeLeft);
Move(p^, Instructions[0], SizeLeft);
Result.InitialInstructions := Instructions;
end;
function LoadFDE(CFI: TDwarfCallFrameInformation; CIEPointer: QWord; InitialLocationAddr: pointer; SizeLeft: QWord): TDwarfFDE;
var
Instr: TDwarfCallFrameInformationInstructions;
CIE: TDwarfCIE;
InitialLocation: TDBGPtr;
AddressRange, SegmentSelector: QWord;
p: pointer;
begin
p := InitialLocationAddr;
CIE := CFI.FindCIEForOffset(CIEPointer);
SegmentSelector := 0;
if Assigned(CIE) then
begin
if CIE.SegmentSize > 0 then
SegmentSelector := ReadUnsignedFromExpression(p, CIE.SegmentSize);
InitialLocation := ReadUnsignedFromExpression(p, CIE.AddressSize);
AddressRange := ReadUnsignedFromExpression(p, CIE.AddressSize);
end;
Result := TDwarfFDE.Create(CIEPointer, InitialLocation, SegmentSelector, AddressRange);
SetLength(Instr, InitialLocationAddr + SizeLeft - p);
if Length(Instr) > 0 then
Move(p^, Instr[0], InitialLocationAddr + SizeLeft - p);
Result.Instructions := Instr;
end;
var
p, pe: Pointer;
CIE32: PDwarfCIEEntryHeader32 absolute p;
CIE64: PDwarfCIEEntryHeader64 absolute p;
FDE32: PDwarfFDEEntryHeader32 absolute p;
FDE64: PDwarfFDEEntryHeader64 absolute p;
CIE: TDwarfCIE;
FDE: TDwarfFDE;
Length: QWord;
CFI: TDwarfCallFrameInformation;
begin
for i := 0 to high(FFiles) do
begin
inf := FFiles[i].Sections[dsFrame];
CFI := TDwarfCallFrameInformation.Create;
FCallFrameInformationList.Add(CFI);
p := inf.RawData;
pe := inf.RawData + inf.Size;
while (p <> nil) and (p < pe) do
begin
// The first fields in the CIE and FDE structures are the same.
// First check if it is a 64-bit format. Then
// detect whether it is a CIE or FDE.
if CIE64^.Signature = DWARF_HEADER64_SIGNATURE then
begin
if CIE64^.CIEId = QWord($ffffffffffffffff) then
begin
// It is a CIE
CIE := LoadCiE(CIE64^.Version, @CIE64^.Augmentation[0], @CIE64^.CIEId+CIE64^.Length-@CIE64^.Augmentation[0]);
CFI.AddCIE(p-inf.RawData, CIE);
end
else
begin
// It is a FDE
FDE := LoadFDE(CFI, FDE64^.CIEPointer, @FDE64^.InitialLocation, @FDE64^.CIEPointer+FDE64^.Length-@FDE64^.InitialLocation);
CFI.AddFDE(FDE);
end;
Length := CIE64^.Length;
p := @CIE64^.CIEId;
Inc(p, Length);
end
else
begin
if CIE32^.CIEId = $ffffffff then
begin
// It is a CIE
CIE := LoadCiE(CIE32^.Version, @CIE32^.Augmentation[0], @CIE32^.CIEId+CIE32^.Length-@CIE32^.Augmentation[0]);
CFI.AddCIE(p-inf.RawData, CIE);
end
else
begin
// It is a FDE
if FDE32^.Length > 0 then
begin
FDE := LoadFDE(CFI, FDE32^.CIEPointer, @FDE32^.InitialLocation, @FDE32^.CIEPointer+FDE32^.Length-@FDE32^.InitialLocation);
CFI.AddFDE(FDE);
end
else
// This should never happen, but it did and it leads to a range-check
// error. (Probably a fpc-bug though)
DebugLn(FPDBG_DWARF_WARNINGS, ['Read FDE with length 0. FDE is skipped.']);
end;
Length := CIE32^.Length;
p := @CIE32^.CIEId;
Inc(p, Length);
end;
end;
end;
end;
function TFpDwarfInfo.LoadCompilationUnits: Integer;
var
p, pe: Pointer;
@ -5460,8 +5571,6 @@ begin
end;
initialization
TheDwarfSymbolClassMapList := TFpSymbolDwarfClassMapList.Create;
FPDBG_DWARF_ERRORS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_ERRORS' {$IFDEF FPDBG_DWARF_ERRORS} , True {$ENDIF} );
FPDBG_DWARF_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_WARNINGS' {$IFDEF FPDBG_DWARF_WARNINGS} , True {$ENDIF} );
FPDBG_DWARF_VERBOSE := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_VERBOSE' {$IFDEF FPDBG_DWARF_VERBOSE} , True {$ENDIF} );

2
components/fpdebug/fpdbgdwarfverboseprinter.pas
View File

@ -6,7 +6,7 @@ unit FpDbgDwarfVerbosePrinter;
interface
uses
Classes, Math, SysUtils, FpDbgDwarf, FpDbgLoader, FpDbgDwarfConst, FpdMemoryTools,
Classes, Math, SysUtils, FpDbgDwarf, FpDbgLoader, FpDbgDwarfConst, FpdMemoryTools, FpDbgUtil,
FpImgReaderBase, FpDbgDwarfDataClasses, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, maps;
type

65
components/fpdebug/fpdbgutil.pp
View File

@ -215,16 +215,79 @@ property FpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue read GetFpDbgGlobalW
function dbgsThread: String;
function dbgsWorkItemState(AState: Integer): String;
function ULEB128toOrdinal(var p: PByte): QWord;
function SLEB128toOrdinal(var p: PByte): Int64;
function ReadUnsignedFromExpression(var CurInstr: Pointer; ASize: Integer): QWord;
function ReadSignedFromExpression(var CurInstr: Pointer; ASize: Integer): Int64;
var
ProcessMessagesProc: procedure of object; // Application.ProcessMessages, if needed. To be called while waiting.
implementation
var
FPDBG_THREADS, DBG_VERBOSE, DBG_ERRORS: PLazLoggerLogGroup;
TheFpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue = nil;
function ULEB128toOrdinal(var p: PByte): QWord;
var
n: Byte;
Stop: Boolean;
begin
Result := 0;
n := 0;
repeat
Stop := (p^ and $80) = 0;
Result := Result + QWord(p^ and $7F) shl n;
Inc(n, 7);
Inc(p);
until Stop or (n > 128);
end;
function SLEB128toOrdinal(var p: PByte): Int64;
var
n: Byte;
Stop: Boolean;
begin
Result := 0;
n := 0;
repeat
Stop := (p^ and $80) = 0;
Result := Result + Int64(p^ and $7F) shl n;
Inc(n, 7);
Inc(p);
until Stop or (n > 128);
// sign extend when msbit = 1
if ((p[-1] and $40) <> 0) and (n < 64) // only supports 64 bit
then Result := Result or (Int64(-1) shl n);
end;
function ReadUnsignedFromExpression(var CurInstr: Pointer; ASize: Integer): QWord;
begin
case ASize of
1: Result := PByte(CurInstr)^;
2: Result := PWord(CurInstr)^;
4: Result := PLongWord(CurInstr)^;
8: Result := PQWord(CurInstr)^;
0: Result := ULEB128toOrdinal(CurInstr);
end;
inc(CurInstr, ASize);
end;
function ReadSignedFromExpression(var CurInstr: Pointer; ASize: Integer): Int64;
begin
case ASize of
1: Result := PShortInt(CurInstr)^;
2: Result := PSmallInt(CurInstr)^;
4: Result := PLongint(CurInstr)^;
8: Result := PInt64(CurInstr)^;
0: Result := SLEB128toOrdinal(CurInstr);
end;
inc(CurInstr, ASize);
end;
function GetFpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue;
begin
if TheFpDbgGlobalWorkerQueue = nil then

4
components/fpdebug/fpdebug.lpk
View File

@ -225,6 +225,10 @@ File(s) with other licenses (see also header in file(s):
<Filename Value="fpwatchresultdata.pas"/>
<UnitName Value="FpWatchResultData"/>
</Item>
<Item>
<Filename Value="fpdbgdwarfcfi.pas"/>
<UnitName Value="fpdbgdwarfcfi"/>
</Item>
</Files>
<i18n>
<EnableI18N Value="True"/>

2
components/fpdebug/fpdebug.pas
View File

@ -16,7 +16,7 @@ uses
FpDbgDwarfDataClasses, FpDbgDwarfFreePascal, fpDbgSymTableContext,
fpDbgSymTable, FpDbgAvrClasses, FpDbgDisasAvr, FpDbgRsp, FpDbgCommon,
FpImgReaderWinPETypes, FpDbgHardcodedFreepascalInfo, FpDbgCallContextInfo,
FpWatchResultData;
FpWatchResultData, FpDbgDwarfCFI;
implementation

52
components/fpdebug/fppascalbuilder.pas
View File

@ -9,6 +9,7 @@ interface
uses
Classes, SysUtils, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgInfo,
FpdMemoryTools, FpErrorMessages, FpDbgDwarfDataClasses, FpDbgDwarf,
FpDbgClasses,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif},
LazUTF8, LazClasses, LazDebuggerIntf;
@ -88,11 +89,62 @@ type
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpSymbol; AFlags: TTypeNameFlags = []): Boolean;
function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpSymbol;
AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean;
function GetParamsAsString(
AThread: TDbgThread;
ADbgCallStack: TDbgCallstackEntry;
AMemManager: TFpDbgMemManager;
ATargetWidth: Byte;
APrettyPrinter: TFpPascalPrettyPrinter): string;
function QuoteText(AText: Utf8String): UTf8String;
implementation
function GetParamsAsString(
AThread: TDbgThread;
ADbgCallStack: TDbgCallstackEntry;
AMemManager: TFpDbgMemManager;
ATargetWidth: Byte;
APrettyPrinter: TFpPascalPrettyPrinter): string;
var
ProcVal: TFpValue;
ProcSymbol: TFpSymbol;
AContext: TFpDbgLocationContext;
m: TFpValue;
v: String;
i: Integer;
begin
result := '';
ProcSymbol := ADbgCallStack.ProcSymbol;
if assigned(ProcSymbol) then begin
ProcVal := ProcSymbol.Value;
if (ProcVal <> nil) then begin
AContext := TFpDbgSimpleLocationContext.Create(AMemManager,
LocToAddrOrNil(ProcSymbol.Address), ATargetWidth div 8, AThread.ID, ADbgCallStack.Index);
if AContext <> nil then begin
TFpValueDwarf(ProcVal).Context := AContext;
APrettyPrinter.Context := AContext;
APrettyPrinter.AddressSize := AContext.SizeOfAddress;
for i := 0 to ProcVal.MemberCount - 1 do begin
m := ProcVal.Member[i];
if (m <> nil) and (sfParameter in m.DbgSymbol.Flags) then begin
APrettyPrinter.PrintValue(v, m, wdfDefault, -1, [ppoStackParam]);
if result <> '' then result := result + ', ';
result := result + v;
end;
m.ReleaseReference;
end;
TFpValueDwarf(ProcVal).Context := nil;
AContext.ReleaseReference;
end;
ProcVal.ReleaseReference;
end;
if result <> '' then
result := '(' + result + ')';
end;
end;
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpSymbol;
AFlags: TTypeNameFlags): Boolean;
var

2
components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas
View File

@ -623,7 +623,7 @@ begin
FSourceFile := DbgCallStack.SourceFile;
FLine := DbgCallStack.Line;
FParamAsString := DbgCallStack.GetParamsAsString(PrettyPrinter);
FParamAsString := GetParamsAsString(FThread, DbgCallStack, FDebugger.MemManager, FDebugger.TargetWidth, PrettyPrinter);
PrettyPrinter.Free;
FDebugger.MemManager.MemLimits.MaxArrayLen := Prop.MemLimits.MaxArrayLen;