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

56
components/fpdebug/fpdbginfo.pas
View File

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

44
components/fpdebug/fpdmemorytools.pas
View File

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

127
components/fpdebug/fperrormessages.pas
View File

@ -12,25 +12,44 @@ type
resourcestring resourcestring
// %0:s is always linebreak // %0:s is always linebreak
MsgfpErrAnyError = '%1:s'; MsgfpErrAnyError = '%1:s';
MsgfpErrSymbolNotFound = 'Identifier not found: "%1:s"'; MsgfpErrSymbolNotFound = 'Identifier not found: "%1:s"';
MsgfpErrNoMemberWithName = 'Member 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 const
fpErrNoError = TFpErrorCode(0); // not an error
fpErrAnyError = TFpErrorCode(1); fpErrAnyError = TFpErrorCode(1);
fpErrSymbolNotFound = TFpErrorCode(2);
fpErrSymbolNotFound = TFpErrorCode(2);
fpErrNoMemberWithName = TFpErrorCode(3); 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 type
TFpError = record TFpError = array of record
ErrorCode: TFpErrorCode; ErrorCode: TFpErrorCode;
ErrorData: Array of TVarRec; ErrorData: Array of TVarRec;
ErrorData2: Array of String; ErrorData2: Array of String;
end; end;
{ TErrorHandler }
{ TFpErrorHandler } { TFpErrorHandler }
TFpErrorHandler = class TFpErrorHandler = class
@ -48,8 +67,12 @@ procedure SetFpErrorHandler(AHandler: TFpErrorHandler);
property FpErrorHandler: TFpErrorHandler read GetFpErrorHandler write SetFpErrorHandler; property FpErrorHandler: TFpErrorHandler read GetFpErrorHandler write SetFpErrorHandler;
function IsFpError(AnError: TFpError): Boolean; function IsFpError(AnError: TFpError): Boolean; inline;
function FpErrorNone: TFpError; 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 implementation
@ -70,12 +93,36 @@ end;
function IsFpError(AnError: TFpError): Boolean; function IsFpError(AnError: TFpError): Boolean;
begin 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; end;
function FpErrorNone: TFpError; function FpErrorNone: TFpError;
begin 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; end;
{ TFpErrorHandler } { TFpErrorHandler }
@ -86,6 +133,15 @@ begin
fpErrAnyError: Result := MsgfpErrAnyError; fpErrAnyError: Result := MsgfpErrAnyError;
fpErrSymbolNotFound: Result := MsgfpErrSymbolNotFound; fpErrSymbolNotFound: Result := MsgfpErrSymbolNotFound;
fpErrNoMemberWithName: Result := MsgfpErrNoMemberWithName; 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;
end; end;
@ -94,14 +150,15 @@ function TFpErrorHandler.CreateError(AnErrorCode: TFpErrorCode;
var var
i: Integer; i: Integer;
begin begin
Result.ErrorCode := AnErrorCode; SetLength(Result, 1);
SetLength(Result.ErrorData, Length(AData)); Result[0].ErrorCode := AnErrorCode;
SetLength(Result.ErrorData2, Length(AData)); SetLength(Result[0].ErrorData, Length(AData));
SetLength(Result[0].ErrorData2, Length(AData));
for i := low(AData) to high(AData) do begin 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 if AData[i].VType = vtAnsiString then begin
Result.ErrorData2[i] := AnsiString(AData[i].VAnsiString); Result[0].ErrorData2[i] := AnsiString(AData[i].VAnsiString);
Result.ErrorData[i].VAnsiString := Pointer(Result.ErrorData2[i]); Result[0].ErrorData[i].VAnsiString := Pointer(Result[0].ErrorData2[i]);
end; end;
end; end;
end; end;
@ -111,29 +168,31 @@ function TFpErrorHandler.CreateError(AnErrorCode: TFpErrorCode; AnError: TFpErro
var var
i, j: Integer; i, j: Integer;
begin begin
Result.ErrorCode := AnErrorCode; Result := CreateError(AnErrorCode, AData);
j := Length(AnError.ErrorData); SetLength(Result, Length(AnError) + 1);
SetLength(Result.ErrorData, Length(AData) + j); for i := 0 to Length(AnError) - 1 do
SetLength(Result.ErrorData2, Length(AData) + j); Result[i+1] := AnError[i];
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;
end; end;
function TFpErrorHandler.ErrorAsString(AnError: TFpError): string; function TFpErrorHandler.ErrorAsString(AnError: TFpError): string;
var var
RealData: Array of TVarRec; RealData: Array of TVarRec;
i: Integer; i, l: Integer;
s: String;
begin 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; end;
function TFpErrorHandler.ErrorAsString(AnErrorCode: TFpErrorCode; function TFpErrorHandler.ErrorAsString(AnErrorCode: TFpErrorCode;
@ -144,7 +203,7 @@ var
s: String; s: String;
begin begin
Result := ''; Result := '';
if AnErrorCode = 0 then exit; if AnErrorCode = fpErrNoError then exit;
SetLength(RealData, Length(AData) + 1); SetLength(RealData, Length(AData) + 1);
s := LineEnding; s := LineEnding;
RealData[0].VAnsiString := Pointer(s); // first arg is always line end 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 interface
uses uses
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, LazLoggerBase; Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, FpErrorMessages,
LazLoggerBase;
type type
TTypeNameFlag = ( TTypeNameFlag = (
@ -408,8 +409,6 @@ function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
procedure DoPointer; procedure DoPointer;
var var
s: String; s: String;
t: TDbgSymbol;
i: Integer;
v: QWord; v: QWord;
begin begin
s := ResTypeName; s := ResTypeName;
@ -611,6 +610,9 @@ begin
skArray: DoArray; skArray: DoArray;
end; end;
if IsFpError(AResValue.LastError) then
APrintedValue := FpErrorHandler.ErrorAsString(AResValue.LastError) + ' ' + APrintedValue;
end; end;

4
components/fpdebug/fppascalparser.pas
View File

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

6
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

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