FpDebug: Renamed TFpDbgHardcodedContext to TFpDbgHardcodedScope

git-svn-id: trunk@63899 -

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;

components/fpdebug/fpdbgcontroller.pas

@@ -11,8 +11,8 @@ uses
   Maps,
   LazLoggerBase, LazClasses,
   DbgIntfBaseTypes, DbgIntfDebuggerBase,
-  FpDbgDisasX86, FpDbgUtil,
+  FpDbgDisasX86,
-  FpDbgClasses,
+  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;
 

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;

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
+          //if not FMemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue, FContext) then begin
-            SetError;
+          //  SetError;
-            exit;
+          //  exit;
-          end;
+          //end;
-          FStack.PushConst(NewValue);
+          //FStack.PushConst(NewValue);
+          FStack.PushTargetRegister(ULEB128toOrdinal(CurData));
         end;
 
       DW_OP_breg0..DW_OP_breg31: begin

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
+  // Just a hack to simulate a real scope, when FindSymbolScope does not return
-  // a context.
+  // a scope.
-  TFpDbgHardcodedContext = class(TFpDbgSymbolScope)
+  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)

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 AsInteger: Int64 read GetAsInteger write SetAsInteger;
-    property AsCardinal: QWord read GetAsCardinal;
+    property AsCardinal: QWord read GetAsCardinal write SetAsCardinal;
-    property AsBool: Boolean read GetAsBool;
+    property AsBool: Boolean read GetAsBool write SetAsBool;
-    property AsString: AnsiString read GetAsString;
+    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;

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;

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>

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
 

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} );
 

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;

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 ""

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"

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 "Внутренняя ошибка: не удалось прочитать данные из памяти"