mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 13:59:31 +02:00
LazDebuggerFp: improve errors for function calling
This commit is contained in:
parent
f7b08ce6f7
commit
9e67808d84
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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, []);
|
||||
|
@ -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;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user