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

LazDebuggerFp: Add cache for common function addresses (used in watch-eval function calling), e.g. FPC_ANSISTR_DECR_REF

Browse Source
This commit is contained in:
Martin 2022-07-01 00:36:15 +02:00
parent 3c322a009f
commit a571e61d9c
3 changed files with 115 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerbase.pas
View File

@ -5,12 +5,17 @@ unit FpDebugDebuggerBase;
interface
uses
Classes, SysUtils, FPDbgController, FpdMemoryTools, FpDbgClasses, FpDbgUtil,
DbgIntfDebuggerBase, FpDebugDebuggerUtils;
Classes, SysUtils, fgl, FPDbgController, FpdMemoryTools, FpDbgClasses,
FpDbgUtil, FpDbgInfo, DbgIntfDebuggerBase, LazLoggerBase,
FpDebugDebuggerUtils, LazDebuggerIntfBaseTypes;
type
{ TFpDebugDebuggerBase }
TFpDebugDebuggerBase = class(TDebuggerIntf)
private type
TCachedDbgPtrMap = specialize TFPGMap<Pointer, TDbgPtr>;
protected
FDbgController: TDbgController;
FMemManager: TFpDbgMemManager;
@ -18,7 +23,21 @@ type
FMemConverter: TFpDbgMemConvertorLittleEndian;
FLockList: TFpDbgLockList;
FWorkQueue: TFpThreadPriorityWorkerQueue;
FCached_FPC_ANSISTR_DECR_REF: TDbgPtr;
FCached_FPC_WIDESTR_DECR_REF: TDbgPtr;
FCached_Data: TCachedDbgPtrMap;
public
destructor Destroy; override;
// All caches must only be accessed it the debug-thread
function GetCached_FPC_ANSISTR_DECR_REF: TDBGPtr;
function GetCached_FPC_WIDESTR_DECR_REF: TDBGPtr;
procedure SetCachedData(AKey: Pointer; AValue: TDBGPtr);
function GetCachedData(AKey: Pointer): TDBGPtr;
procedure ClearCachedData;
property DbgController: TDbgController read FDbgController;
property MemManager: TFpDbgMemManager read FMemManager;
property MemReader: TDbgMemReader read FMemReader;
@ -30,5 +49,74 @@ type
implementation
{ TFpDebugDebuggerBase }
destructor TFpDebugDebuggerBase.Destroy;
begin
inherited Destroy;
FreeAndNil(FCached_Data);
end;
function TFpDebugDebuggerBase.GetCached_FPC_ANSISTR_DECR_REF: TDBGPtr;
var
StringDecRefSymbol: TFpSymbol;
begin
Result := FCached_FPC_ANSISTR_DECR_REF;
if Result <> 0 then
exit;
StringDecRefSymbol := DbgController.CurrentProcess.FindProcSymbol('FPC_ANSISTR_DECR_REF');
if (StringDecRefSymbol <> nil) and (IsTargetNotNil(StringDecRefSymbol.Address)) then
FCached_FPC_ANSISTR_DECR_REF := StringDecRefSymbol.Address.Address;
StringDecRefSymbol.ReleaseReference;
Result := FCached_FPC_ANSISTR_DECR_REF;
end;
function TFpDebugDebuggerBase.GetCached_FPC_WIDESTR_DECR_REF: TDBGPtr;
var
StringDecRefSymbol: TFpSymbol;
begin
Result := FCached_FPC_WIDESTR_DECR_REF;
if Result <> 0 then
exit;
StringDecRefSymbol := DbgController.CurrentProcess.FindProcSymbol('FPC_WIDESTR_DECR_REF');
if (StringDecRefSymbol <> nil) and (IsTargetNotNil(StringDecRefSymbol.Address)) then
FCached_FPC_WIDESTR_DECR_REF := StringDecRefSymbol.Address.Address;
StringDecRefSymbol.ReleaseReference;
Result := FCached_FPC_WIDESTR_DECR_REF;
end;
procedure TFpDebugDebuggerBase.SetCachedData(AKey: Pointer; AValue: TDBGPtr);
begin
if FCached_Data = nil then
FCached_Data := TCachedDbgPtrMap.Create;
FCached_Data[AKey] := AValue;
end;
function TFpDebugDebuggerBase.GetCachedData(AKey: Pointer): TDBGPtr;
var
i: Integer;
begin
Result := 0;
if FCached_Data <> nil then begin
i := FCached_Data.IndexOf(AKey);
if i >= 0 then
Result := FCached_Data.Data[i];
end;
end;
procedure TFpDebugDebuggerBase.ClearCachedData;
begin
FCached_FPC_ANSISTR_DECR_REF := 0;
FCached_FPC_WIDESTR_DECR_REF := 0;
if FCached_Data <> nil then
FCached_Data.Clear;
end;
end.

23
components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas
View File

@ -486,6 +486,7 @@ end;
procedure TFpThreadWorkerRunLoop.DoExecute;
begin
FDebugger.ClearCachedData;
FDebugger.DbgController.ProcessLoop;
Queue(@LoopFinished_DecRef);
end;
@ -783,7 +784,7 @@ function TFpThreadWorkerEvaluate.DoWatchFunctionCall(
AResult: TFpValue; var AnError: TFpError): boolean;
var
FunctionSymbolData, FunctionSymbolType, FunctionResultSymbolType,
TempSymbol, StringDecRefSymbol, StringSymbol: TFpSymbol;
TempSymbol, StringSymbol: TFpSymbol;
ExprParamVal: TFpValue;
ProcAddress: TFpDbgMemLocation;
FunctionResultDataSize: TFpDbgValueSize;
@ -791,7 +792,7 @@ var
CallContext: TFpDbgInfoCallContext;
PCnt, i, FoundIdx, ItemsOffs: Integer;
rk: TDbgSymbolKind;
StringAddr: TDBGPtr;
StringAddr, StringDecRefAddress: TDBGPtr;
begin
Result := False;
if FExpressionScope = nil then
@ -829,16 +830,19 @@ begin
try
ParameterSymbolArr := nil;
StringDecRefSymbol := nil;
StringDecRefAddress := 0;
StringAddr := 0;
if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString])
then begin
// FCached_FPC_ANSISTR_DECR_REF TFpThreadWorkerRunLoop.DoExecute
if (FunctionResultSymbolType.Kind = skWideString) then
StringDecRefSymbol := FDebugger.DbgController.CurrentProcess.FindProcSymbol('FPC_WIDESTR_DECR_REF')
StringDecRefAddress := FDebugger.GetCached_FPC_WIDESTR_DECR_REF
else
StringDecRefSymbol := FDebugger.DbgController.CurrentProcess.FindProcSymbol('FPC_ANSISTR_DECR_REF');
if (StringDecRefSymbol = nil) or (not IsTargetNotNil(StringDecRefSymbol.Address)) then begin
StringDecRefAddress := FDebugger.GetCached_FPC_ANSISTR_DECR_REF;
if (StringDecRefAddress = 0) then begin
DebugLn(['Error result kind ', dbgs(FunctionSymbolType.Kind)]);
AnError := CreateError(fpErrAnyError, ['Result type of function not supported']);
exit;
@ -940,7 +944,7 @@ begin
FDebugger.MemReader, FDebugger.MemConverter);
try
if (ASelfValue = nil) and (StringDecRefSymbol <> nil) then begin
if (ASelfValue = nil) and (StringDecRefAddress <> 0) then begin
if not CallContext.AddStringResult then begin
DebugLn('Internal error for string result');
AnError := CallContext.LastError;
@ -963,7 +967,7 @@ begin
exit;
end;
if (ASelfValue <> nil) and (StringDecRefSymbol <> nil) and (i = 0) then begin
if (ASelfValue <> nil) and (StringDecRefAddress <> 0) and (i = 0) then begin
if not CallContext.AddStringResult then begin
DebugLn('Internal error for string result');
AnError := CallContext.LastError;
@ -1017,7 +1021,7 @@ begin
end;
if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString]) and (StringAddr <> 0) then begin
CallContext := FDebugger.DbgController.Call(StringDecRefSymbol.Address, FExpressionScope.LocationContext,
CallContext := FDebugger.DbgController.Call(TargetLoc(StringDecRefAddress), FExpressionScope.LocationContext,
FDebugger.MemReader, FDebugger.MemConverter);
try
CallContext.AddOrdinalViaRefAsParam(StringAddr);
@ -1034,7 +1038,6 @@ begin
for i := 0 to High(ParameterSymbolArr) do
if ParameterSymbolArr[i] <> nil then
ParameterSymbolArr[i].ReleaseReference;
ReleaseRefAndNil(StringDecRefSymbol);
end;
end;

16
components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas
View File

@ -302,9 +302,9 @@ function TFpDbgValueConverterVariantToLStr.ConvertValue(ASourceValue: TFpValue;
): TFpValue;
var
NewResult, ProcVal, m: TFpValue;
ProcSym, StringDecRefSymbol: TFpSymbol;
ProcSym: TFpSymbol;
CallContext: TFpDbgInfoCallContext;
StringAddr, ProcAddr: TDbgPtr;
StringAddr, ProcAddr, StringDecRefAddress: TDbgPtr;
ProcLoc: TFpDbgMemLocation;
r: Boolean;
begin
@ -330,7 +330,6 @@ begin
ProcVal := nil;
ProcSym := nil;
StringDecRefSymbol := nil;
try
(*
//VARIANTS_$$_SYSVARTOLSTR$ANSISTRING$VARIANT
@ -359,15 +358,19 @@ begin
exit;
end;
ProcAddr := AnFpDebugger.GetCachedData(pointer(TFpDbgValueConverterVariantToLStr));
if ProcAddr = 0 then begin
ProcAddr := GetProcAddrFromMgr(AnFpDebugger, AnExpressionScope);
if ProcAddr = 0 then begin
SetError(CreateError(fpErrAnyError, ['SysVarToLStr not found']));
exit;
end;
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterVariantToLStr), ProcAddr);
end;
ProcLoc := TargetLoc(ProcAddr);
StringDecRefSymbol := AnFpDebugger.DbgController.CurrentProcess.FindProcSymbol('FPC_ANSISTR_DECR_REF');
if (StringDecRefSymbol = nil) or (not IsTargetAddr(StringDecRefSymbol.Address)) then begin
StringDecRefAddress := AnFpDebugger.GetCached_FPC_ANSISTR_DECR_REF;
if (StringDecRefAddress = 0) then begin
SetError(CreateError(fpErrAnyError, ['STRING_DEC_REF not found']));
exit;
end;
@ -405,7 +408,7 @@ begin
AnFpDebugger.DbgController.AbortCurrentCommand;
CallContext.ReleaseReference;
CallContext := AnFpDebugger.DbgController.Call(StringDecRefSymbol.Address, AnExpressionScope.LocationContext,
CallContext := AnFpDebugger.DbgController.Call(TargetLoc(StringDecRefAddress), AnExpressionScope.LocationContext,
AnFpDebugger.MemReader, AnFpDebugger.MemConverter);
try
CallContext.AddOrdinalViaRefAsParam(StringAddr);
@ -419,7 +422,6 @@ begin
finally
ProcVal.ReleaseReference;
ProcSym.ReleaseReference;
StringDecRefSymbol.ReleaseReference;
end;
end;