paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-04 19:40:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazDebuggerFp (pure): Exception handling. (no software exceptions)

Browse Source 
git-svn-id: trunk@44970 -
This commit is contained in:
joost 2014-05-07 18:32:50 +00:00
parent 975e523a89
commit f25dee1d51
5 changed files with 65 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/fpdebug/app/fpd/fpdloop.pas
View File

@ -49,6 +49,7 @@ type
FLast: string;
procedure ShowDisas;
procedure ShowCode;
procedure GControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string);
procedure GControllerCreateProcessEvent(var continue: boolean);
procedure GControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TDbgBreakpoint);
protected
@ -66,6 +67,22 @@ uses
{ TFPDLoop }
procedure TFPDLoop.GControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string);
begin
if not continue then
begin
ShowCode;
ShowDisas;
end;
if ExceptionMessage<>'' then
begin
writeln('Program raised exception class '''+ExceptionClass+'''. Exception message:');
writeln(ExceptionMessage);
end
else
writeln('Program raised exception class '''+ExceptionClass+'''.');
end;
procedure TFPDLoop.ShowDisas;
var
a: TDbgPtr;
@ -199,6 +216,7 @@ begin
inherited Initialize;
GController.OnHitBreakpointEvent:=@GControllerHitBreakpointEvent;
GController.OnCreateProcessEvent:=@GControllerCreateProcessEvent;
GController.OnExceptionEvent:=@GControllerExceptionEvent;
end;
initialization

6
components/fpdebug/fpdbgclasses.pp
View File

@ -234,6 +234,8 @@ type
TDbgProcess = class(TDbgInstance)
private
FExceptionClass: string;
FExceptionMessage: string;
FExitCode: DWord;
FOnLog: TOnLog;
FProcessID: Integer;
@ -304,6 +306,10 @@ type
property CurrentBreakpoint: TDbgBreakpoint read FCurrentBreakpoint;
property RunToBreakpoint: TDbgBreakpoint read FRunToBreakpoint;
// Properties valid when last event was an deException
property ExceptionMessage: string read FExceptionMessage write FExceptionMessage;
property ExceptionClass: string read FExceptionClass write FExceptionClass;
property LastEventProcessIdentifier: THandle read GetLastEventProcessIdentifier;
property OnLog: TOnLog read FOnLog write FOnLog;
property MainThread: TDbgThread read FMainThread;

4
components/fpdebug/fpdbgcontroller.pas
View File

@ -16,7 +16,7 @@ type
TOnCreateProcessEvent = procedure(var continue: boolean) of object;
TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TDbgBreakpoint) of object;
TOnExceptionEvent = procedure(var continue: boolean) of object;
TOnExceptionEvent = procedure(var continue: boolean; const ExceptionClass, ExceptionMessage: string) of object;
TOnProcessExitEvent = procedure(ExitCode: DWord) of object;
{ TDbgController }
@ -306,7 +306,7 @@ begin
debugln('Exception');
continue:=false;
if assigned(OnExceptionEvent) then
OnExceptionEvent(continue);
OnExceptionEvent(continue, FCurrentProcess.ExceptionClass, FCurrentProcess.ExceptionMessage );
end;
deLoadLibrary:
begin

69
components/fpdebug/fpdbgwinclasses.pas
View File

@ -472,30 +472,31 @@ function TDbgWinProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
// in both 32 and 64 case is the exceptioncode the first, so no difference
case AEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_ACCESS_VIOLATION : DebugLn('ACCESS_VIOLATION');
EXCEPTION_ARRAY_BOUNDS_EXCEEDED : DebugLn('ARRAY_BOUNDS_EXCEEDED');
EXCEPTION_BREAKPOINT : DebugLn('BREAKPOINT');
EXCEPTION_DATATYPE_MISALIGNMENT : DebugLn('DATATYPE_MISALIGNMENT');
EXCEPTION_FLT_DENORMAL_OPERAND : DebugLn('FLT_DENORMAL_OPERAND');
EXCEPTION_FLT_DIVIDE_BY_ZERO : DebugLn('FLT_DIVIDE_BY_ZERO');
EXCEPTION_FLT_INEXACT_RESULT : DebugLn('FLT_INEXACT_RESULT');
EXCEPTION_FLT_INVALID_OPERATION : DebugLn('FLT_INVALID_OPERATION');
EXCEPTION_FLT_OVERFLOW : DebugLn('FLT_OVERFLOW');
EXCEPTION_FLT_STACK_CHECK : DebugLn('FLT_STACK_CHECK');
EXCEPTION_FLT_UNDERFLOW : DebugLn('FLT_UNDERFLOW');
EXCEPTION_ILLEGAL_INSTRUCTION : DebugLn('ILLEGAL_INSTRUCTION');
EXCEPTION_IN_PAGE_ERROR : DebugLn('IN_PAGE_ERROR');
EXCEPTION_INT_DIVIDE_BY_ZERO : DebugLn('INT_DIVIDE_BY_ZERO');
EXCEPTION_INT_OVERFLOW : DebugLn('INT_OVERFLOW');
EXCEPTION_INVALID_DISPOSITION : DebugLn('INVALID_DISPOSITION');
EXCEPTION_INVALID_HANDLE : DebugLn('EXCEPTION_INVALID_HANDLE');
EXCEPTION_NONCONTINUABLE_EXCEPTION : DebugLn('NONCONTINUABLE_EXCEPTION');
EXCEPTION_POSSIBLE_DEADLOCK : DebugLn('EXCEPTION_POSSIBLE_DEADLOCK');
EXCEPTION_PRIV_INSTRUCTION : DebugLn('PRIV_INSTRUCTION');
EXCEPTION_SINGLE_STEP : DebugLn('SINGLE_STEP');
EXCEPTION_STACK_OVERFLOW : DebugLn('STACK_OVERFLOW');
EXCEPTION_ACCESS_VIOLATION : ExceptionClass:='ACCESS VIOLATION';
EXCEPTION_ARRAY_BOUNDS_EXCEEDED : ExceptionClass:='ARRAY BOUNDS EXCEEDED';
EXCEPTION_BREAKPOINT : ExceptionClass:='BREAKPOINT';
EXCEPTION_DATATYPE_MISALIGNMENT : ExceptionClass:='DATATYPE MISALIGNMENT';
EXCEPTION_FLT_DENORMAL_OPERAND : ExceptionClass:='FLT DENORMAL OPERAND';
EXCEPTION_FLT_DIVIDE_BY_ZERO : ExceptionClass:='FLT DIVIDE BY ZERO';
EXCEPTION_FLT_INEXACT_RESULT : ExceptionClass:='FLT INEXACT RESULT';
EXCEPTION_FLT_INVALID_OPERATION : ExceptionClass:='FLT INVALID OPERATION';
EXCEPTION_FLT_OVERFLOW : ExceptionClass:='FLT OVERFLOW';
EXCEPTION_FLT_STACK_CHECK : ExceptionClass:='FLT STACK CHECK';
EXCEPTION_FLT_UNDERFLOW : ExceptionClass:='FLT UNDERFLOW';
EXCEPTION_ILLEGAL_INSTRUCTION : ExceptionClass:='ILLEGAL INSTRUCTION';
EXCEPTION_IN_PAGE_ERROR : ExceptionClass:='IN PAGE ERROR';
EXCEPTION_INT_DIVIDE_BY_ZERO : ExceptionClass:='INT DIVIDE BY ZERO';
EXCEPTION_INT_OVERFLOW : ExceptionClass:='INT OVERFLOW';
EXCEPTION_INVALID_DISPOSITION : ExceptionClass:='INVALID DISPOSITION';
EXCEPTION_INVALID_HANDLE : ExceptionClass:='INVALID HANDLE';
EXCEPTION_NONCONTINUABLE_EXCEPTION : ExceptionClass:='NONCONTINUABLE EXCEPTION';
EXCEPTION_POSSIBLE_DEADLOCK : ExceptionClass:='POSSIBLE DEADLOCK';
EXCEPTION_PRIV_INSTRUCTION : ExceptionClass:='PRIV INSTRUCTION';
EXCEPTION_SINGLE_STEP : ExceptionClass:='SINGLE STEP';
EXCEPTION_STACK_OVERFLOW : ExceptionClass:='STACK OVERFLOW';
// add some status - don't know if we can get them here
{
DBG_EXCEPTION_NOT_HANDLED : DebugLn('DBG_EXCEPTION_NOT_HANDLED');
STATUS_GUARD_PAGE_VIOLATION : DebugLn('STATUS_GUARD_PAGE_VIOLATION');
STATUS_NO_MEMORY : DebugLn('STATUS_NO_MEMORY');
@ -505,8 +506,9 @@ function TDbgWinProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
STATUS_REG_NAT_CONSUMPTION : DebugLn('STATUS_REG_NAT_CONSUMPTION');
STATUS_SXS_EARLY_DEACTIVATION : DebugLn('STATUS_SXS_EARLY_DEACTIVATION');
STATUS_SXS_INVALID_DEACTIVATION : DebugLn('STATUS_SXS_INVALID_DEACTIVATION');
}
else
DebugLn(' Unknown code: $', IntToHex(ExInfo32.ExceptionRecord.ExceptionCode, 8));
ExceptionClass := 'Unknown exception code $' + IntToHex(ExInfo32.ExceptionRecord.ExceptionCode, 8);
DebugLn(' [');
case ExInfo32.ExceptionRecord.ExceptionCode and $C0000000 of
STATUS_SEVERITY_SUCCESS : DebugLn('SEVERITY_ERROR');
@ -536,6 +538,9 @@ function TDbgWinProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
DebugLn(' Code: $', IntToHex((ExInfo32.ExceptionRecord.ExceptionCode and $0000FFFF), 4));
end;
ExceptionClass:='External: '+ExceptionClass;
DebugLn(ExceptionClass);
ExceptionMessage:='';
if GMode = dm32
then Info0 := PtrUInt(ExInfo32.ExceptionRecord.ExceptionAddress)
else Info0 := PtrUInt(ExInfo64.ExceptionRecord.ExceptionAddress);
@ -564,19 +569,12 @@ function TDbgWinProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent;
Info1Str := FormatAddress(Info1);
case Info0 of
EXCEPTION_READ_FAULT: begin
DebugLn(' Read of address: ', Info1Str);
end;
EXCEPTION_WRITE_FAULT: begin
DebugLn(' Write of address: ', Info1Str);
end;
EXCEPTION_EXECUTE_FAULT: begin
DebugLn(' Execute of address: ', Info1Str);
end;
EXCEPTION_READ_FAULT: ExceptionMessage := 'Access violation reading from address ' + Info1Str +'.';
EXCEPTION_WRITE_FAULT: ExceptionMessage := 'Access violation writing to address ' + Info1Str +'.';
EXCEPTION_EXECUTE_FAULT: ExceptionMessage := 'Access violation executing address ' + Info1Str +'.';
end;
end;
end;
Debugln('');
DebugLn(' Info: ');
for n := 0 to EXCEPTION_MAXIMUM_PARAMETERS - 1 do
@ -813,7 +811,10 @@ begin
end
else begin
HandleException(MDebugEvent);
result := deException;
if MDebugEvent.Exception.dwFirstChance = 1 then
result := deInternalContinue
else
result := deException;
end;
end;
end;

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

@ -51,7 +51,7 @@ type
procedure FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint);
procedure FDbgControllerCreateProcessEvent(var continue: boolean);
procedure FDbgControllerProcessExitEvent(AExitCode: DWord);
procedure FDbgControllerExceptionEvent(var continue: boolean);
procedure FDbgControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string);
procedure FDbgControllerDebugInfoLoaded(Sender: TObject);
function GetDebugInfo: TDbgInfo;
protected
@ -753,9 +753,10 @@ begin
FreeDebugThread;
end;
procedure TFpDebugDebugger.FDbgControllerExceptionEvent(var continue: boolean);
procedure TFpDebugDebugger.FDbgControllerExceptionEvent(var continue: boolean;
const ExceptionClass, ExceptionMessage: string);
begin
DoException(deInternal, 'unknown', GetLocation, 'Unknown exception', continue);
DoException(deExternal, ExceptionClass, GetLocation, ExceptionMessage, continue);
if not continue then
begin
SetState(dsPause);