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

LazDebugger, lldb: more except handling

Browse Source 
git-svn-id: trunk@58952 -
This commit is contained in:
martin 2018-09-11 12:07:08 +00:00
parent 39bce25a6e
commit abb4caa1b0
1 changed files with 33 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas
View File

@ -84,7 +84,7 @@ type
TLldbDebuggerCommandRun = class(TLldbDebuggerCommand) TLldbDebuggerCommandRun = class(TLldbDebuggerCommand)
private type private type
TExceptionInfoCommand = (exiReg0, exiReg1, exiClass, exiMsg); TExceptionInfoCommand = (exiReg0, exiReg2, exiClass, exiMsg);
TExceptionInfoCommands = set of TExceptionInfoCommand; TExceptionInfoCommands = set of TExceptionInfoCommand;
private private
FMode: (cmRun, cmRunToCatch, cmRunAfterCatch, cmRunToTmpBrk); FMode: (cmRun, cmRunToCatch, cmRunAfterCatch, cmRunToTmpBrk);
@ -101,7 +101,7 @@ type
FFramesDescending: Boolean; FFramesDescending: Boolean;
procedure ThreadInstructionSucceeded(Sender: TObject); procedure ThreadInstructionSucceeded(Sender: TObject);
procedure ExceptionReadReg0Success(Sender: TObject); procedure ExceptionReadReg0Success(Sender: TObject);
procedure ExceptionReadReg1Success(Sender: TObject); procedure ExceptionReadReg2Success(Sender: TObject);
procedure ExceptionReadClassSuccess(Sender: TObject); procedure ExceptionReadClassSuccess(Sender: TObject);
procedure ExceptionReadMsgSuccess(Sender: TObject); procedure ExceptionReadMsgSuccess(Sender: TObject);
procedure CatchesStackInstructionFinished(Sender: TObject); procedure CatchesStackInstructionFinished(Sender: TObject);
@ -238,7 +238,7 @@ type
FTargetRegisters: array[0..2] of String; FTargetRegisters: array[0..2] of String;
FLldbMissingBreakSetDisable: Boolean; FLldbMissingBreakSetDisable: Boolean;
FExceptionInfo: record FExceptionInfo: record
FReg0Cmd, FReg1Cmd, FExceptClassCmd, FExceptMsgCmd: String; FReg0Cmd, FReg2Cmd, FExceptClassCmd, FExceptMsgCmd: String;
FAtExcepiton: Boolean; // cleared in Setstate FAtExcepiton: Boolean; // cleared in Setstate
end; end;
(* DoAfterLineReceived is called after DebugInstruction.ProcessInputFromDbg (* DoAfterLineReceived is called after DebugInstruction.ProcessInputFromDbg
@ -607,21 +607,21 @@ begin
exit; exit;
end; end;
fr := 0; fr := 1;
repeat repeat
ParseNewFrameLocation(r[fr], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d); ParseNewFrameLocation(r[fr], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
Arguments.Free; Arguments.Free;
if frame = FCurrentExceptionInfo.FFramePtr then if frame = FCurrentExceptionInfo.FFramePtr then begin
SetDebuggerLocation(Addr, Frame, Func, filename, FullFile, Line);
break; break;
end;
inc(fr); inc(fr);
until fr >= Length(r); until fr >= Length(r);
if (fr < Length(r)) and (line > 0) then
SetDebuggerLocation(Addr, Frame, Func, filename, FullFile, Line);
SetDebuggerState(dsPause); SetDebuggerState(dsPause);
Debugger.DoCurrent(Debugger.FCurrentLocation);
Finished; Finished;
end; end;
@ -631,15 +631,29 @@ begin
end; end;
procedure TLldbDebuggerCommandRun.ExceptionReadReg0Success(Sender: TObject); procedure TLldbDebuggerCommandRun.ExceptionReadReg0Success(Sender: TObject);
var
v: String;
i: SizeInt;
begin begin
FCurrentExceptionInfo.FObjAddress := StrToInt64Def(TLldbInstructionReadExpression(Sender).Res, 0); v := TLldbInstructionReadExpression(Sender).Res;
i := pos(' = ', v);
if i > 1 then
delete(v, 1, i+2);
FCurrentExceptionInfo.FObjAddress := StrToInt64Def(v, 0);
Include(FCurrentExceptionInfo.FHasCommandData, exiReg0); Include(FCurrentExceptionInfo.FHasCommandData, exiReg0);
end; end;
procedure TLldbDebuggerCommandRun.ExceptionReadReg1Success(Sender: TObject); procedure TLldbDebuggerCommandRun.ExceptionReadReg2Success(Sender: TObject);
var
v: String;
i: SizeInt;
begin begin
FCurrentExceptionInfo.FFramePtr := StrToInt64Def(TLldbInstructionReadExpression(Sender).Res, 0); v := TLldbInstructionReadExpression(Sender).Res;
Include(FCurrentExceptionInfo.FHasCommandData, exiReg1); i := pos(' = ', v);
if i > 1 then
delete(v, 1, i+2);
FCurrentExceptionInfo.FFramePtr := StrToInt64Def(v, 0);
Include(FCurrentExceptionInfo.FHasCommandData, exiReg2);
end; end;
procedure TLldbDebuggerCommandRun.ExceptionReadClassSuccess(Sender: TObject); procedure TLldbDebuggerCommandRun.ExceptionReadClassSuccess(Sender: TObject);
@ -750,7 +764,8 @@ const
else begin else begin
Debugger.FExceptionInfo.FAtExcepiton := True; Debugger.FExceptionInfo.FAtExcepiton := True;
if (exiReg1 in FCurrentExceptionInfo.FHasCommandData) and (FCurrentExceptionInfo.FFramePtr <> 0) then begin if (exiReg2 in FCurrentExceptionInfo.FHasCommandData) and (FCurrentExceptionInfo.FFramePtr <> 0) then begin
FState := crRunning; // ensure command is not finished early
Instr := TLldbInstructionStackTrace.Create(MaxStackSearch, 0, Debugger.FCurrentThreadId); Instr := TLldbInstructionStackTrace.Create(MaxStackSearch, 0, Debugger.FCurrentThreadId);
Instr.OnFinish := @SearchExceptFpStackInstructionFinished; Instr.OnFinish := @SearchExceptFpStackInstructionFinished;
QueueInstruction(Instr); QueueInstruction(Instr);
@ -872,9 +887,9 @@ begin
Instr.OnSuccess := @ExceptionReadReg0Success; Instr.OnSuccess := @ExceptionReadReg0Success;
end end
else else
if StrStartsWith(s, Debugger.FExceptionInfo.FReg1Cmd, True) then begin if StrStartsWith(s, Debugger.FExceptionInfo.FReg2Cmd, True) then begin
Instr := TLldbInstructionReadExpression.Create; Instr := TLldbInstructionReadExpression.Create;
Instr.OnSuccess := @ExceptionReadReg1Success; Instr.OnSuccess := @ExceptionReadReg2Success;
end end
else else
if StrStartsWith(s, Debugger.FExceptionInfo.FExceptClassCmd, True) then begin if StrStartsWith(s, Debugger.FExceptionInfo.FExceptClassCmd, True) then begin
@ -2071,20 +2086,20 @@ begin
Debugger.FBreakErrorBreak.OnFinish := nil; Debugger.FBreakErrorBreak.OnFinish := nil;
Debugger.FExceptionInfo.FReg0Cmd := ''; Debugger.FExceptionInfo.FReg0Cmd := '';
Debugger.FExceptionInfo.FReg1Cmd := ''; Debugger.FExceptionInfo.FReg2Cmd := '';
Debugger.FExceptionInfo.FExceptClassCmd := ''; Debugger.FExceptionInfo.FExceptClassCmd := '';
Debugger.FExceptionInfo.FExceptMsgCmd := ''; Debugger.FExceptionInfo.FExceptMsgCmd := '';
BrkId := Debugger.FExceptionBreak.BreakId; BrkId := Debugger.FExceptionBreak.BreakId;
if BrkId > 0 then begin if BrkId > 0 then begin
Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0]; Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0];
Debugger.FExceptionInfo.FReg1Cmd := 'p/x ' + Debugger.FTargetRegisters[1]; Debugger.FExceptionInfo.FReg2Cmd := 'p/x ' + Debugger.FTargetRegisters[2];
Debugger.FExceptionInfo.FExceptClassCmd := 'p ((char ***)' + Debugger.FTargetRegisters[0] + ')[0][3]'; Debugger.FExceptionInfo.FExceptClassCmd := 'p ((char ***)' + Debugger.FTargetRegisters[0] + ')[0][3]';
Debugger.FExceptionInfo.FExceptMsgCmd := 'p ((char **)' + Debugger.FTargetRegisters[0] + ')[1]'; Debugger.FExceptionInfo.FExceptMsgCmd := 'p ((char **)' + Debugger.FTargetRegisters[0] + ')[1]';
// 'p ((EXCEPTION *)' + Debugger.FTargetRegisters[0] + ')->FMESSAGE' // 'p ((EXCEPTION *)' + Debugger.FTargetRegisters[0] + ')->FMESSAGE'
Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [ Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [
Debugger.FExceptionInfo.FReg0Cmd, Debugger.FExceptionInfo.FExceptClassCmd, Debugger.FExceptionInfo.FExceptMsgCmd Debugger.FExceptionInfo.FReg0Cmd, Debugger.FExceptionInfo.FReg2Cmd, Debugger.FExceptionInfo.FExceptClassCmd, Debugger.FExceptionInfo.FExceptMsgCmd
]); ]);
QueueInstruction(Instr); QueueInstruction(Instr);
Instr.ReleaseReference; Instr.ReleaseReference;