diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 769cb9ffcd..268c909344 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -136,6 +136,8 @@ type function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override; function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override; function RegisterSize(ARegNum: Cardinal): Integer; override; + + function WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override; end; { TDbgStackFrameInfo @@ -1198,7 +1200,10 @@ var Process: TDbgProcess; begin Process := GetDbgProcess; - if not Process.GetThread(AContext.ThreadId, Result) then + // In fact, AContext should always be assigned, assuming that the main thread + // should be used is dangerous. But functions like TFpDbgMemManager.ReadSignedInt + // have a default value of nil for the context. Which is a lot of work to fix. + if not Assigned(AContext) or not Process.GetThread(AContext.ThreadId, Result) then Result := Process.MainThread; end; @@ -1258,6 +1263,34 @@ begin end; end; +function TDbgMemReader.WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; +var + ARegister: TDbgRegisterValue; + StackFrame: Integer; + AFrame: TDbgCallstackEntry; + CtxThread: TDbgThread; +begin + result := false; + CtxThread := GetDbgThread(AContext); + if CtxThread = nil then + exit; + + if AContext <> nil then // TODO: Always true? + StackFrame := AContext.StackFrame + else + StackFrame := 0; + if StackFrame = 0 then + begin + ARegister:=CtxThread.RegisterValueList.FindRegisterByDwarfIndex(ARegNum); + if assigned(ARegister) then + begin + CtxThread.SetRegisterValue(ARegister.Name, AValue); + CtxThread.LoadRegisterValues; + result := true; + end; + end +end; + function TDbgMemReader.RegisterSize(ARegNum: Cardinal): Integer; var ARegister: TDbgRegisterValue; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 340f7e71b2..7e3a1fd1ce 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -11,8 +11,8 @@ uses Maps, LazLoggerBase, LazClasses, DbgIntfBaseTypes, DbgIntfDebuggerBase, - FpDbgDisasX86, FpDbgUtil, - FpDbgClasses, + FpDbgDisasX86, + FpDbgClasses, FpDbgCallContextInfo, FpDbgUtil, {$ifdef windows} FpDbgWinClasses, {$endif} {$ifdef darwin} FpDbgDarwinClasses, {$endif} {$ifdef linux} FpDbgLinuxClasses, {$endif} @@ -425,6 +425,8 @@ begin FRoutineAddress := LocToAddr(ARoutineAddress); FCallContext := ACallContext; + + StoreRegisters; end; procedure TDbgControllerCallRoutineCmd.Init; @@ -433,7 +435,6 @@ begin FStep := sSingleStep; StoreInstructionPointer; - StoreRegisters; InsertCallInstructionCode; end; diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 2409a48a02..0de8f52c69 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -262,6 +262,7 @@ type function GetFieldFlags: TFpValueFieldFlags; override; function GetAsCardinal: QWord; override; function GetAsInteger: Int64; override; + procedure SetAsInteger(AValue: Int64); override; end; { TFpValueDwarfCardinal } @@ -271,6 +272,7 @@ type FValue: QWord; protected function GetAsCardinal: QWord; override; + procedure SetAsCardinal(AValue: QWord); override; function GetFieldFlags: TFpValueFieldFlags; override; end; @@ -291,6 +293,7 @@ type protected function GetFieldFlags: TFpValueFieldFlags; override; function GetAsBool: Boolean; override; + procedure SetAsBool(AValue: Boolean); override; end; { TFpValueDwarfChar } @@ -311,6 +314,7 @@ type function GetDerefAddress: TFpDbgMemLocation; protected function GetAsCardinal: QWord; override; + procedure SetAsCardinal(AValue: QWord); override; function GetFieldFlags: TFpValueFieldFlags; override; function GetDataAddress: TFpDbgMemLocation; override; function GetAsString: AnsiString; override; @@ -331,7 +335,9 @@ type //function IsValidTypeCast: Boolean; override; function GetFieldFlags: TFpValueFieldFlags; override; function GetAsCardinal: QWord; override; + procedure SetAsCardinal(AValue: QWord); override; function GetAsString: AnsiString; override; + procedure SetAsString(AValue: AnsiString); override; // Has exactly 0 (if the ordinal value is out of range) or 1 member (the current value's enum) function GetMemberCount: Integer; override; function GetMember({%H-}AIndex: Int64): TFpValue; override; @@ -397,6 +403,7 @@ type procedure Reset; override; function GetFieldFlags: TFpValueFieldFlags; override; function GetAsCardinal: QWord; override; + procedure SetAsCardinal(AValue: QWord); override; function GetDataSize: TFpDbgValueSize; override; end; @@ -2103,7 +2110,7 @@ begin if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then Result := inherited GetAsInteger else - if not MemManager.ReadSignedInt(OrdOrDataAddr, Size, Result) then begin + if not MemManager.ReadSignedInt(OrdOrDataAddr, Size, Result, Context) then begin Result := 0; // TODO: error SetLastError(MemManager.LastError); end; @@ -2111,6 +2118,19 @@ begin FIntValue := Result; end; +procedure TFpValueDwarfInteger.SetAsInteger(AValue: Int64); +var + Size: TFpDbgValueSize; +begin + if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then + inherited SetAsCardinal(AValue) + else + if not MemManager.WriteSignedInt(OrdOrDataAddr, Size, AValue, Context) then begin + SetLastError(MemManager.LastError); + end; + Exclude(FEvaluated, doneUInt); +end; + { TDbgDwarfCardinalSymbolValue } function TFpValueDwarfCardinal.GetAsCardinal: QWord; @@ -2126,7 +2146,7 @@ begin if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then Result := inherited GetAsCardinal else - if not MemManager.ReadUnsignedInt(OrdOrDataAddr, Size, Result) then begin + if not MemManager.ReadUnsignedInt(OrdOrDataAddr, Size, Result, Context) then begin Result := 0; // TODO: error SetLastError(MemManager.LastError); end; @@ -2140,6 +2160,19 @@ begin Result := Result + [svfCardinal]; end; +procedure TFpValueDwarfCardinal.SetAsCardinal(AValue: QWord); +var + Size: TFpDbgValueSize; +begin + if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then + inherited SetAsCardinal(AValue) + else + if not MemManager.WriteUnsignedInt(OrdOrDataAddr, Size, AValue, Context) then begin + SetLastError(MemManager.LastError); + end; + Exclude(FEvaluated, doneUInt); +end; + { TFpValueDwarfFloat } function TFpValueDwarfFloat.GetFieldFlags: TFpValueFieldFlags; @@ -2166,7 +2199,7 @@ begin SetLastError(CreateError(fpErrorBadFloatSize)); end else - if not MemManager.ReadFloat(OrdOrDataAddr, Size, Result) then begin + if not MemManager.ReadFloat(OrdOrDataAddr, Size, Result, Context) then begin Result := 0; // TODO: error SetLastError(MemManager.LastError); end; @@ -2187,6 +2220,11 @@ begin Result := QWord(GetAsCardinal) <> 0; end; +procedure TFpValueDwarfBoolean.SetAsBool(AValue: Boolean); +begin + SetAsCardinal(QWord(AValue)); +end; + { TFpValueDwarfChar } function TFpValueDwarfChar.GetFieldFlags: TFpValueFieldFlags; @@ -2249,7 +2287,7 @@ begin if (Size > 0) then begin Addr := OrdOrDataAddr; if not IsNilLoc(Addr) then begin - if not MemManager.ReadAddress(Addr, SizeVal(Context.SizeOfAddress), Result) then + if not MemManager.ReadAddress(Addr, SizeVal(Context.SizeOfAddress), Result, Context) then SetLastError(MemManager.LastError); end; end; @@ -2333,7 +2371,7 @@ begin exit; end; - if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], nil, [mmfPartialRead]) then begin + if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], Context, [mmfPartialRead]) then begin Result := ''; SetLastError(MemManager.LastError); exit; @@ -2369,7 +2407,7 @@ begin exit; end; - if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], nil, [mmfPartialRead]) then begin + if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], Context, [mmfPartialRead]) then begin Result := ''; SetLastError(MemManager.LastError); exit; @@ -2432,6 +2470,12 @@ begin end; end; +procedure TFpValueDwarfPointer.SetAsCardinal(AValue: QWord); +begin + if not MemManager.WriteSignedInt(OrdOrDataAddr, SizeVal(Context.SizeOfAddress), AValue, Context) then + SetLastError(MemManager.LastError); +end; + { TFpValueDwarfEnum } procedure TFpValueDwarfEnum.InitMemberIndex; @@ -2477,7 +2521,7 @@ begin if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then Result := inherited GetAsCardinal else - if not MemManager.ReadEnum(OrdOrDataAddr, Size, Result) then begin + if not MemManager.ReadEnum(OrdOrDataAddr, Size, Result, Context) then begin SetLastError(MemManager.LastError); Result := 0; // TODO: error end; @@ -2485,6 +2529,19 @@ begin FValue := Result; end; +procedure TFpValueDwarfEnum.SetAsCardinal(AValue: QWord); +var + Size: TFpDbgValueSize; +begin + if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then + inherited SetAsCardinal(AValue) + else + if not MemManager.WriteEnum(OrdOrDataAddr, Size, AValue, Context) then begin + SetLastError(MemManager.LastError); + end; + Exclude(FEvaluated, doneUInt); +end; + function TFpValueDwarfEnum.GetAsString: AnsiString; begin InitMemberIndex; @@ -2515,6 +2572,18 @@ begin Result := nil; end; +procedure TFpValueDwarfEnum.SetAsString(AValue: AnsiString); +var + EnumSymbol: TFpSymbol; +begin + EnumSymbol := TypeInfo.NestedSymbolByName[AValue]; + if Assigned(EnumSymbol) then begin + SetAsCardinal(EnumSymbol.OrdinalValue); + end + else + SetLastError(CreateError(fpErrAnyError, ['Not a valid enum-value'])); +end; + { TFpValueDwarfEnumMember } function TFpValueDwarfEnumMember.GetFieldFlags: TFpValueFieldFlags; @@ -2581,7 +2650,7 @@ begin if t = nil then exit; GetDwarfDataAddress(DAddr); - if not MemManager.ReadSet(DAddr, Size, FMem) then begin + if not MemManager.ReadSet(DAddr, Size, FMem, Context) then begin SetLastError(MemManager.LastError); exit; // TODO: error end; @@ -2799,6 +2868,19 @@ begin Result := QWord(LocToAddrOrNil(Addr)); end; +procedure TFpValueDwarfStruct.SetAsCardinal(AValue: QWord); +var + Addr: TFpDbgMemLocation; +begin + Addr := Address; + if not IsValidLoc(Addr) then + SetLastError(CreateError(fpErrFailedWriteMem)) + else begin + if not MemManager.WriteUnsignedInt(Addr, SizeVal(Context.SizeOfAddress), AValue, Context) then + SetLastError(MemManager.LastError); + end; +end; + function TFpValueDwarfStruct.GetDataSize: TFpDbgValueSize; begin Assert((FDataSymbol = nil) or (FDataSymbol.TypeInfo is TFpSymbolDwarf)); @@ -2949,7 +3031,7 @@ end; function TFpValueDwarfArray.GetAsCardinal: QWord; begin // TODO cache - if not MemManager.ReadUnsignedInt(OrdOrAddress, SizeVal(AddressSize), Result) then begin + if not MemManager.ReadUnsignedInt(OrdOrAddress, SizeVal(AddressSize), Result, Context) then begin SetLastError(MemManager.LastError); Result := 0; end; @@ -4829,7 +4911,10 @@ var i: Integer; s, s1, s2: String; begin - if AIndex = '' then + if AIndex = '' then begin + Result := nil; + Exit; + end; s1 := UTF8UpperCase(AIndex); s2 := UTF8LowerCase(AIndex); CreateMembers; diff --git a/components/fpdebug/fpdbgdwarfdataclasses.pas b/components/fpdebug/fpdbgdwarfdataclasses.pas index a286127f3d..2a59ff1376 100644 --- a/components/fpdebug/fpdbgdwarfdataclasses.pas +++ b/components/fpdebug/fpdbgdwarfdataclasses.pas @@ -738,6 +738,7 @@ type procedure PushCopy(AFromIndex: Integer); procedure PushConst(const AVal: TDBGPtr); procedure PushTargetMem(const AVal: TDBGPtr); + procedure PushTargetRegister(const ARegNum: Cardinal); function Peek: PFpDbgMemLocation; function PeekForDeref: PFpDbgMemLocation; function PeekKind: TFpDbgMemLocationType; // Can be called on empty stack @@ -1874,6 +1875,15 @@ begin inc(FCount); end; +procedure TDwarfLocationStack.PushTargetRegister(const ARegNum: Cardinal); +begin + if Length(FList) <= FCount then + IncCapacity; + FList[FCount] := Default(TFpDbgMemLocation); + FList[FCount] := RegisterLoc(ARegNum); + inc(FCount); +end; + function TDwarfLocationStack.Peek: PFpDbgMemLocation; begin Assert(0 < FCount); @@ -2089,11 +2099,12 @@ begin FStack.PushConst(NewValue); end; DW_OP_regx: begin - if not FMemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue, FContext) then begin - SetError; - exit; - end; - FStack.PushConst(NewValue); + //if not FMemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue, FContext) then begin + // SetError; + // exit; + //end; + //FStack.PushConst(NewValue); + FStack.PushTargetRegister(ULEB128toOrdinal(CurData)); end; DW_OP_breg0..DW_OP_breg31: begin diff --git a/components/fpdebug/fpdbghardcodedfreepascalinfo.pas b/components/fpdebug/fpdbghardcodedfreepascalinfo.pas index 2d3f3ae663..9d357d3b12 100644 --- a/components/fpdebug/fpdbghardcodedfreepascalinfo.pas +++ b/components/fpdebug/fpdbghardcodedfreepascalinfo.pas @@ -202,11 +202,11 @@ type function GetClassName: string; end; - { TFpDbgHardcodedContext } + { TFpDbgHardcodedScope } - // Just a hack to simulate a real context, when FindSymbolScope does not return - // a context. - TFpDbgHardcodedContext = class(TFpDbgSymbolScope) + // Just a hack to simulate a real scope, when FindSymbolScope does not return + // a scope. + TFpDbgHardcodedScope = class(TFpDbgSymbolScope) public constructor Create(AMemManager: TFpDbgMemManager; AnAdressSize: Integer; AThreadId: Integer); end; @@ -311,9 +311,9 @@ begin end; end; -{ TFpDbgHardcodedContext } +{ TFpDbgHardcodedScope } -constructor TFpDbgHardcodedContext.Create(AMemManager: TFpDbgMemManager; AnAdressSize: Integer; AThreadId: Integer); +constructor TFpDbgHardcodedScope.Create(AMemManager: TFpDbgMemManager; AnAdressSize: Integer; AThreadId: Integer); begin inherited Create( TFpDbgSimpleLocationContext.Create(AMemManager, 0, AnAdressSize, AThreadId, 0) diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 0fd5e75f51..a0ef63927b 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -121,6 +121,11 @@ type function GetAsWideString: WideString; virtual; function GetAsFloat: Extended; virtual; + procedure SetAsCardinal(AValue: QWord); virtual; + procedure SetAsInteger(AValue: Int64); virtual; + procedure SetAsBool(AValue: Boolean); virtual; + procedure SetAsString(AValue: AnsiString); virtual; + function GetAddress: TFpDbgMemLocation; virtual; function DoGetSize(out ASize: TFpDbgValueSize): Boolean; virtual; function GetDataAddress: TFpDbgMemLocation; virtual; @@ -153,10 +158,10 @@ type property Kind: TDbgSymbolKind read GetKind; property FieldFlags: TFpValueFieldFlags read GetFieldFlags; - property AsInteger: Int64 read GetAsInteger; - property AsCardinal: QWord read GetAsCardinal; - property AsBool: Boolean read GetAsBool; - property AsString: AnsiString read GetAsString; + property AsInteger: Int64 read GetAsInteger write SetAsInteger; + property AsCardinal: QWord read GetAsCardinal write SetAsCardinal; + property AsBool: Boolean read GetAsBool write SetAsBool; + property AsString: AnsiString read GetAsString write SetAsString; property AsWideString: WideString read GetAsWideString; property AsFloat: Extended read GetAsFloat; @@ -488,6 +493,7 @@ type function GetProcedureAtAddress: TFpValue; virtual; function GetMemManager: TFpDbgMemManager; virtual; function GetSizeOfAddress: Integer; virtual; + procedure DoReferenceReleased; override; public constructor Create(ALocationContext: TFpDbgLocationContext); destructor Destroy; override; @@ -536,18 +542,19 @@ type function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer; out ABytesRead: Cardinal): Boolean; override; function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override; function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override; + function WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override; function RegisterSize(ARegNum: Cardinal): Integer; override; procedure SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr); end; - { TFpDbgInfoCallContext } + { TFpDbgInfoAbstractCallContext } // This class is used to represent the context, just after the debugger made // the debugee call some function. // The special addition to make this work is that it is possible to set a // register-value by calling SetRegisterValue. Further this class is an empty // wrapper. - TFpDbgInfoCallContext = class(TFpDbgLocationContext) + TFpDbgAbstractCallContext = class(TFpDbgLocationContext) private FBaseContext: TFpDbgLocationContext; FMemManager: TFpDbgMemManager; @@ -563,6 +570,9 @@ type public constructor Create(const ABaseContext: TFpDbgLocationContext; AMemReader: TFpDbgMemReaderBase; AMemConverter: TFpDbgMemConvertor); destructor Destroy; override; + + function CreateParamSymbol(AParamIndex: Integer; ASymbolType: TFpSymbol): TFpValue; virtual; abstract; + procedure SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr); procedure SetError(const Message: string); property IsValid: Boolean read FIsValid; @@ -658,9 +668,12 @@ begin FRegisterCache[ARegNum].Value := AValue; end; -{ TFpDbgInfoCallContext } +function TFpDbgCallMemReader.WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; +begin + Result := FBaseMemReader.WriteRegister(ARegNum, AValue, AContext); +end; -constructor TFpDbgInfoCallContext.Create( +constructor TFpDbgAbstractCallContext.Create( const ABaseContext: TFpDbgLocationContext; AMemReader: TFpDbgMemReaderBase; AMemConverter: TFpDbgMemConvertor); begin @@ -675,7 +688,7 @@ begin Inherited Create; end; -destructor TFpDbgInfoCallContext.Destroy; +destructor TFpDbgAbstractCallContext.Destroy; begin FMemManager.Free; FMemReader.Free; @@ -683,37 +696,37 @@ begin inherited Destroy; end; -function TFpDbgInfoCallContext.GetAddress: TDbgPtr; +function TFpDbgAbstractCallContext.GetAddress: TDbgPtr; begin Result := FBaseContext.Address; end; -function TFpDbgInfoCallContext.GetMemManager: TFpDbgMemManager; +function TFpDbgAbstractCallContext.GetMemManager: TFpDbgMemManager; begin Result := FMemManager; end; -function TFpDbgInfoCallContext.GetSizeOfAddress: Integer; +function TFpDbgAbstractCallContext.GetSizeOfAddress: Integer; begin Result := FBaseContext.SizeOfAddress; end; -function TFpDbgInfoCallContext.GetStackFrame: Integer; +function TFpDbgAbstractCallContext.GetStackFrame: Integer; begin Result := FBaseContext.StackFrame; end; -function TFpDbgInfoCallContext.GetThreadId: Integer; +function TFpDbgAbstractCallContext.GetThreadId: Integer; begin Result := FBaseContext.ThreadId; end; -procedure TFpDbgInfoCallContext.SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr); +procedure TFpDbgAbstractCallContext.SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr); begin FMemReader.SetRegisterValue(ARegNum, AValue); end; -procedure TFpDbgInfoCallContext.SetError(const Message: string); +procedure TFpDbgAbstractCallContext.SetError(const Message: string); begin FIsValid := False; FMessage := Message; @@ -990,6 +1003,26 @@ begin Result := 0; end; +procedure TFpValue.SetAsCardinal(AValue: QWord); +begin + SetLastError(CreateError(fpErrChangeVariableNotSupported)); +end; + +procedure TFpValue.SetAsInteger(AValue: Int64); +begin + SetLastError(CreateError(fpErrChangeVariableNotSupported)); +end; + +procedure TFpValue.SetAsBool(AValue: Boolean); +begin + SetLastError(CreateError(fpErrChangeVariableNotSupported)); +end; + +procedure TFpValue.SetAsString(AValue: AnsiString); +begin + SetLastError(CreateError(fpErrChangeVariableNotSupported)); +end; + { TPasParserConstNumberSymbolValue } function TFpValueConstNumber.GetKind: TDbgSymbolKind; @@ -1168,6 +1201,11 @@ begin Result := nil; end; +procedure TFpDbgSymbolScope.DoReferenceReleased; +begin + inherited DoReferenceReleased; +end; + function TFpDbgSimpleLocationContext.GetMemManager: TFpDbgMemManager; begin Result := FMemManager; diff --git a/components/fpdebug/fpdbglinuxclasses.pas b/components/fpdebug/fpdbglinuxclasses.pas index f3a84a427a..692cc8f1b3 100644 --- a/components/fpdebug/fpdbglinuxclasses.pas +++ b/components/fpdebug/fpdbglinuxclasses.pas @@ -733,7 +733,28 @@ begin begin case AName of 'rax': FUserRegs.regs64[rax] := AValue; + 'rbx': FUserRegs.regs64[rbx] := AValue; + 'rcx': FUserRegs.regs64[rcx] := AValue; + 'rdx': FUserRegs.regs64[rdx] := AValue; + 'rsi': FUserRegs.regs64[rsi] := AValue; + 'rdi': FUserRegs.regs64[rdi] := AValue; + 'rbp': FUserRegs.regs64[rbp] := AValue; + 'rsp': FUserRegs.regs64[rsp] := AValue; + + 'r8': FUserRegs.regs64[r8] := AValue; + 'r9': FUserRegs.regs64[r9] := AValue; + 'r10': FUserRegs.regs64[r10] := AValue; + 'r11': FUserRegs.regs64[r11] := AValue; + 'r12': FUserRegs.regs64[r12] := AValue; + 'r13': FUserRegs.regs64[r13] := AValue; + 'r14': FUserRegs.regs64[r14] := AValue; + 'r15': FUserRegs.regs64[r15] := AValue; + 'rip': FUserRegs.regs64[rip] := AValue; + + 'cs': FUserRegs.regs64[cs] := AValue; + 'fs': FUserRegs.regs64[fs] := AValue; + 'gs': FUserRegs.regs64[gs] := AValue; else raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]); end; diff --git a/components/fpdebug/fpdebug.lpk b/components/fpdebug/fpdebug.lpk index 8e13a3aab4..9731c483df 100644 --- a/components/fpdebug/fpdebug.lpk +++ b/components/fpdebug/fpdebug.lpk @@ -216,7 +216,11 @@ File(s) with other licenses (see also header in file(s): </Item> <Item> <Filename Value="fpdbghardcodedfreepascalinfo.pas"/> - <UnitName Value="fpdbghardcodedfreepascalinfo"/> + <UnitName Value="FpDbgHardcodedFreepascalInfo"/> + </Item> + <Item> + <Filename Value="fpdbgcallcontextinfo.pas"/> + <UnitName Value="fpdbgcallcontextinfo"/> </Item> </Files> <i18n> diff --git a/components/fpdebug/fpdebug.pas b/components/fpdebug/fpdebug.pas index 23afe86aa7..aea68eca1b 100644 --- a/components/fpdebug/fpdebug.pas +++ b/components/fpdebug/fpdebug.pas @@ -13,7 +13,8 @@ uses macho, FpImgReaderMachoFile, FpImgReaderMacho, FpPascalBuilder, FpDbgInfo, FpdMemoryTools, FpErrorMessages, FPDbgController, FpDbgDwarfVerbosePrinter, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal, fpDbgSymTableContext, fpDbgSymTable, FpDbgAvrClasses, FpDbgDisasAvr, - FpDbgRsp, FpDbgCommon, FpImgReaderWinPETypes, FpDbgHardcodedFreepascalInfo, LazarusPackageIntf; + FpDbgRsp, FpDbgCommon, FpImgReaderWinPETypes, FpDbgHardcodedFreepascalInfo, FpDbgCallContextInfo, + LazarusPackageIntf; implementation diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index 6023ce9062..fa1deb4c98 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/components/fpdebug/fpdmemorytools.pas @@ -100,6 +100,7 @@ type // Register with reduced size are treated as unsigned // TODO: ReadRegister should only take THREAD-ID, not context function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; virtual; abstract; + function WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; virtual; abstract; function RegisterSize(ARegNum: Cardinal): Integer; virtual; abstract; // Registernum from name end; @@ -342,6 +343,11 @@ type const ADest: Pointer; const ADestSize: QWord; AContext: TFpDbgLocationContext; const AFlags: TFpDbgMemManagerFlags = [] ): Boolean; + function WriteMemory(AReadDataType: TFpDbgMemReadDataType; + const ADestLocation: TFpDbgMemLocation; const ADestSize: TFpDbgValueSize; + const ASource: Pointer; const ASourceSize: QWord; AContext: TFpDbgLocationContext; + const AFlags: TFpDbgMemManagerFlags = [] + ): Boolean; public procedure SetCacheManager(ACacheMgr: TFpDbgMemCacheManagerBase); property CacheManager: TFpDbgMemCacheManagerBase read GetCacheManager; @@ -360,6 +366,11 @@ type *) function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext {= nil}): Boolean; + function WriteMemory(const ADestLocation: TFpDbgMemLocation; const ASize: TFpDbgValueSize; + const ASource: Pointer; AContext: TFpDbgLocationContext = nil; + const AFlags: TFpDbgMemManagerFlags = [] + ): Boolean; + // location will be invalid, if read failed function ReadAddress(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; AContext: TFpDbgLocationContext = nil): TFpDbgMemLocation; @@ -375,17 +386,25 @@ type // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean; function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean; inline; + + function WriteUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + const AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean; + //function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: QWord; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean; function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: Int64; AContext: TFpDbgLocationContext = nil): Boolean; inline; + function WriteSignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + const AValue: Int64; AContext: TFpDbgLocationContext = nil): Boolean; //function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: Int64; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean; // //enum/set: may need bitorder swapped function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean; inline; + function WriteEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + const AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean; inline; //function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: QWord; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean; @@ -1438,8 +1457,10 @@ begin SourceReadSize := FMemReader.RegisterSize(Cardinal(ConvData.SourceLocation.Address)); if SourceReadSize = 0 then exit; // failed - if not FMemReader.ReadRegister(Cardinal(ConvData.SourceLocation.Address), TmpVal, AContext) then + if not FMemReader.ReadRegister(Cardinal(ConvData.SourceLocation.Address), TmpVal, AContext) then begin + FLastError := CreateError(fpErrFailedReadRegister); exit; // failed + end end; end; if SourceReadSize > ConvData.SourceSize.Size then @@ -1474,6 +1495,68 @@ begin FLastError := CreateError(fpInternalErrFailedReadMem); end; +function TFpDbgMemManager.WriteMemory(AReadDataType: TFpDbgMemReadDataType; + const ADestLocation: TFpDbgMemLocation; const ADestSize: TFpDbgValueSize; const ASource: Pointer; + const ASourceSize: QWord; AContext: TFpDbgLocationContext; const AFlags: TFpDbgMemManagerFlags + ): Boolean; +var + WriteData, WriteData2: Pointer; + TmpVal: TDbgPtr; + BitOffset, DestExtraSize: Integer; + DestWriteSize, DestFullSize: QWord; +begin + Result := False; + DebugLn(FPDBG_VERBOSE_MEM, ['$WriteMem: ', dbgs(AReadDataType),' ', dbgs(ADestLocation), ' ', dbgs(ADestSize), ' Source ', ASource]); + + if (ADestLocation.MType in [mlfInvalid, mlfUninitialized]) or + (ADestSize <= 0) + then begin + FLastError := CreateError(fpInternalErrCanNotWriteInvalidMem); + exit; + end; + + FLastError := NoError; + if AContext = nil then + AContext := FDefaultContext; + + // ToDo: Use a TargetMemConverter + + BitOffset := ADestLocation.BitOffset; + DestExtraSize := (BitOffset + ADestSize.BitSize + 7) div 8; + + case ADestLocation.MType of + // ToDo: Add the ability to write to memory + mlfTargetRegister: + begin + If (BitOffset <> 0) or (not IsByteSize(ADestSize)) then begin + // Not yet supported + FLastError := CreateError(fpErrCanNotWriteMemAtAddr, [ADestLocation.Address]); + Result := False; + exit; + end; + + DestWriteSize := FMemReader.RegisterSize(Cardinal(ADestLocation.Address)); + if DestWriteSize = 0 then + exit; // failed + + if SizeOf(TmpVal) < DestWriteSize then + Exit; // failed + + move(ASource^, TmpVal, Min(SizeOf(TmpVal), Int64(ASourceSize))); // Little Endian only + + if not FMemReader.WriteRegister(Cardinal(ADestLocation.Address), TmpVal, AContext) then + exit; // failed + + Result := True; + end; + end; + + if (not Result) and (not IsError(FLastError)) then + FLastError := CreateError(fpErrFailedWriteMem); +end; + + + procedure TFpDbgMemManager.SetCacheManager(ACacheMgr: TFpDbgMemCacheManagerBase); begin if FCacheManager = ACacheMgr then exit; @@ -1520,6 +1603,13 @@ begin Result := ReadMemory(rdtRawRead, ASourceLocation, ASize, ADest, ASize.Size, AContext, AFlags); end; +function TFpDbgMemManager.WriteMemory(const ADestLocation: TFpDbgMemLocation; + const ASize: TFpDbgValueSize; const ASource: Pointer; AContext: TFpDbgLocationContext; + const AFlags: TFpDbgMemManagerFlags): Boolean; +begin + Result := WriteMemory(rdtRawRead, ADestLocation, ASize, ASource, ASize.Size, AContext, AFlags); +end; + function TFpDbgMemManager.ReadMemoryEx( const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: TFpDbgValueSize; ADest: Pointer; AContext: TFpDbgLocationContext @@ -1589,6 +1679,12 @@ begin Result := ReadMemory(rdtUnsignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); end; +function TFpDbgMemManager.WriteUnsignedInt(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; const AValue: QWord; AContext: TFpDbgLocationContext): Boolean; +begin + Result := WriteMemory(rdtUnsignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); +end; + function TFpDbgMemManager.ReadSignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: Int64; AContext: TFpDbgLocationContext ): Boolean; @@ -1596,6 +1692,12 @@ begin Result := ReadMemory(rdtSignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); end; +function TFpDbgMemManager.WriteSignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + const AValue: Int64; AContext: TFpDbgLocationContext): Boolean; +begin + Result := WriteMemory(rdtSignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); +end; + function TFpDbgMemManager.ReadEnum(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgLocationContext ): Boolean; @@ -1603,6 +1705,12 @@ begin Result := ReadMemory(rdtEnum, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); end; +function TFpDbgMemManager.WriteEnum(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + const AValue: QWord; AContext: TFpDbgLocationContext): Boolean; +begin + Result := WriteMemory(rdtEnum, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); +end; + function TFpDbgMemManager.ReadSet(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: TBytes; AContext: TFpDbgLocationContext ): Boolean; @@ -1678,6 +1786,7 @@ begin Result := True; end; + initialization FPDBG_VERBOSE_MEM := DebugLogger.FindOrRegisterLogGroup('FPDBG_VERBOSE_MEM' {$IFDEF FPDBG_VERBOSE_MEM} , True {$ENDIF} ); diff --git a/components/fpdebug/fperrormessages.pas b/components/fpdebug/fperrormessages.pas index f78c4c5684..727d46439d 100644 --- a/components/fpdebug/fperrormessages.pas +++ b/components/fpdebug/fperrormessages.pas @@ -32,6 +32,7 @@ resourcestring MsgfpErrReadMemSizeLimit = 'Memory read size exceeds limit'; MsgfpErrCanNotReadMemAtAddr = 'Failed to read Mem at Address $%1:x'; MsgfpErrFailedReadRegiseter = 'Failed to read data from register'; + MsgfpInternalErrFailedWriteMem = 'Failed to write data'; // 200 LocationParser MsgfpErrLocationParser = 'Internal Error: Cannot calculate location.'; MsgfpErrLocationParserMemRead = '%1:s (while calculating location)'; // Pass on nested error @@ -56,6 +57,7 @@ const fpErrInvalidNumber = TFpErrorCode(28); fpErrCannotDereferenceType = TFpErrorCode(29); fpErrTypeHasNoIndex = TFpErrorCode(30); + fpErrChangeVariableNotSupported = TFpErrorCode(31); // 100 memreader error fpInternalErrFailedReadMem = TFpErrorCode(100); @@ -63,6 +65,9 @@ const fpErrReadMemSizeLimit = TFpErrorCode(102); fpErrCanNotReadMemAtAddr = TFpErrorCode(103); fpErrFailedReadRegister = TFpErrorCode(104); + fpInternalErrCanNotWriteInvalidMem= TFpErrorCode(105); + fpErrFailedWriteMem = TFpErrorCode(106); + fpErrCanNotWriteMemAtAddr = TFpErrorCode(107); // 200 LocationParser fpErrLocationParser = TFpErrorCode(200); @@ -200,6 +205,7 @@ begin fpInternalErrFailedReadMem: Result := MsgfpInternalErrfpErrFailedReadMem; fpErrCanNotReadMemAtAddr: Result := MsgfpErrCanNotReadMemAtAddr; fpErrFailedReadRegister: Result := MsgfpErrFailedReadRegiseter; + fpErrFailedWriteMem: Result := MsgfpInternalErrFailedWriteMem; fpErrLocationParser: Result := MsgfpErrLocationParser; fpErrLocationParserMemRead: Result := MsgfpErrLocationParserMemRead; diff --git a/components/fpdebug/languages/fperrormessages.pot b/components/fpdebug/languages/fperrormessages.pot index d7157084ef..62e1d91840 100644 --- a/components/fpdebug/languages/fperrormessages.pot +++ b/components/fpdebug/languages/fperrormessages.pot @@ -101,6 +101,10 @@ msgstr "" msgid "Internal error: Missing data location" msgstr "" +#: fperrormessages.msgfpinternalerrfailedwritemem +msgid "Failed to write data" +msgstr "" + #: fperrormessages.msgfpinternalerrfperrfailedreadmem msgid "Internal error: Failed to read data from memory" msgstr "" diff --git a/components/fpdebug/languages/fperrormessages.pt_BR.po b/components/fpdebug/languages/fperrormessages.pt_BR.po index 70b1ed50a4..de5c0ae235 100644 --- a/components/fpdebug/languages/fperrormessages.pt_BR.po +++ b/components/fpdebug/languages/fperrormessages.pt_BR.po @@ -112,6 +112,10 @@ msgstr "Impossível acessar elemento indexado na expressão %1:s" msgid "Internal error: Missing data location" msgstr "Erro interno: Localização dos dados faltando" +#: fperrormessages.msgfpinternalerrfailedwritemem +msgid "Failed to write data" +msgstr "" + #: fperrormessages.msgfpinternalerrfperrfailedreadmem msgid "Internal error: Failed to read data from memory" msgstr "Erro interno: Falha ao ler dados da memória" diff --git a/components/fpdebug/languages/fperrormessages.ru.po b/components/fpdebug/languages/fperrormessages.ru.po index be9e0c8714..d842ec383e 100644 --- a/components/fpdebug/languages/fperrormessages.ru.po +++ b/components/fpdebug/languages/fperrormessages.ru.po @@ -111,6 +111,10 @@ msgstr "Невозможно получить доступ к элементу msgid "Internal error: Missing data location" msgstr "Внутренняя ошибка: неизвестно расположение данных" +#: fperrormessages.msgfpinternalerrfailedwritemem +msgid "Failed to write data" +msgstr "" + #: fperrormessages.msgfpinternalerrfperrfailedreadmem msgid "Internal error: Failed to read data from memory" msgstr "Внутренняя ошибка: не удалось прочитать данные из памяти"