LazDebuggerFp: improve errors for function calling

This commit is contained in:
Martin 2022-06-30 20:38:47 +02:00
parent f7b08ce6f7
commit 9e67808d84
6 changed files with 193 additions and 58 deletions

View File

@ -206,7 +206,7 @@ function TFpDbgInfoCallContext.AddRecordParam(var ParamSymbol: TFpValue;
Move(d, Data, sz);
end
else begin
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
FLastError := CreateError(fpErrAnyError, ['failed to read record data from memory']);
end;
end;
@ -334,11 +334,11 @@ begin
else begin
// 32bit linux
Result := False;
FLastError := CreateError(fpErrAnyError, ['not supported']);
FLastError := CreateError(fpErrAnyError, ['record as parm are not supported']);
end;
{$Else}
Result := False;
FLastError := CreateError(fpErrAnyError, ['not supported']);
FLastError := CreateError(fpErrAnyError, ['record as param are not supported']);
{$ENDIF}
end;
@ -351,8 +351,9 @@ begin
ParamSymbol := InternalCreateParamSymbol(FNextParamRegister, RefSym, '');
try
Result := ParamSymbol <> nil;
if not Result then
if not Result then begin
exit;
end;
ParamSymbol.AsCardinal := FStringResultMem;
Result := not IsError(ParamSymbol.LastError);
FLastError := ParamSymbol.LastError;
@ -387,13 +388,14 @@ function TFpDbgInfoCallContext.WriteStack: Boolean;
var
m: TDBGPtr;
begin
Result := True;
if Length(FPreparedStack) = 0 then
exit;
m := AllocStack(Length(FPreparedStack));
Result := FDbgProcess.WriteData(m, Length(FPreparedStack), FPreparedStack[0]);
if not Result then
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
FLastError := CreateError(fpErrAnyError, ['failed to write call info to stack memory']);
end;
function TFpDbgInfoCallContext.CreateParamSymbol(AParamIndex: Integer;
@ -457,7 +459,11 @@ begin
Result := True;
ANil := 0;
FStringResultMem := AllocStack(32); // TODO: only Win64 needs 32 alignemnt
FDbgProcess.WriteData(FStringResultMem, FDbgProcess.PointerSize, ANil);
Result := FDbgProcess.WriteData(FStringResultMem, FDbgProcess.PointerSize, ANil);
if not Result then begin
FLastError := CreateError(fpErrAnyError, ['Error writing result param to stack memory']);
exit;
end;
FNeedStringResInFinalize := FDbgProcess.Mode = dm32;
if not FNeedStringResInFinalize then
@ -499,7 +505,7 @@ function TFpDbgInfoCallContext.GetStringResultAsPointer(out
begin
Result := FDbgProcess.ReadAddress(FStringResultMem, AStringAsPtr);
if not Result then
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
FLastError := CreateError(fpErrAnyError, ['failed to read result from stack mem']);
end;
function TFpDbgInfoCallContext.GetStringResult(out AVal: TFpValue;
@ -520,7 +526,7 @@ begin
AVal := TFpValueConstString.Create(ResSymbol.AsString);
Result := IsError(ResSymbol.LastError);
if not Result then
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
FLastError := ResSymbol.LastError;
ReleaseRefAndNil(ResSymbol);
exit;
end;
@ -535,7 +541,7 @@ begin
SetLength(s,r);
end;
if not Result then begin
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
FLastError := CreateError(fpErrAnyError, ['failed to read result from mem']);
exit;
end;
end;
@ -560,7 +566,7 @@ begin
AVal := TFpValueConstString.Create(ResSymbol.AsString);
Result := IsError(ResSymbol.LastError);
if not Result then
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
FLastError := ResSymbol.LastError;
ReleaseRefAndNil(ResSymbol);
exit;
end;
@ -575,7 +581,7 @@ begin
SetLength(s,r);
end;
if not Result then begin
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
FLastError := CreateError(fpErrAnyError, ['failed to read result from mem']);
exit;
end;
end;

View File

@ -50,7 +50,8 @@ type
deLoadLibrary, deUnloadLibrary,
deFinishedStep, deBreakpoint, deHardCodedBreakpoint,
deException,
deInternalContinue);
deInternalContinue,
deFailed);
TFPDCompareStepInfo = (dcsiNewLine, dcsiSameLine, dcsiNoLineInfo, dcsiZeroLine);
{ TDbgRegisterValue }
@ -798,7 +799,8 @@ const
'deLoadLibrary', 'deUnloadLibrary',
'deFinishedStep', 'deBreakpoint', 'deHardCodedBreakpoint',
'deException',
'deInternalContinue'
'deInternalContinue',
'deFailed'
);
function GetDbgProcessClass(ATargetInfo: TTargetDescriptor): TOSDbgClasses;

View File

@ -52,7 +52,7 @@ type
constructor Create(AController: TDbgController); virtual;
destructor Destroy; override;
procedure DoBeforeLoopStart;
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); virtual; abstract;
function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual; abstract;
procedure ResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean);
function NextInstruction: TDbgAsmInstruction; inline;
property Thread: TDbgThread read FThread write SetThread;
@ -65,7 +65,7 @@ type
protected
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
public
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
end;
{ TDbgControllerStepIntoInstructionCmd }
@ -74,7 +74,7 @@ type
protected
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
public
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
end;
{ TDbgControllerHiddenBreakStepBaseCmd }
@ -100,7 +100,7 @@ type
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); virtual; abstract;
public
destructor Destroy; override;
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
property StoredStackFrameInfo: TDbgStackFrameInfo read FStackFrameInfo;
property IsSteppedOut: Boolean read GetIsSteppedOut;
@ -134,7 +134,7 @@ type
public
constructor Create(AController: TDbgController; AStoreStepInfoAtInit: Boolean = False);
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
property StartedInFuncName: String read FStartedInFuncName;
end;
@ -187,6 +187,8 @@ type
FStep: TStep;
FHiddenBreakpoint: TFpInternalBreakpoint;
FCallContext: TFpDbgInfoCallContext;
FHasOrigCodeRead, FHasInstPtr: Boolean;
FInitError: Boolean;
procedure Init; override;
procedure InsertCallInstructionCode;
@ -199,10 +201,13 @@ type
procedure StoreRoutineResult;
procedure StoreRegisters;
procedure RestoreRegisters;
procedure HandleUnrecoverable;
procedure RestoreState;
public
constructor Create(AController: TDbgController; const ARoutineAddress: TFpDbgMemLocation; ACallContext:TFpDbgInfoCallContext);
destructor Destroy; override;
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
function DoContinue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
end;
@ -454,10 +459,14 @@ begin
debugln(FPDBG_FUNCCALL, ['CallRoutine INIT - Cmd.Init - ProcessLoop starts']);
inherited Init;
FCallContext.WriteStack;
FStep := sSingleStep;
StoreInstructionPointer;
if not FCallContext.WriteStack then begin
FInitError := True;
exit;
end;
InsertCallInstructionCode;
end;
@ -473,13 +482,20 @@ begin
// Store the original code of the current instruction
SetLength(FOriginalCode, 5);
if not FProcess.ReadData(CurrentIP, 5, FOriginalCode[0]) then
raise Exception.Create('Failed to read the original code at the instruction pointer');
if not FProcess.ReadData(CurrentIP, 5, FOriginalCode[0]) then begin
FCallContext.SetError('Failed to read code from mem');
FInitError := True;
exit;
end;
FHasOrigCodeRead := True;
// Calculate the relative offset between the address of the current instruction
// and the address of the function we want to call.
if Abs(Int64(FRoutineAddress)-Int64(CurrentIP))>=MaxSIntValue then
raise Exception.Create('Calling this function is not supported. Offset to the function that is to be called is too high.');
if Abs(Int64(FRoutineAddress)-Int64(CurrentIP))>=MaxSIntValue then begin
FCallContext.SetError('Calling this function is not supported. Offset to the function that is to be called is too high.');
FInitError := True;
exit;
end;
RelAddr := Int32(FRoutineAddress) - (Int32(CurrentIP) + 5); // 5 is the size of the instruction we are about to add.
// Construct the code to call the function.
@ -489,15 +505,27 @@ begin
DW^ := RelAddr;
// Overwrite the current code with the new code to call the function
FProcess.WriteInstructionCode(CurrentIP, 5, Buf[0]);
if not FProcess.WriteInstructionCode(CurrentIP, 5, Buf[0]) then begin
FCallContext.SetError('Failed to write code to mem');
FInitError := True;
exit;
end;
// Store the address where the debugee should return at after the function
// finished. It is used to determine if the call has been completed succesfully.
FReturnAdress := CurrentIP + 5;
end;
procedure TDbgControllerCallRoutineCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
function TDbgControllerCallRoutineCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread): boolean;
begin
Result := not FInitError;
if not Result then begin
// Code and InstrPtr should not be modified yet.
RestoreState;
exit;
end;
case FStep of
sSingleStep: AProcess.Continue(AProcess, AThread, True); // Single step into the function
sRunRoutine: AProcess.Continue(AProcess, AThread, False); // Continue running the function
@ -508,6 +536,15 @@ procedure TDbgControllerCallRoutineCmd.DoResolveEvent(var AnEvent: TFPDEvent; An
var
CurrentIP: TDBGPtr;
begin
if FInitError then begin
assert(False, 'TDbgControllerCallRoutineCmd.DoResolveEvent: False / should never be here');
if not IsError(FCallContext.LastError) then
FCallContext.SetError('Failed to setup call');
FThread.ClearExceptionSignal;
RestoreState;
Finished := True;
end;
case FStep of
sSingleStep: begin
// The debugee is in the routine now. Restore the original code.
@ -520,16 +557,33 @@ begin
AnEvent := deInternalContinue;
Finished := false;
FStep := sRunRoutine;
end else
raise Exception.Create('Fatal debugger-result during function-call.');
end else begin
assert(False, 'TDbgControllerCallRoutineCmd.DoResolveEvent: False / failed single step, should never happen');
FCallContext.SetError('Failed to make call');
FThread.ClearExceptionSignal;
RestoreState;
Finished := True;
end;
end;
sRunRoutine: begin
// Now the debugee has stopped while running the routine.
if not (AnEvent in [deException, deBreakpoint]) then
if AnEvent in [deInternalContinue, deLoadLibrary, deUnloadLibrary] then begin
AnEvent := deInternalContinue;
Finished := false;
exit;
end;
if not (AnEvent in [deException, deBreakpoint, deHardCodedBreakpoint, deExitProcess]) then begin
//deCreateProcess, deFinishedStep
// Bail out. It can be anything, even deExitProcess. Maybe that handling
// some events can be implemented somewhere in the future.
raise Exception.Create('Fatal debugger-result during function-call.');
FCallContext.SetError('Internal error');
HandleUnrecoverable;
Finished := True;
Exit;
end;
CurrentIP := FController.CurrentThread.GetInstructionPointerRegisterValue;
if CurrentIP<>FReturnAdress then
@ -537,7 +591,7 @@ begin
// If we are not at the return-adres, the debugee has stopped due to some
// unforeseen reason. Skip setting up the call-context, but assign an
// error instead.
if (AnEvent = deBreakpoint) then
if (AnEvent in [deBreakpoint, deHardCodedBreakpoint, deExitProcess]) then
// Note that deBreakpoint does not necessarily mean that it it stopped
// at an actual breakpoint.
FCallContext.SetError('The function stopped unexpectedly. (Breakpoint, Exception, etc)')
@ -559,20 +613,27 @@ begin
RemoveHiddenBreakpointAtReturnAddress;
// Restore the debugee in the original state. So debugging can continue...
RestoreInstructionPointer();
RestoreRegisters();
RestoreState;
Finished := true;
end
else
Finished := True;
else begin
RestoreState;
Finished := True;
end
end;
end;
procedure TDbgControllerCallRoutineCmd.RestoreOriginalCode;
begin
debugln(FPDBG_FUNCCALL, ['CallRoutine -- << Restore orig Code']);
if not FProcess.WriteInstructionCode(FOriginalInstructionPointer, Length(FOriginalCode), FOriginalCode[0]) then
raise Exception.Create('Failed to restore the original code at the instruction-pointer');
if not FHasOrigCodeRead then
exit;
FHasOrigCodeRead := False;
if not FProcess.WriteInstructionCode(FOriginalInstructionPointer, Length(FOriginalCode), FOriginalCode[0]) then begin
// There is no recovery from here. Attempt to exti somewhat graceful
HandleUnrecoverable;
FCallContext.SetError('Failed to restore target app after call. Terminating');
end;
end;
procedure TDbgControllerCallRoutineCmd.SetHiddenBreakpointAtReturnAddress(AnAddress: TDBGPtr);
@ -586,10 +647,13 @@ procedure TDbgControllerCallRoutineCmd.StoreInstructionPointer;
begin
debugln(FPDBG_FUNCCALL, ['CallRoutine -- >> Store IP']);
FOriginalInstructionPointer := FController.CurrentThread.GetInstructionPointerRegisterValue;
FHasInstPtr := True;
end;
procedure TDbgControllerCallRoutineCmd.RestoreInstructionPointer;
begin
if not FHasInstPtr then
exit;
debugln(FPDBG_FUNCCALL, ['CallRoutine -- << Restore IP']);
{$ifdef cpui386}
FController.CurrentThread.SetRegisterValue('eip', FOriginalInstructionPointer);
@ -612,6 +676,24 @@ begin
FController.CurrentThread.RestoreRegisters;
end;
procedure TDbgControllerCallRoutineCmd.HandleUnrecoverable;
begin
// There is no recovery from here. Attempt to exti somewhat graceful
FController.Stop;
FProcess.TerminateProcess;
end;
procedure TDbgControllerCallRoutineCmd.RestoreState;
begin
try
RestoreOriginalCode;
RestoreInstructionPointer();
RestoreRegisters();
except
HandleUnrecoverable;
end;
end;
procedure TDbgControllerCallRoutineCmd.RemoveHiddenBreakpointAtReturnAddress();
begin
FreeAndNil(FHiddenBreakpoint);
@ -694,10 +776,12 @@ end;
{ TDbgControllerContinueCmd }
procedure TDbgControllerContinueCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
function TDbgControllerContinueCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread): boolean;
begin
assert(FProcess=AProcess, 'TDbgControllerContinueCmd.DoContinue: FProcess=AProcess');
AProcess.Continue(AProcess, AThread, False);
Result := True;
end;
procedure TDbgControllerContinueCmd.DoResolveEvent(var AnEvent: TFPDEvent;
@ -708,11 +792,12 @@ end;
{ TDbgControllerStepIntoInstructionCmd }
procedure TDbgControllerStepIntoInstructionCmd.DoContinue(
AProcess: TDbgProcess; AThread: TDbgThread);
function TDbgControllerStepIntoInstructionCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread): boolean;
begin
assert(FProcess=AProcess, 'TDbgControllerStepIntoInstructionCmd.DoContinue: FProcess=AProcess');
FProcess.Continue(FProcess, FThread, True);
Result := True;
end;
procedure TDbgControllerStepIntoInstructionCmd.DoResolveEvent(
@ -811,9 +896,10 @@ begin
inherited Destroy;
end;
procedure TDbgControllerHiddenBreakStepBaseCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread);
function TDbgControllerHiddenBreakStepBaseCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread): boolean;
begin
Result := True;
if (AThread <> FThread) then begin
FProcess.Continue(FProcess, AThread, False);
exit;
@ -949,9 +1035,10 @@ begin
inherited Create(AController);
end;
procedure TDbgControllerLineStepBaseCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread);
function TDbgControllerLineStepBaseCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread): boolean;
begin
Result := True;
if AThread = FThread then
FWasAtJumpInstruction := False;
inherited DoContinue(AProcess, AThread);
@ -1591,7 +1678,7 @@ var
AProcessIdentifier: THandle;
AThreadIdentifier: THandle;
AExit: boolean;
IsFinished, b: boolean;
IsFinished, b, DidContinue: boolean;
EventProcess: TDbgProcess;
DummyThread: TDbgThread;
CurCmd: TDbgControllerCmd;
@ -1619,6 +1706,7 @@ begin
repeat
ReleaseRefAndNil(FDefaultContext);
DidContinue := True;
if assigned(FCurrentProcess) and not assigned(FMainProcess) then begin
// IF there is a pause-request, we will hit a deCreateProcess.
// No need to indicate FRunning
@ -1644,7 +1732,7 @@ begin
else
begin
DebugLnEnter(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName);
FCommand.DoContinue(FCurrentProcess, FCurrentThread);
DidContinue := FCommand.DoContinue(FCurrentProcess, FCurrentThread);
end;
// TODO: replace the dangling pointer with the next best value....
@ -1657,6 +1745,11 @@ begin
DebugLnExit(FPDBG_COMMANDS);
end;
end;
if not DidContinue then begin
FPDEvent := deFailed;
break;
end;
if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then
Continue;
InterLockedExchange(FRunning, 0);

View File

@ -982,6 +982,12 @@ begin
if not CallContext.IsValid then begin
DebugLn(['Error in call ',CallContext.Message]);
//ReturnMessage := CallContext.Message;
AnError := CallContext.LastError;
if not IsError(AnError) then
if CallContext.Message <> '' then
AnError := CreateError(fpErrAnyError, [CallContext.Message])
else
AnError := CreateError(fpErrAnyError, ['Error in function execution']);
exit;
end;

View File

@ -6,8 +6,8 @@ interface
uses
Classes, SysUtils, FpWatchResultData, FpDbgInfo, FpdMemoryTools,
DbgIntfBaseTypes, FpDebugValueConvertors, FpDebugDebuggerBase,
LazDebuggerIntf;
FpErrorMessages, DbgIntfBaseTypes, FpDebugValueConvertors,
FpDebugDebuggerBase, LazDebuggerIntf;
type
@ -125,7 +125,10 @@ begin
Result := inherited DoValueToResData(NewFpVal, AnResFld);
end
else begin
AnResFld.CreateError('Conversion failed');
if IsError(CurConv.LastErrror) then
AnResFld.CreateError(ErrorHandler.ErrorAsString(CurConv.LastErrror))
else
AnResFld.CreateError('Conversion failed');
Result := True;
end;
AnResData := AnResData.AddField('', dfvUnknown, []);

View File

@ -20,6 +20,8 @@ type
*)
TFpDbgValueConverter = class(TRefCountedObject)
private
FLastErrror: TFpError;
public
class function GetName: String; virtual; abstract;
class function GetSupportedKinds: TDbgSymbolKinds; virtual;
@ -29,6 +31,8 @@ type
AnFpDebugger: TFpDebugDebuggerBase;
AnExpressionScope: TFpDbgSymbolScope
): TFpValue; virtual; abstract;
procedure SetError(AnError: TFpError);
property LastErrror: TFpError read FLastErrror;
end;
TFpDbgValueConverterClass = class of TFpDbgValueConverter;
@ -133,6 +137,11 @@ begin
Result.Assign(Self);
end;
procedure TFpDbgValueConverter.SetError(AnError: TFpError);
begin
FLastErrror := AnError;
end;
class function TFpDbgValueConverter.GetSupportedKinds: TDbgSymbolKinds;
begin
Result := [low(TDbgSymbolKinds)..high(TDbgSymbolKinds)];
@ -305,14 +314,18 @@ begin
( (ASourceValue.MemberCount = 0) or
(ASourceValue.MemberCount >= 2)
) )
then
then begin
SetError(CreateError(fpErrAnyError, ['Value not a variant']));
exit;
end;
if (ASourceValue.MemberCount >= 2) then begin
m := ASourceValue.Member[0];
r := SizeToFullBytes(m.DataSize) <> 2;
m.ReleaseReference;
if r then
if r then begin
SetError(CreateError(fpErrAnyError, ['Value not a variant']));
exit;
end;
end;
ProcVal := nil;
@ -341,17 +354,23 @@ begin
ProcLoc := ProcSym.Address
*)
if not IsTargetAddr(ASourceValue.Address) then
if not IsTargetAddr(ASourceValue.Address) then begin
SetError(CreateError(fpErrAnyError, ['Value not in memory']));
exit;
end;
ProcAddr := GetProcAddrFromMgr(AnFpDebugger, AnExpressionScope);
if ProcAddr = 0 then
if ProcAddr = 0 then begin
SetError(CreateError(fpErrAnyError, ['SysVarToLStr not found']));
exit;
end;
ProcLoc := TargetLoc(ProcAddr);
StringDecRefSymbol := AnFpDebugger.DbgController.CurrentProcess.FindProcSymbol('FPC_ANSISTR_DECR_REF');
if (StringDecRefSymbol = nil) or (not IsTargetAddr(StringDecRefSymbol.Address)) then
if (StringDecRefSymbol = nil) or (not IsTargetAddr(StringDecRefSymbol.Address)) then begin
SetError(CreateError(fpErrAnyError, ['STRING_DEC_REF not found']));
exit;
end;
StringAddr := 0;
CallContext := AnFpDebugger.DbgController.Call(ProcLoc, AnExpressionScope.LocationContext,
@ -362,16 +381,22 @@ begin
CallContext.AddOrdinalParam(nil, ASourceValue.DataAddress.Address);
AnFpDebugger.DbgController.ProcessLoop;
if not CallContext.IsValid then
if not CallContext.IsValid then begin
if (IsError(CallContext.LastError)) then
SetError(CallContext.LastError)
else
if (CallContext.Message <> '') then
SetError(CreateError(fpErrAnyError, [CallContext.Message]));
exit;
end;
if not CallContext.GetStringResultAsPointer(StringAddr) then begin
//AnError := CallContext.LastError;
SetError(CallContext.LastError);
exit;
end;
if not CallContext.GetStringResult(NewResult) then begin
// error
SetError(CallContext.LastError);
exit;
end;