paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 07:40:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: add some more error checks in eval

Browse Source 
git-svn-id: trunk@44230 -
This commit is contained in:
martin 2014-02-25 04:57:38 +00:00
parent 581df94551
commit de5811d90d
7 changed files with 309 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

197
components/fpdebug/fpdbgdwarf.pas
View File

@ -41,8 +41,8 @@ unit FpDbgDwarf;
interface
uses
Classes, Types, SysUtils, FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, Maps, Math,
FpDbgLoader, FpImgReaderBase, FpdMemoryTools, LazLoggerBase, // LazLoggerDummy,
Classes, Types, SysUtils, FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, Maps, Math, FpDbgLoader,
FpImgReaderBase, FpdMemoryTools, FpErrorMessages, LazLoggerBase, // LazLoggerDummy,
LazClasses, LazFileUtils, LazUTF8, contnrs, DbgIntfBaseTypes;
type
@ -295,6 +295,7 @@ type
TDwarfLocationExpression = class
private
FFrameBase: TDbgPtr;
FLastError: TFpError;
FOnFrameBaseNeeded: TNotifyEvent;
FStack: TDwarfLocationStack;
FCU: TDwarfCompilationUnit;
@ -308,6 +309,7 @@ type
function ResultData: TDbgPtr;
property FrameBase: TDbgPtr read FFrameBase write FFrameBase;
property OnFrameBaseNeeded: TNotifyEvent read FOnFrameBaseNeeded write FOnFrameBaseNeeded;
property LastError: TFpError read FLastError;
end;
{ TDwarfInformationEntry }
@ -597,9 +599,11 @@ type
FValueSymbol: TDbgDwarfValueIdentifier;
FTypeCastTargetType: TDbgDwarfTypeIdentifier;
FTypeCastSourceValue: TDbgSymbolValue;
FLastError: TFpError;
function MemManager: TFpDbgMemManager; inline;
function AddressSize: Byte; inline;
protected
function GetLastError: TFpError; override;
function DataAddr: TFpDbgMemLocation;
function OrdOrDataAddr: TFpDbgMemLocation;
function GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean;
@ -1135,7 +1139,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
TDbgDwarfIdentifierSet = class(TDbgDwarfTypeIdentifier)
protected
procedure KindNeeded; override;
function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
function GetTypedValueObject({%H-}ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
function GetMemberCount: Integer; override;
function GetMember(AIndex: Integer): TDbgSymbol; override;
end;
@ -1219,7 +1223,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
procedure ReadOrdering;
protected
procedure KindNeeded; override;
function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
function GetTypedValueObject({%H-}ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
function GetFlags: TDbgSymbolFlags; override;
// GetMember: returns the TYPE/range of each index. NOT the data
@ -1382,7 +1386,8 @@ function DbgsDump(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): St
implementation
var
FPDBG_DWARF_WARNINGS, FPDBG_DWARF_SEARCH, FPDBG_DWARF_VERBOSE: PLazLoggerLogGroup;
FPDBG_DWARF_ERRORS, FPDBG_DWARF_WARNINGS, FPDBG_DWARF_SEARCH, FPDBG_DWARF_VERBOSE,
FPDBG_DWARF_DATA_WARNINGS: PLazLoggerLogGroup;
const
SCOPE_ALLOC_BLOCK_SIZE = 4096; // Increase scopelist in steps of
@ -2056,7 +2061,7 @@ begin
if i2 < Cnt then begin
FMemberCount := i2;
debugln(FPDBG_DWARF_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
debugln(FPDBG_DWARF_DATA_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
end;
end
else begin
@ -2082,7 +2087,7 @@ begin
if i2 < Cnt then begin
FMemberCount := i2;
debugln(['TDbgDwarfSetSymbolValue.InitMap not enough members']);
debugln(FPDBG_DWARF_DATA_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
end;
end;
@ -2103,8 +2108,6 @@ begin
end;
function TDbgDwarfSetSymbolValue.GetMemberCount: Integer;
var
t: TDbgSymbol;
begin
InitMap;
Result := FMemberCount;
@ -2219,6 +2222,7 @@ end;
function TDbgDwarfEnumMemberSymbolValue.IsValidTypeCast: Boolean;
begin
assert(False, 'TDbgDwarfEnumMemberSymbolValue.IsValidTypeCast can not be returned for typecast');
Result := False;
end;
{ TDbgDwarfEnumSymbolValue }
@ -2758,13 +2762,24 @@ begin
Result := FOwner.FCU.FAddressSize;
end;
function TDbgDwarfSymbolValue.GetLastError: TFpError;
begin
Result := FLastError;
end;
function TDbgDwarfSymbolValue.DataAddr: TFpDbgMemLocation;
begin
if FValueSymbol <> nil then
Result := FValueSymbol.Address
if FValueSymbol <> nil then begin
Result := FValueSymbol.Address;
if IsFpError(FValueSymbol.LastError) then
FLastError := FValueSymbol.LastError;
end
else
if HasTypeCastInfo then
Result := FTypeCastSourceValue.Address
if HasTypeCastInfo then begin
Result := FTypeCastSourceValue.Address;
if IsFpError(FTypeCastSourceValue.LastError) then
FLastError := FTypeCastSourceValue.LastError;
end
else
Result := InvalidLoc;
end;
@ -2781,13 +2796,14 @@ function TDbgDwarfSymbolValue.GetDwarfDataAddress(out AnAddress: TFpDbgMemLocati
ATargetType: TDbgDwarfTypeIdentifier): Boolean;
var
fields: TDbgSymbolValueFieldFlags;
t: TDbgDwarfTypeIdentifier;
begin
if FValueSymbol <> nil then begin
Assert(FValueSymbol is TDbgDwarfValueIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol');
Assert(TypeInfo is TDbgDwarfTypeIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo');
Assert(not HasTypeCastInfo, 'TDbgDwarfSymbolValue.GetDwarfDataAddress not HasTypeCastInfo');
Result := FValueSymbol.GetDataAddress(AnAddress, TDbgDwarfTypeIdentifier(FOwner));
if IsFpError(FValueSymbol.LastError) then
FLastError := FValueSymbol.LastError;
end
else
@ -2809,6 +2825,8 @@ begin
exit;
Result := FTypeCastTargetType.GetDataAddress(AnAddress, ATargetType);
if IsFpError(FTypeCastTargetType.LastError) then
FLastError := FTypeCastTargetType.LastError;
end;
end;
@ -3943,31 +3961,39 @@ begin
end;
procedure TDwarfLocationExpression.Evaluate;
var
CurInstr, CurData: PByte;
MemManager: TFpDbgMemManager;
AddrSize: Byte;
procedure SetError;
procedure SetError(AnInternalErrorCode: TFpErrorCode = fpErrNoError);
begin
FStack.Push(InvalidLoc, lseError); // Mark as failed
debugln(['!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TDwarfLocationExpression ERROR']);
if IsFpError(MemManager.LastError)
then FLastError := CreateError(fpErrLocationParserMemRead, MemManager.LastError, [])
else FLastError := CreateError(fpErrLocationParser, []);
debugln(FPDBG_DWARF_ERRORS,
['DWARF ERROR in TDwarfLocationExpression: Failed at Pos=', CurInstr-FData,
' OpCode=', IntToHex(CurInstr^, 2), ' Depth=', FStack.Count,
' Data: ', dbgMemRange(FData, FMaxData-FData),
' MemReader.LastError: ', FpErrorHandler.ErrorAsString(MemManager.LastError),
' Extra: ', FpErrorHandler.ErrorAsString(AnInternalErrorCode, []) ]);
end;
function AssertAddressOnStack: Boolean;
begin
Result := FStack.PeekKind in [lseValue, lseRegister]; // todo: allow register?
if not Result then
SetError;
SetError(fpErrLocationParserNoAddressOnStack);
end;
function AssertMinCount(ACnt: Integer): Boolean;
begin
Result := FStack.Count >= ACnt;
if not Result then
SetError;
SetError(fpErrLocationParserMinStack);
end;
var
MemManager: TFpDbgMemManager;
AddrSize: Byte;
function ReadAddressFromMemory(AnAddress: TFpDbgMemLocation; ASize: Cardinal; out AValue: TFpDbgMemLocation): Boolean;
begin
//TODO: zero fill / sign extend
@ -3986,32 +4012,31 @@ var
SetError;
end;
function ReadUnsignedFromExpression(var p: Pointer; ASize: Integer): TDbgPtr;
function ReadUnsignedFromExpression(var CurInstr: Pointer; ASize: Integer): TDbgPtr;
begin
case ASize of
1: Result := PByte(p)^;
2: Result := PWord(p)^;
4: Result := PLongWord(p)^;
8: Result := PQWord(p)^;
0: Result := ULEB128toOrdinal(p);
1: Result := PByte(CurInstr)^;
2: Result := PWord(CurInstr)^;
4: Result := PLongWord(CurInstr)^;
8: Result := PQWord(CurInstr)^;
0: Result := ULEB128toOrdinal(CurInstr);
end;
inc(p, ASize);
inc(CurInstr, ASize);
end;
function ReadSignedFromExpression(var p: Pointer; ASize: Integer): TDbgPtr;
function ReadSignedFromExpression(var CurInstr: Pointer; ASize: Integer): TDbgPtr;
begin
case ASize of
1: Int64(Result) := PShortInt(p)^;
2: Int64(Result) := PSmallInt(p)^;
4: Int64(Result) := PLongint(p)^;
8: Int64(Result) := PInt64(p)^;
0: Int64(Result) := SLEB128toOrdinal(p);
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(p, ASize);
inc(CurInstr, ASize);
end;
var
p: PByte;
NewLoc, Loc: TFpDbgMemLocation;
NewValue: TDbgPtr;
i: TDbgPtr;
@ -4020,12 +4045,15 @@ var
begin
AddrSize := FCU.FAddressSize;
MemManager := FCU.FOwner.MemManager;
while FData < FMaxData do begin
p := FData;
inc(FData);
case p^ of
MemManager.ClearLastError;
FLastError := FpErrorNone;
CurData := FData;
while CurData < FMaxData do begin
CurInstr := CurData;
inc(CurData);
case CurInstr^ of
DW_OP_nop: ;
DW_OP_addr: FStack.Push(FCU.ReadAddressAtPointer(FData, True), lseValue);
DW_OP_addr: FStack.Push(FCU.ReadAddressAtPointer(CurData, True), lseValue);
DW_OP_deref: begin
if not AssertAddressOnStack then exit;
if not ReadAddressFromMemory(FStack.Pop.Value, AddrSize, NewLoc) then exit;
@ -4041,7 +4069,7 @@ begin
end;
DW_OP_deref_size: begin
if not AssertAddressOnStack then exit;
if not ReadAddressFromMemory(FStack.Pop.Value, ReadUnsignedFromExpression(FData, 1), NewLoc) then exit;
if not ReadAddressFromMemory(FStack.Pop.Value, ReadUnsignedFromExpression(CurData, 1), NewLoc) then exit;
FStack.Push(NewLoc, lseValue);
end;
DW_OP_xderef_size: begin
@ -4049,31 +4077,31 @@ begin
Loc := FStack.Pop.Value;
if not AssertAddressOnStack then exit;
// TODO check address is valid
if not ReadAddressFromMemoryEx(Loc, FStack.Pop.Value.Address, ReadUnsignedFromExpression(FData, 1), NewLoc) then exit;
if not ReadAddressFromMemoryEx(Loc, FStack.Pop.Value.Address, ReadUnsignedFromExpression(CurData, 1), NewLoc) then exit;
FStack.Push(NewLoc, lseValue);
end;
DW_OP_const1u: FStack.Push(ReadUnsignedFromExpression(FData, 1), lseValue);
DW_OP_const2u: FStack.Push(ReadUnsignedFromExpression(FData, 2), lseValue);
DW_OP_const4u: FStack.Push(ReadUnsignedFromExpression(FData, 4), lseValue);
DW_OP_const8u: FStack.Push(ReadUnsignedFromExpression(FData, 8), lseValue);
DW_OP_constu: FStack.Push(ReadUnsignedFromExpression(FData, 0), lseValue);
DW_OP_const1s: FStack.Push(ReadSignedFromExpression(FData, 1), lseValue);
DW_OP_const2s: FStack.Push(ReadSignedFromExpression(FData, 2), lseValue);
DW_OP_const4s: FStack.Push(ReadSignedFromExpression(FData, 4), lseValue);
DW_OP_const8s: FStack.Push(ReadSignedFromExpression(FData, 8), lseValue);
DW_OP_consts: FStack.Push(ReadSignedFromExpression(FData, 0), lseValue);
DW_OP_lit0..DW_OP_lit31: FStack.Push(p^-DW_OP_lit0, lseValue);
DW_OP_const1u: FStack.Push(ReadUnsignedFromExpression(CurData, 1), lseValue);
DW_OP_const2u: FStack.Push(ReadUnsignedFromExpression(CurData, 2), lseValue);
DW_OP_const4u: FStack.Push(ReadUnsignedFromExpression(CurData, 4), lseValue);
DW_OP_const8u: FStack.Push(ReadUnsignedFromExpression(CurData, 8), lseValue);
DW_OP_constu: FStack.Push(ReadUnsignedFromExpression(CurData, 0), lseValue);
DW_OP_const1s: FStack.Push(ReadSignedFromExpression(CurData, 1), lseValue);
DW_OP_const2s: FStack.Push(ReadSignedFromExpression(CurData, 2), lseValue);
DW_OP_const4s: FStack.Push(ReadSignedFromExpression(CurData, 4), lseValue);
DW_OP_const8s: FStack.Push(ReadSignedFromExpression(CurData, 8), lseValue);
DW_OP_consts: FStack.Push(ReadSignedFromExpression(CurData, 0), lseValue);
DW_OP_lit0..DW_OP_lit31: FStack.Push(CurInstr^-DW_OP_lit0, lseValue);
DW_OP_reg0..DW_OP_reg31: begin
if not MemManager.ReadRegister(p^-DW_OP_reg0, NewValue) then begin
if not MemManager.ReadRegister(CurInstr^-DW_OP_reg0, NewValue) then begin
SetError;
exit;
end;
FStack.Push(NewValue, lseRegister);
end;
DW_OP_regx: begin
if not MemManager.ReadRegister(ULEB128toOrdinal(FData), NewValue) then begin
if not MemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue) then begin
SetError;
exit;
end;
@ -4081,21 +4109,21 @@ begin
end;
DW_OP_breg0..DW_OP_breg31: begin
if not MemManager.ReadRegister(p^-DW_OP_breg0, NewValue) then begin
if not MemManager.ReadRegister(CurInstr^-DW_OP_breg0, NewValue) then begin
SetError;
exit;
end;
{$PUSH}{$R-}{$Q-}
FStack.Push(NewValue+SLEB128toOrdinal(FData), lseValue);
FStack.Push(NewValue+SLEB128toOrdinal(CurData), lseValue);
{$POP}
end;
DW_OP_bregx: begin
if not MemManager.ReadRegister(ULEB128toOrdinal(FData), NewValue) then begin
if not MemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue) then begin
SetError;
exit;
end;
{$PUSH}{$R-}{$Q-}
FStack.Push(NewValue+SLEB128toOrdinal(FData), lseValue);
FStack.Push(NewValue+SLEB128toOrdinal(CurData), lseValue);
{$POP}
end;
@ -4106,7 +4134,7 @@ begin
exit;
end;
{$PUSH}{$R-}{$Q-}
FStack.Push(FFrameBase+SLEB128toOrdinal(FData), lseValue);
FStack.Push(FFrameBase+SLEB128toOrdinal(CurData), lseValue);
{$POP}
end;
@ -4123,7 +4151,7 @@ begin
FStack.Push(FStack.Peek(1));
end;
DW_OP_pick: begin
i := ReadUnsignedFromExpression(FData, 1);
i := ReadUnsignedFromExpression(CurData, 1);
if not AssertMinCount(i) then exit;
FStack.Push(FStack.Peek(i));
end;
@ -4164,7 +4192,7 @@ begin
if not AssertMinCount(1) then exit;
Entry := FStack.Peek(0);
{$PUSH}{$R-}{$Q-}
FStack.Modify(0, Entry.Value.Address+ULEB128toOrdinal(FData), lseValue);
FStack.Modify(0, Entry.Value.Address+ULEB128toOrdinal(CurData), lseValue);
{$POP}
end;
DW_OP_minus: begin
@ -4244,15 +4272,15 @@ begin
end;
DW_OP_skip: begin
x := ReadSignedFromExpression(FData, 2);
FData := FData + x;
x := ReadSignedFromExpression(CurData, 2);
CurData := CurData + x;
end;
DW_OP_bra: begin
if not AssertMinCount(1) then exit;
Entry := FStack.Pop;
x := ReadSignedFromExpression(FData, 2);
x := ReadSignedFromExpression(CurData, 2);
if Entry.Value.Address <> 0 then
FData := FData + x;
CurData := CurData + x;
end;
DW_OP_eq: begin
@ -4322,7 +4350,7 @@ begin
*)
else
begin
debugln(['TDwarfLocationExpression.Evaluate UNKNOWN ', p^]);
debugln(FPDBG_DWARF_ERRORS, ['TDwarfLocationExpression.Evaluate UNKNOWN ', CurInstr^]);
SetError;
exit;
end;
@ -4847,7 +4875,7 @@ begin
AValue := FCompUnit.FOwner.FSections[dsInfo].RawData + Offs;
end
else begin
DebugLn(FPDBG_DWARF_WARNINGS, ['FORM for DW_AT_type not expected ', DwarfAttributeFormToString(Form)]);
DebugLn(FPDBG_DWARF_VERBOSE, ['FORM for DW_AT_type not expected ', DwarfAttributeFormToString(Form)]);
end;
end;
@ -5928,7 +5956,7 @@ begin
end;
debugln(['TDbgDwarfIdentifierMember.InitLocationParser FAILED !!!!!!!']);
debugln([FPDBG_DWARF_ERRORS, 'TDbgDwarfIdentifierMember.InitLocationParser FAILED !!!!!!!']);
//TODO: error
end;
@ -6008,7 +6036,7 @@ begin
end;
//TODO: error
debugln(['TDbgDwarfIdentifierMember.InitLocationParser FAILED']);
debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfIdentifierMember.InitLocationParser FAILED']);
end;
function TDbgDwarfIdentifierStructure.GetDataAddress(var AnAddress: TFpDbgMemLocation;
@ -6448,6 +6476,9 @@ begin
InitLocationParser(LocationParser, AnObjectDataAddress);
LocationParser.Evaluate;
if IsFpError(LocationParser.FLastError) then
SetLastError(LocationParser.FLastError);
if LocationParser.ResultKind in [lseValue] then begin
AnAddress := TargetLoc(LocationParser.ResultData);
Result := True;
@ -6749,6 +6780,9 @@ begin
FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), FCU);
FFrameBaseParser.Evaluate;
if IsFpError(FFrameBaseParser.FLastError) then
SetLastError(FFrameBaseParser.FLastError);
if FFrameBaseParser.ResultKind in [lseValue] then
Result := FFrameBaseParser.ResultData;
end;
@ -6781,9 +6815,12 @@ function TDbgDwarfProcSymbol.GetSelfParameter(AnAddress: TDbgPtr): TDbgDwarfValu
const
this1: string = 'THIS';
this2: string = 'this';
self1: string = '$SELF';
self2: string = '$self';
var
InfoEntry: TDwarfInformationEntry;
tg: Cardinal;
found: Boolean;
begin
// special: search "self"
// Todo nested procs
@ -6796,7 +6833,12 @@ begin
tg := InfoEntry.AbbrevTag;
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
if InfoEntry.GoNamedChildEx(@this1[1], @this2[1]) then begin
found := InfoEntry.GoNamedChildEx(@this1[1], @this2[1]);
if not found then begin
InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
found := InfoEntry.GoNamedChildEx(@self1[1], @self2[1]);
end;
if found then begin
if ((AnAddress = 0) or InfoEntry.IsAddressInStartScope(AnAddress)) and
InfoEntry.IsArtificial
then begin
@ -8226,7 +8268,8 @@ begin
// TODO: only valid, as long as context is valid, because if comnext is freed, then self is lost too
Result := SelfParam.MemberByName[AName];
assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
Result.AddReference;
if Result <> nil then
Result.AddReference;
if Result= nil then debugln(['TDbgDwarfInfoAddressContext.FindSymbol NOT IN SELF !!!!!!!!!!!!!']);
end;
end;
@ -8262,7 +8305,8 @@ begin
// TODO: only valid, as long as context is valid, because if comnext is freed, then self is lost too
Result := SelfParam.MemberByName[AName];
assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
Result.AddReference;
if Result <> nil then
Result.AddReference;
if Result<> nil then debugln(['TDbgDwarfInfoAddressContext.FindSymbol NOT IN SELF !!!!!!!!!!!!!']);
end
else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
@ -9438,9 +9482,12 @@ begin
end;
initialization
FPDBG_DWARF_ERRORS := DebugLogger.RegisterLogGroup('FPDBG_DWARF_ERRORS' {$IFDEF FPDBG_DWARF_ERRORS} , True {$ENDIF} );
FPDBG_DWARF_WARNINGS := DebugLogger.RegisterLogGroup('FPDBG_DWARF_WARNINGS' {$IFDEF FPDBG_DWARF_WARNINGS} , True {$ENDIF} );
FPDBG_DWARF_VERBOSE := DebugLogger.RegisterLogGroup('FPDBG_DWARF_VERBOSE' {$IFDEF FPDBG_DWARF_VERBOSE} , True {$ENDIF} );
FPDBG_DWARF_SEARCH := DebugLogger.RegisterLogGroup('FPDBG_DWARF_SEARCH' {$IFDEF FPDBG_DWARF_SEARCH} , True {$ENDIF} );
// Target data anormalities
FPDBG_DWARF_DATA_WARNINGS := DebugLogger.RegisterLogGroup('FPDBG_DWARF_DATA_WARNINGS' {$IFDEF FPDBG_DWARF_DATA_WARNINGS} , True {$ENDIF} );
end.

56
components/fpdebug/fpdbginfo.pas
View File

@ -5,7 +5,8 @@ unit FpDbgInfo;
interface
uses
Classes, SysUtils, DbgIntfBaseTypes, FpDbgLoader, FpdMemoryTools, LazLoggerBase, LazClasses;
Classes, SysUtils, DbgIntfBaseTypes, FpDbgLoader, FpdMemoryTools, FpErrorMessages,
LazLoggerBase, LazClasses;
type
{ TFpDbgCircularRefCountedObject }
@ -29,7 +30,7 @@ type
procedure MakeCirclularRefToPlain;
function CircleBackRefsActive: Boolean; inline;
procedure CircleBackRefActiveChanged(NewActive: Boolean); virtual;
procedure CircleBackRefActiveChanged({%H-}NewActive: Boolean); virtual;
end;
{ TFpDbgCircularRefCntObjList }
@ -113,17 +114,19 @@ type
function GetDataAddress: TFpDbgMemLocation; virtual;
function GetDataSize: Integer; virtual;
function GetMember(AIndex: Integer): TDbgSymbolValue; virtual;
function GetMemberByName(AIndex: String): TDbgSymbolValue; virtual;
function GetMember({%H-}AIndex: Integer): TDbgSymbolValue; virtual;
function GetMemberByName({%H-}AIndex: String): TDbgSymbolValue; virtual;
function GetMemberCount: Integer; virtual;
function GetIndexType(AIndex: Integer): TDbgSymbol; virtual;
function GetIndexType({%H-}AIndex: Integer): TDbgSymbol; virtual;
function GetIndexTypeCount: Integer; virtual;
function GetMemberCountEx(AIndex: array of Int64): Integer; virtual;
function GetMemberEx(AIndex: Array of Int64): TDbgSymbolValue; virtual;
function GetMemberCountEx({%H-}AIndex: array of Int64): Integer; virtual;
function GetMemberEx({%H-}AIndex: Array of Int64): TDbgSymbolValue; virtual;
function GetDbgSymbol: TDbgSymbol; virtual;
function GetTypeInfo: TDbgSymbol; virtual;
function GetContextTypeInfo: TDbgSymbol; virtual;
function GetLastError: TFpError; virtual;
public
constructor Create;
property RefCount;
@ -172,7 +175,9 @@ type
Maybe a stType, then there is no Value *)
property DbgSymbol: TDbgSymbol read GetDbgSymbol;
property TypeInfo: TDbgSymbol read GetTypeInfo;
property ContextTypeInfo: TDbgSymbol read GetContextTypeInfo; // For members, the class in which this mebec is declared
property ContextTypeInfo: TDbgSymbol read GetContextTypeInfo; // For members, the class in which this meber is declared
property LastError: TFpError read GetLastError;
end;
{ TSymbolValueConstNumber }
@ -211,6 +216,7 @@ type
TDbgSymbol = class(TDbgSymbolBase)
private
FEvaluatedFields: TDbgSymbolFields;
FLastError: TFpError;
// Cached fields
FName: String;
@ -229,6 +235,8 @@ type
function GetTypeInfo: TDbgSymbol; inline;
function GetMemberVisibility: TDbgSymbolMemberVisibility; inline;
protected
function GetLastError: TFpError; virtual;
procedure SetLastError(AnError: TFpError);
// NOT cached fields
function GetChild({%H-}AIndex: Integer): TDbgSymbol; virtual;
function GetColumn: Cardinal; virtual;
@ -323,7 +331,9 @@ type
// TypeCastValue| only fon stType symbols, may return nil
// Returns a reference to caller / caller must release
function TypeCastValue(AValue: TDbgSymbolValue): TDbgSymbolValue; virtual;
function TypeCastValue({%H-}AValue: TDbgSymbolValue): TDbgSymbolValue; virtual;
property LastError: TFpError read GetLastError;
end;
{ TDbgSymbolForwarder }
@ -336,6 +346,7 @@ type
procedure ForwardToSymbolNeeded; virtual;
function GetForwardToSymbol: TDbgSymbol; inline;
protected
function GetLastError: TFpError; override;
procedure KindNeeded; override;
procedure NameNeeded; override;
procedure SymbolTypeNeeded; override;
@ -564,6 +575,11 @@ begin
Result := nil;
end;
function TDbgSymbolValue.GetLastError: TFpError;
begin
Result := FpErrorNone;
end;
function TDbgSymbolValue.GetKind: TDbgSymbolKind;
begin
Result := skNone;
@ -759,6 +775,16 @@ begin
Result := FSymbolType;
end;
function TDbgSymbol.GetLastError: TFpError;
begin
Result := FLastError;
end;
procedure TDbgSymbol.SetLastError(AnError: TFpError);
begin
FLastError := AnError;
end;
function TDbgSymbol.GetHasBounds: Boolean;
begin
Result := False;
@ -942,6 +968,18 @@ begin
Result := FForwardToSymbol;
end;
function TDbgSymbolForwarder.GetLastError: TFpError;
var
p: TDbgSymbol;
begin
Result := inherited GetLastError;
if IsFpError(Result) then
exit;
p := GetForwardToSymbol;
if p <> nil then
Result := p.LastError;
end;
procedure TDbgSymbolForwarder.KindNeeded;
var
p: TDbgSymbol;

44
components/fpdebug/fpdmemorytools.pas
View File

@ -24,7 +24,7 @@ unit FpdMemoryTools;
interface
uses
Classes, SysUtils, math, DbgIntfBaseTypes;
Classes, SysUtils, math, DbgIntfBaseTypes, FpErrorMessages;
type
@ -182,6 +182,7 @@ type
TFpDbgMemManager = class
private
FLastError: TFpError;
FMemReader: TFpDbgMemReaderBase;
FTargetMemConvertor: TFpDbgMemConvertor;
FSelfMemConvertor: TFpDbgMemConvertor; // used when resizing constants (or register values, which are already in self format)
@ -192,6 +193,7 @@ type
public
constructor Create(AMemReader: TFpDbgMemReaderBase; AMemConvertor: TFpDbgMemConvertor);
constructor Create(AMemReader: TFpDbgMemReaderBase; ATargenMemConvertor, ASelfMemConvertor: TFpDbgMemConvertor);
procedure ClearLastError;
function ReadMemory(const ALocation: TFpDbgMemLocation; ASize: Cardinal; ADest: Pointer): Boolean;
function ReadMemoryEx(const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
@ -236,6 +238,7 @@ type
property TargetMemConvertor: TFpDbgMemConvertor read FTargetMemConvertor;
property SelfMemConvertor: TFpDbgMemConvertor read FSelfMemConvertor;
property LastError: TFpError read FLastError;
end;
function NilLoc: TFpDbgMemLocation; inline;
@ -486,20 +489,29 @@ var
TmpVal: TDbgPtr;
ConvData: TFpDbgMemConvData;
begin
FLastError := FpErrorNone;
Result := False;
case ALocation.MType of
mlfInvalid: ;
mlfInvalid:
FLastError := CreateError(fpErrCanNotReadInvalidMem);
mlfTargetMem, mlfSelfMem: begin
Result := TargetMemConvertor.PrepareTargetRead(AReadDataType, ALocation.Address,
ADest, ATargetSize, ADestSize, ConvData);
if not Result then exit;
if ALocation.MType = mlfTargetMem then
Result := FMemReader.ReadMemory(ConvData.NewTargetAddress, ConvData.NewReadSize, ConvData.NewDestAddress)
if ALocation.MType = mlfTargetMem then begin
Result := FMemReader.ReadMemory(ConvData.NewTargetAddress, ConvData.NewReadSize, ConvData.NewDestAddress);
if not Result then
FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ALocation.Address]);
end
else
begin
move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize);
Result := True;
try
move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize);
Result := True;
except
Result := False;
end;
end;
if Result then
@ -541,6 +553,8 @@ begin
Result := True;
end;
end;
if (not Result) and (not IsFpError(FLastError)) then
FLastError := CreateError(fpErrFailedReadMem);
end;
constructor TFpDbgMemManager.Create(AMemReader: TFpDbgMemReaderBase;
@ -559,6 +573,11 @@ begin
FSelfMemConvertor := ASelfMemConvertor;
end;
procedure TFpDbgMemManager.ClearLastError;
begin
FLastError := FpErrorNone;
end;
function TFpDbgMemManager.ReadMemory(const ALocation: TFpDbgMemLocation; ASize: Cardinal;
ADest: Pointer): Boolean;
var
@ -567,11 +586,16 @@ var
TmpVal: TDbgPtr;
ConvData: TFpDbgMemConvData;
begin
FLastError := FpErrorNone;
Result := False;
case ALocation.MType of
mlfInvalid: ;
mlfTargetMem:
Result := FMemReader.ReadMemory(ALocation.Address, ASize, ADest);
begin
Result := FMemReader.ReadMemory(ALocation.Address, ASize, ADest);
if not Result then
FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ALocation.Address]);
end;
mlfSelfMem:
begin
move(Pointer(ALocation.Address)^, ADest^, ASize);
@ -608,21 +632,27 @@ begin
Result := True;
end;
end;
if (not Result) and (not IsFpError(FLastError)) then
FLastError := CreateError(fpErrFailedReadMem);
end;
function TFpDbgMemManager.ReadMemoryEx(const ALocation: TFpDbgMemLocation;
AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
begin
FLastError := FpErrorNone;
// AnAddressSpace is ignored, when not actually reading from target address
case ALocation.MType of
mlfTargetMem: Result := FMemReader.ReadMemoryEx(ALocation.Address, AnAddressSpace, ASize, ADest);
else
Result := ReadMemory(ALocation, ASize, ADest);
end;
if (not Result) and (not IsFpError(FLastError)) then
FLastError := CreateError(fpErrFailedReadMem);
end;
function TFpDbgMemManager.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr): Boolean;
begin
FLastError := FpErrorNone;
Result := FMemReader.ReadRegister(ARegNum, AValue);
end;

127
components/fpdebug/fperrormessages.pas
View File

@ -12,25 +12,44 @@ type
resourcestring
// %0:s is always linebreak
MsgfpErrAnyError = '%1:s';
MsgfpErrSymbolNotFound = 'Identifier not found: "%1:s"';
MsgfpErrAnyError = '%1:s';
MsgfpErrSymbolNotFound = 'Identifier not found: "%1:s"';
MsgfpErrNoMemberWithName = 'Member not found: %1:s';
// 100 memreader error
MsgfpErrfpErrFailedReadMem = 'Failed to read data from target mem';
MsgfpErrCanNotReadInvalidMem = 'Failed to read data from invalid location';
MsgfpErrCanNotReadMemAtAddr = 'Failed to read Mem at Address %1:u';
// 200 LocationParser
MsgfpErrLocationParser = 'Internal Error: Can not calculate location.';
MsgfpErrLocationParserMemRead = '%1:s (while calculating location)'; // Pass on nested error
MsgfpErrLocationParserMinStack = 'Not enough elements on stack.'; // internally used
MsgfpErrLocationParserNoAddressOnStack = 'Not an address on stack'; // internally used
const
fpErrNoError = TFpErrorCode(0); // not an error
fpErrAnyError = TFpErrorCode(1);
fpErrSymbolNotFound = TFpErrorCode(2);
fpErrSymbolNotFound = TFpErrorCode(2);
fpErrNoMemberWithName = TFpErrorCode(3);
// 100 memreader error
fpErrFailedReadMem = TFpErrorCode(100);
fpErrCanNotReadInvalidMem = TFpErrorCode(101);
fpErrCanNotReadMemAtAddr = TFpErrorCode(102);
// 200 LocationParser
fpErrLocationParser = TFpErrorCode(200);
fpErrLocationParserMemRead = TFpErrorCode(201);
fpErrLocationParserMinStack = TFpErrorCode(202);
fpErrLocationParserNoAddressOnStack = TFpErrorCode(203);
type
TFpError = record
TFpError = array of record
ErrorCode: TFpErrorCode;
ErrorData: Array of TVarRec;
ErrorData2: Array of String;
end;
{ TErrorHandler }
{ TFpErrorHandler }
TFpErrorHandler = class
@ -48,8 +67,12 @@ procedure SetFpErrorHandler(AHandler: TFpErrorHandler);
property FpErrorHandler: TFpErrorHandler read GetFpErrorHandler write SetFpErrorHandler;
function IsFpError(AnError: TFpError): Boolean;
function FpErrorNone: TFpError;
function IsFpError(AnError: TFpError): Boolean; inline;
function FpErrorCode(AnError: TFpError): TFpErrorCode; inline;
function FpErrorNone: TFpError; inline;
function CreateError(AnErrorCode: TFpErrorCode): TFpError; inline;
function CreateError(AnErrorCode: TFpErrorCode; AData: array of const): TFpError; inline;
function CreateError(AnErrorCode: TFpErrorCode; AnError: TFpError; AData: array of const): TFpError; inline;
implementation
@ -70,12 +93,36 @@ end;
function IsFpError(AnError: TFpError): Boolean;
begin
Result := AnError.ErrorCode <> 0;
Result := (length(AnError) > 0) and (AnError[0].ErrorCode <> 0);
end;
function FpErrorCode(AnError: TFpError): TFpErrorCode;
begin
if length(AnError) > 0 then
Result := AnError[0].ErrorCode
else
Result := fpErrNoError; // 0
end;
function FpErrorNone: TFpError;
begin
Result.ErrorCode := 0;
Result:= nil;
end;
function CreateError(AnErrorCode: TFpErrorCode): TFpError;
begin
Result := FpErrorHandler.CreateError(AnErrorCode, []);
end;
function CreateError(AnErrorCode: TFpErrorCode; AData: array of const): TFpError;
begin
Result := FpErrorHandler.CreateError(AnErrorCode, AData);
end;
function CreateError(AnErrorCode: TFpErrorCode; AnError: TFpError;
AData: array of const): TFpError;
begin
Result := FpErrorHandler.CreateError(AnErrorCode, AnError, AData);
end;
{ TFpErrorHandler }
@ -86,6 +133,15 @@ begin
fpErrAnyError: Result := MsgfpErrAnyError;
fpErrSymbolNotFound: Result := MsgfpErrSymbolNotFound;
fpErrNoMemberWithName: Result := MsgfpErrNoMemberWithName;
fpErrCanNotReadInvalidMem: Result := MsgfpErrCanNotReadInvalidMem;
fpErrCanNotReadMemAtAddr: Result := MsgfpErrCanNotReadMemAtAddr;
fpErrFailedReadMem: Result := MsgfpErrfpErrFailedReadMem;
fpErrLocationParser: Result := MsgfpErrLocationParser;
fpErrLocationParserMemRead: Result := MsgfpErrLocationParserMemRead;
fpErrLocationParserMinStack: Result := MsgfpErrLocationParserMinStack;
fpErrLocationParserNoAddressOnStack: Result := MsgfpErrLocationParserNoAddressOnStack;
end;
end;
@ -94,14 +150,15 @@ function TFpErrorHandler.CreateError(AnErrorCode: TFpErrorCode;
var
i: Integer;
begin
Result.ErrorCode := AnErrorCode;
SetLength(Result.ErrorData, Length(AData));
SetLength(Result.ErrorData2, Length(AData));
SetLength(Result, 1);
Result[0].ErrorCode := AnErrorCode;
SetLength(Result[0].ErrorData, Length(AData));
SetLength(Result[0].ErrorData2, Length(AData));
for i := low(AData) to high(AData) do begin
Result.ErrorData[i] := AData[i];
Result[0].ErrorData[i] := AData[i];
if AData[i].VType = vtAnsiString then begin
Result.ErrorData2[i] := AnsiString(AData[i].VAnsiString);
Result.ErrorData[i].VAnsiString := Pointer(Result.ErrorData2[i]);
Result[0].ErrorData2[i] := AnsiString(AData[i].VAnsiString);
Result[0].ErrorData[i].VAnsiString := Pointer(Result[0].ErrorData2[i]);
end;
end;
end;
@ -111,29 +168,31 @@ function TFpErrorHandler.CreateError(AnErrorCode: TFpErrorCode; AnError: TFpErro
var
i, j: Integer;
begin
Result.ErrorCode := AnErrorCode;
j := Length(AnError.ErrorData);
SetLength(Result.ErrorData, Length(AData) + j);
SetLength(Result.ErrorData2, Length(AData) + j);
for i := 0 to j - 1 do begin
Result.ErrorData2[i] := AnError.ErrorData2[i];
Result.ErrorData[i] := AnError.ErrorData[i];
end;
for i := low(AData) to high(AData) do begin
Result.ErrorData[j+i] := AData[i];
if AData[i].VType = vtAnsiString then begin
Result.ErrorData2[j+i] := AnsiString(AData[i].VAnsiString);
Result.ErrorData[j+i].VAnsiString := Pointer(Result.ErrorData2[j+i]);
end;
end;
Result := CreateError(AnErrorCode, AData);
SetLength(Result, Length(AnError) + 1);
for i := 0 to Length(AnError) - 1 do
Result[i+1] := AnError[i];
end;
function TFpErrorHandler.ErrorAsString(AnError: TFpError): string;
var
RealData: Array of TVarRec;
i: Integer;
i, l: Integer;
s: String;
begin
Result := ErrorAsString(AnError.ErrorCode, AnError.ErrorData);
i := Length(AnError) - 1;
Result := '';
while i >= 0 do begin
RealData := AnError[i].ErrorData;
l := Length(RealData);
SetLength(RealData, l + 1);
s := Result;
UniqueString(s);
RealData[l].VAnsiString := pointer(s);
// to do : Errorcode may be mapped, if required by outer error
Result := ErrorAsString(AnError[i].ErrorCode, RealData);
dec(i);
end;
end;
function TFpErrorHandler.ErrorAsString(AnErrorCode: TFpErrorCode;
@ -144,7 +203,7 @@ var
s: String;
begin
Result := '';
if AnErrorCode = 0 then exit;
if AnErrorCode = fpErrNoError then exit;
SetLength(RealData, Length(AData) + 1);
s := LineEnding;
RealData[0].VAnsiString := Pointer(s); // first arg is always line end

8
components/fpdebug/fppascalbuilder.pas
View File

@ -5,7 +5,8 @@ unit FpPascalBuilder;
interface
uses
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, LazLoggerBase;
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, FpErrorMessages,
LazLoggerBase;
type
TTypeNameFlag = (
@ -408,8 +409,6 @@ function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
procedure DoPointer;
var
s: String;
t: TDbgSymbol;
i: Integer;
v: QWord;
begin
s := ResTypeName;
@ -611,6 +610,9 @@ begin
skArray: DoArray;
end;
if IsFpError(AResValue.LastError) then
APrintedValue := FpErrorHandler.ErrorAsString(AResValue.LastError) + ' ' + APrintedValue;
end;

4
components/fpdebug/fppascalparser.pas
View File

@ -1357,7 +1357,7 @@ end;
procedure TFpPascalExpression.SetError(AMsg: String);
begin
if FError.ErrorCode <> 0 then begin
if IsFpError(FError) then begin
DebugLn(['Skipping error ', AMsg]);
FValid := False;
exit;
@ -1404,7 +1404,7 @@ end;
function TFpPascalExpression.DebugDump(AWithResults: Boolean): String;
begin
Result := 'TFpPascalExpression: ' + FTextExpression + LineEnding +
'Valid: ' + dbgs(FValid) + ' Error: "' + dbgs(FError.ErrorCode) + '"'+ LineEnding
'Valid: ' + dbgs(FValid) + ' Error: "' + dbgs(FpErrorCode(FError)) + '"'+ LineEnding
;
if FExpressionPart <> nil then
Result := Result + FExpressionPart.DebugDump(' ', AWithResults);

6
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

@ -943,7 +943,7 @@ begin
ResTypeInfo := nil;
if not FpDebugger.EvaluateExpression(WatchValue, WatchValue.Expression, ResText, ResTypeInfo)
then begin
debugln(['TFPGDBMIWatches.InternalRequestData FAILED']);
if IsWatchValueAlive then debugln(['TFPGDBMIWatches.InternalRequestData FAILED ', WatchValue.Expression]);
if IsWatchValueAlive then
inherited InternalRequestData(WatchValue);
end;
@ -1506,7 +1506,7 @@ begin
if not PasExpr.Valid then begin
DebugLn(FpErrorHandler.ErrorAsString(PasExpr.Error));
if PasExpr.Error.ErrorCode <> fpErrAnyError then begin
if FpErrorCode(PasExpr.Error) <> fpErrAnyError then begin
Result := True;
AResText := FpErrorHandler.ErrorAsString(PasExpr.Error);;
if AWatchValue <> nil then begin;
@ -1551,7 +1551,7 @@ DebugLn(FpErrorHandler.ErrorAsString(PasExpr.Error));
if ATypeInfo <> nil then begin
Result := True;
debugln(['TFPGDBMIWatches.InternalRequestData GOOOOOOD']);
debugln(['TFPGDBMIWatches.InternalRequestData GOOOOOOD ', AExpression]);
if AWatchValue <> nil then begin;
AWatchValue.Value := AResText;
AWatchValue.TypeInfo := ATypeInfo;