paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-05 11:38:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

Move IsReadableLoc and IsReadableMem to MemModel.

Browse Source
This commit is contained in:
ccrause 2024-01-12 13:03:21 +02:00 committed by Martin
parent 3ecbb52069
commit c327f03044
9 changed files with 52 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/fpdebug/fpdbgavrclasses.pas
View File

@ -45,6 +45,8 @@ type
function UpdateLocationToCodeAddress(const ALocation: TFpDbgMemLocation): TFpDbgMemLocation; override;
function LocationToAddress(const ALocation: TFpDbgMemLocation): TDBGPtr; override;
function AddressToTargetLocation(const AAddress: TDBGPtr): TFpDbgMemLocation; override;
function IsReadableMemory(const ALocation: TFpDbgMemLocation): Boolean; override;
function IsReadableLocation(const ALocation: TFpDbgMemLocation): Boolean; override;
end;
{ TAvrMemManager }
@ -168,6 +170,21 @@ begin
Result.Address := word(Result.Address);
end;
function TFpDbgAvrMemModel.IsReadableMemory(const
ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (ALocation.MType in [mlfTargetMem, mlfSelfMem]) and
(ALocation.Address >= 0);
end;
function TFpDbgAvrMemModel.IsReadableLocation(const
ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (not(ALocation.MType in [mlfInvalid, mlfUninitialized])) and
(not(ALocation.MType in [mlfTargetMem, mlfSelfMem]) or
(ALocation.Address >= 0));
end;
{ TAvrMemManager }
function TAvrMemManager.ReadMemory(AReadDataType: TFpDbgMemReadDataType; const

2
components/fpdebug/fpdbgcallcontextinfo.pas
View File

@ -115,7 +115,7 @@ function TFpSymbolCallParamOrdinalOrPointer.TFpValueCallParamStringByRef.GetDwar
(out AnAddress: TFpDbgMemLocation; ATargetType: TFpSymbolDwarfType): Boolean;
begin
AnAddress := Address;
Result := IsReadableLoc(AnAddress);
Result := MemManager.MemModel.IsReadableLocation(AnAddress);
end;
{ TFpSymbolCallParamOrdinalOrPointer }

6
components/fpdebug/fpdbgdwarf.pas
View File

@ -2010,7 +2010,7 @@ begin
Assert((ti is TFpSymbolDwarfType) and (ti.SymbolType = stType), 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo = stType');
AnAddress := Address;
Result := IsReadableLoc(AnAddress);
Result := Context.MemModel.IsReadableLocation(AnAddress);
if Result then
Result := TFpSymbolDwarf(ti).GetDataAddress(Self, AnAddress, ATargetType);
@ -2031,7 +2031,7 @@ begin
if svfAddress in fields then
AnAddress := FTypeCastSourceValue.Address;
Result := IsReadableLoc(AnAddress);
Result := Context.MemModel.IsReadableLocation(AnAddress);
if Result then
Result := FTypeSymbol.GetDataAddress(Self, AnAddress, ATargetType);
end;
@ -3715,7 +3715,7 @@ begin
assert((FArraySymbol is TFpSymbolDwarfTypeArray) and (FArraySymbol.Kind = skArray));
Addr := TFpSymbolDwarfTypeArray(FArraySymbol).GetMemberAddress(Self, AIndex);
if not IsReadableLoc(Addr) then exit;
if not Context.MemModel.IsReadableLocation(Addr) then exit;
// FAddrObj.RefCount: hold by self
i := 1;

8
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -1477,7 +1477,7 @@ begin
if Result then
exit;
if not( GetDwarfDataAddress(Addr) and IsReadableLoc(Addr) ) then
if not( GetDwarfDataAddress(Addr) and MemManager.MemModel.IsReadableLocation(Addr) ) then
exit;
Addr:= Addr - (AddressSize * 2);
@ -1883,7 +1883,7 @@ begin
if Result then
exit;
if not IsReadableLoc(Addr) then
if not MemManager.MemModel.IsReadableLocation(Addr) then
exit;
if TFpDwarfFreePascalSymbolClassMap(TypeInfo.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion >= $030301
@ -1953,7 +1953,7 @@ begin
(svfOrdinal in TypeCastSourceValue.FieldFlags)
then
Addr := TargetLoc(TypeCastSourceValue.AsCardinal);
if not IsReadableLoc(Addr) then
if not MemManager.MemModel.IsReadableLocation(Addr) then
exit;
assert((TypeInfo <> nil) and (TypeInfo.CompilationUnit <> nil) and (TypeInfo.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3), 'TFpValueDwarfV3FreePascalString.GetAsString: (Owner <> nil) and (Owner.CompilationUnit <> nil) and (TypeInfo.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3)');
@ -1996,7 +1996,7 @@ begin
(svfOrdinal in TypeCastSourceValue.FieldFlags)
then
AnAddr := TargetLoc(TypeCastSourceValue.AsCardinal);
if not IsReadableLoc(AnAddr) then
if not MemManager.MemModel.IsReadableLocation(AnAddr) then
exit;
Result := True;

7
components/fpdebug/fpdbginfo.pas
View File

@ -584,6 +584,7 @@ type
function GetSymbolAtAddress: TFpSymbol; virtual;
function GetProcedureAtAddress: TFpValue; virtual;
function GetMemManager: TFpDbgMemManager; virtual;
function GetMemModel: TFpDbgMemModel; virtual;
function GetSizeOfAddress: Integer; virtual;
public
constructor Create(ALocationContext: TFpDbgLocationContext);
@ -593,6 +594,7 @@ type
// search this, and all parent context
function FindSymbol(const {%H-}AName: String; const OnlyUnitName: String = ''): TFpValue; virtual;
property MemManager: TFpDbgMemManager read GetMemManager;
property MemModel: TFpDbgMemModel read GetMemModel;
property SizeOfAddress: Integer read GetSizeOfAddress;
property LocationContext: TFpDbgLocationContext read FLocationContext;
end;
@ -1530,6 +1532,11 @@ begin
Result := LocationContext.MemManager;
end;
function TFpDbgSymbolScope.GetMemModel: TFpDbgMemModel;
begin
Result := LocationContext.MemModel;
end;
constructor TFpDbgSymbolScope.Create(ALocationContext: TFpDbgLocationContext);
begin
FLocationContext := ALocationContext;

20
components/fpdebug/fpdmemorytools.pas
View File

@ -391,6 +391,8 @@ type
function UpdateLocationToCodeAddress(const ALocation: TFpDbgMemLocation): TFpDbgMemLocation; virtual;
function LocationToAddress(const ALocation: TFpDbgMemLocation): TDBGPtr; virtual;
function AddressToTargetLocation(const AAddress: TDBGPtr): TFpDbgMemLocation; virtual;
function IsReadableMemory(const ALocation: TFpDbgMemLocation): Boolean; virtual;
function IsReadableLocation(const ALocation: TFpDbgMemLocation): Boolean; virtual;
end;
(* TFpDbgMemManager
@ -496,7 +498,7 @@ function IsConstData(const ALocation: TFpDbgMemLocation): Boolean; inline;
function IsInitializedLoc(const ALocation: TFpDbgMemLocation): Boolean; inline;
function IsValidLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid, Nil allowed
function IsReadableLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and not Nil // can be const or reg
function IsReadableMem(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and target or sel <> nil
function IsReadableMem(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and target or self <> nil
function IsNilLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid AND NIL // Does not check mlfTargetRegister
// TODO: registers should be targed.... // May have to rename some of those
function IsTargetNil(const ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed = nil
@ -1149,6 +1151,18 @@ begin
Result := TargetLoc(AAddress);
end;
function TFpDbgMemModel.IsReadableMemory(const
ALocation: TFpDbgMemLocation): Boolean;
begin
Result := IsReadableMem(ALocation);
end;
function TFpDbgMemModel.IsReadableLocation(const
ALocation: TFpDbgMemLocation): Boolean;
begin
Result := IsReadableLoc(ALocation);
end;
{ TFpDbgMemReaderBase }
function TFpDbgMemReaderBase.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
@ -2056,7 +2070,7 @@ var
i: QWord;
begin
Result := False;
if not IsReadableLoc(ALocation) then begin
if not MemModel.IsReadableLocation(ALocation) then begin
FLastError := CreateError(fpInternalErrFailedReadMem);
exit;
end;
@ -2089,7 +2103,7 @@ var
i: QWord;
begin
Result := False;
if not IsReadableLoc(ALocation) then begin
if not MemModel.IsReadableLocation(ALocation) then begin
FLastError := CreateError(fpInternalErrFailedReadMem);
exit;
end;

2
components/fpdebug/fppascalbuilder.pas
View File

@ -931,7 +931,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
GetTypeAsDeclaration(s, t);
APrintedValue := APrintedValue + s;
if (AValue.Kind in [skFunction, skProcedure]) and IsReadableLoc(v) then begin
if (AValue.Kind in [skFunction, skProcedure]) and Context.MemModel.IsReadableLocation(v) then begin
APrintedValue := APrintedValue + ' AT ' + '$'+IntToHex(va, AnAddressSize*2);
end;

2
components/fpdebug/fppascalparser.pas
View File

@ -1217,7 +1217,7 @@ begin
FCardinal := 0;
FCardinalRead := True;
Addr := GetAddress;
if not IsReadableLoc(Addr) then exit;
if not Context.MemModel.IsReadableLocation(Addr) then exit;
FCardinal := LocToAddrOrNil(Ctx.ReadAddress(Addr, SizeVal(Ctx.SizeOfAddress)));
Result := FCardinal;

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

@ -880,7 +880,7 @@ begin
// check params
ProcAddress := AFunctionValue.EntryPCAddress;
if not IsReadableLoc(ProcAddress) then begin
if not FExpressionScope.MemModel.IsReadableMemory(ProcAddress) then begin
DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, ['Error proc addr']);
AnError := CreateError(fpErrAnyError, ['Unable to calculate function address']);
exit;