paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-08 14:35:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebugger (pure): Fix for showing exception-messages on Linux

Browse Source 
git-svn-id: trunk@45899 -
This commit is contained in:
joost 2014-07-17 17:37:10 +00:00
parent 54b39f97e9
commit 6ae20a6ef6
1 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -127,6 +127,7 @@ type
function AddBreak(const ALocation: TDbgPtr): FpDbgClasses.TDbgBreakpoint; overload;
function AddBreak(const AFileName: String; ALine: Cardinal): FpDbgClasses.TDbgBreakpoint; overload;
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean;
function ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean;
procedure PrepareCallStackEntryList;
property DebugInfo: TDbgInfo read GetDebugInfo;
@ -1115,8 +1116,8 @@ var
b: byte;
begin
// Read address of the vmt
FDbgController.CurrentProcess.ReadAddress(AnAddr, VMTAddr);
FDbgController.CurrentProcess.ReadAddress(VMTAddr+3*DBGPTRSIZE[FDbgController.CurrentProcess.Mode], ClassNameAddr);
ReadAddress(AnAddr, VMTAddr);
ReadAddress(VMTAddr+3*DBGPTRSIZE[FDbgController.CurrentProcess.Mode], ClassNameAddr);
// read classname (as shortstring)
ReadData(ClassNameAddr, 1, b);
setlength(result,b);
@ -1129,9 +1130,9 @@ var
len: TDBGPtr;
begin
result := '';
if not FDbgController.CurrentProcess.ReadAddress(AnAddr, StrAddr) then
if not ReadAddress(AnAddr, StrAddr) then
Exit;
FDbgController.CurrentProcess.ReadAddress(StrAddr-DBGPTRSIZE[FDbgController.CurrentProcess.Mode], len);
ReadAddress(StrAddr-DBGPTRSIZE[FDbgController.CurrentProcess.Mode], len);
setlength(result, len);
if not ReadData(StrAddr, len, result[1]) then
result := '';
@ -1477,6 +1478,25 @@ begin
{$endif linux}
end;
function TFpDebugDebugger.ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean;
var
dw: DWord;
qw: QWord;
begin
case FDbgController.CurrentProcess.Mode of
dm32:
begin
result := ReadData(AAdress, sizeof(dw), dw);
AData:=dw;
end;
dm64:
begin
result := ReadData(AAdress, sizeof(qw), qw);
AData:=qw;
end;
end;
end;
procedure TFpDebugDebugger.PrepareCallStackEntryList;
begin
{$ifdef linux}