From a571e61d9ceb70a963f208b017b57912b3b0534a Mon Sep 17 00:00:00 2001 From: Martin Date: Fri, 1 Jul 2022 00:36:15 +0200 Subject: [PATCH] LazDebuggerFp: Add cache for common function addresses (used in watch-eval function calling), e.g. FPC_ANSISTR_DECR_REF --- .../lazdebuggerfp/fpdebugdebuggerbase.pas | 92 ++++++++++++++++++- .../fpdebugdebuggerworkthreads.pas | 23 +++-- .../lazdebuggerfp/fpdebugvalueconvertors.pas | 22 +++-- 3 files changed, 115 insertions(+), 22 deletions(-) diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerbase.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerbase.pas index db9b52146e..8f46de83f8 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerbase.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerbase.pas @@ -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; 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. diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas index 9ab728b54a..6f85904402 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas @@ -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; diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas index 6443696934..88990f8635 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas @@ -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 := GetProcAddrFromMgr(AnFpDebugger, AnExpressionScope); + ProcAddr := AnFpDebugger.GetCachedData(pointer(TFpDbgValueConverterVariantToLStr)); if ProcAddr = 0 then begin - SetError(CreateError(fpErrAnyError, ['SysVarToLStr not found'])); - exit; + 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;