LLDB Debugger: register

git-svn-id: trunk@58330 -

components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas

@@ -422,15 +422,6 @@ var
 begin
   Result := False;
 
-  InStr := TLldbInstructionRegister.Create(AContext.ThreadId, AContext.StackFrame);
-  InStr.AddReference;
-  FDebugger.DebugInstructionQueue.QueueInstruction(InStr);
-  while not InStr.IsCompleted do begin
-    Application.ProcessMessages;
-    sleep(30);
-  end;
-
-
   // WINDOWS gdb dwarf names
   {$IFDEF cpu64}
   case ARegNum of
@@ -471,11 +462,25 @@ begin
   {$ENDIF}
   assert(AContext <> nil, 'TFpLldbDbgMemReader.ReadRegister: AContext <> nil');
 
-  v := InStr.Res.Values[rname];
+  Reg := FDebugger.Registers.CurrentRegistersList[AContext.ThreadId, AContext.StackFrame];
-  InStr.ReleaseReference;
+  for i := 0 to Reg.Count - 1 do
-
+    if UpperCase(Reg[i].Name) = rname then
-  AValue := StrToQWordDef(v, 0);
+      begin
-  Result := True;
+        RegVObj := Reg[i].ValueObjFormat[rdDefault];
+        if RegVObj <> nil then
+          v := RegVObj.Value[rdDefault]
+        else
+          v := '';
+        if pos(' ', v) > 1 then v := copy(v, 1, pos(' ', v)-1);
+debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDbgMemReader.ReadRegister ',rname, '  ', v]);
+        Result := true;
+        try
+          AValue := StrToQWord(v);
+        except
+          Result := False;
+        end;
+        exit;
+      end;
 end;
 
 function TFpLldbDbgMemReader.RegisterSize(ARegNum: Cardinal): Integer;

components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas

@@ -154,7 +154,7 @@ type
     function  CreateBreakPoints: TDBGBreakPoints; override;
     //function  CreateLocals: TLocalsSupplier; override;
     //function  CreateLineInfo: TDBGLineInfo; override;
-    //function  CreateRegisters: TRegisterSupplier; override;
+    function  CreateRegisters: TRegisterSupplier; override;
     function  CreateCallStack: TCallStackSupplier; override;
     //function  CreateDisassembler: TDBGDisassembler; override;
     function  CreateWatches: TWatchesSupplier; override;
@@ -228,11 +228,13 @@ type
   TLldbDebuggerCommandCallStack = class(TLldbDebuggerCommand)
   private
     FCurrentCallStack: TCallStackBase;
+    procedure DoCallstackFreed(Sender: TObject);
     procedure StackInstructionFinished(Sender: TObject);
   protected
     procedure DoExecute; override;
   public
-    property  CurrentCallStack: TCallStackBase read FCurrentCallStack write FCurrentCallStack;
+    property  CurrentCallStack: TCallStackBase read FCurrentCallStack;
+    constructor Create(AOwner: TLldbDebugger; ACurrentCallStack: TCallStackBase);
   end;
 
   { TLldbCallStack }
@@ -252,6 +254,11 @@ type
 
   {%endregion   ^^^^^  CallStack  ^^^^^   }
 
+  {%region
+    *****
+    *****     Watches
+    ***** }
+
   { TLldbWatches }
 
   TLldbWatches = class(TWatchesSupplier)
@@ -261,6 +268,13 @@ type
   public
   end;
 
+  {%endregion   ^^^^^  Watches  ^^^^^   }
+
+  {%region
+    *****
+    *****     BreakPoint
+    ***** }
+
   { TLldbBreakPoint }
 
   TLldbBreakPoint = class(TDBGBreakPoint)
@@ -285,6 +299,37 @@ type
 //    function FindById(AnId: Integer): TGDBMIBreakPoint;
   end;
 
+  {%endregion   ^^^^^  BreakPoint  ^^^^^   }
+
+  {%region
+    *****
+    *****     Register
+    ***** }
+
+  { TLldbDebuggerCommandRegister }
+
+  TLldbDebuggerCommandRegister = class(TLldbDebuggerCommand)
+  private
+    FRegisters: TRegisters;
+    procedure RegisterInstructionFinished(Sender: TObject);
+  protected
+    procedure DoExecute; override;
+  public
+    constructor Create(AOwner: TLldbDebugger; ARegisters: TRegisters);
+    destructor Destroy; override;
+    property Registers: TRegisters read FRegisters;
+  end;
+
+  { TLldbRegisterSupplier }
+
+  TLldbRegisterSupplier = class(TRegisterSupplier)
+  public
+    procedure Changed;
+    procedure RequestData(ARegisters: TRegisters); override;
+  end;
+
+  {%endregion   ^^^^^  Register  ^^^^^   }
+
 {%region
   *****
   *****     Threads
@@ -396,7 +441,12 @@ var
   IsCur: Boolean;
   addr: TDBGPtr;
 begin
-  It := TMapIterator.Create(Instr.Callstack.RawEntries);
+  if FCurrentCallStack = nil then begin
+    Finished;
+    exit;
+  end;
+
+  It := TMapIterator.Create(FCurrentCallStack.RawEntries);
 
   for i := 0 to Length(Instr.Res) - 1 do begin
     s := Instr.Res[i];
@@ -408,25 +458,44 @@ begin
   end;
   It.Free;
 
-  TLldbCallStack(Debugger.CallStack).ParentRequestEntries(Instr.Callstack);
+  TLldbCallStack(Debugger.CallStack).ParentRequestEntries(FCurrentCallStack);
 
   Finished;
 end;
 
+procedure TLldbDebuggerCommandCallStack.DoCallstackFreed(Sender: TObject);
+begin
+  FCurrentCallStack := nil;
+  //cancel
+end;
+
 procedure TLldbDebuggerCommandCallStack.DoExecute;
 var
   StartIdx, EndIdx: Integer;
   Instr: TLldbInstructionStackTrace;
 begin
+  if FCurrentCallStack = nil then begin
+    Finished;
+    exit;
+  end;
+
   StartIdx := Max(FCurrentCallStack.LowestUnknown, 0);
   EndIdx   := FCurrentCallStack.HighestUnknown;
 
-  Instr := TLldbInstructionStackTrace.Create(EndIdx, FCurrentCallStack);
+  Instr := TLldbInstructionStackTrace.Create(EndIdx, FCurrentCallStack.ThreadId);
   Instr.OnFinish := @StackInstructionFinished;
   QueueInstruction(Instr);
   Instr.ReleaseReference;
 end;
 
+constructor TLldbDebuggerCommandCallStack.Create(AOwner: TLldbDebugger;
+  ACurrentCallStack: TCallStackBase);
+begin
+  inherited Create(AOwner);
+  FCurrentCallStack := ACurrentCallStack;
+  FCurrentCallStack.AddFreeNotification(@DoCallstackFreed);
+end;
+
 { TLldbCallStack }
 
 procedure TLldbCallStack.ParentRequestEntries(ACallstack: TCallStackBase);
@@ -487,8 +556,7 @@ begin
   if not (Debugger.State in [dsPause, dsInternalPause]) then
     exit;
 
-  Cmd := TLldbDebuggerCommandCallStack.Create(TLldbDebugger(Debugger));
+  Cmd := TLldbDebuggerCommandCallStack.Create(TLldbDebugger(Debugger), ACallstack);
-  Cmd.CurrentCallStack := ACallstack;
   TLldbDebugger(Debugger).QueueCommand(Cmd);
   Cmd.ReleaseReference;
 end;
@@ -575,6 +643,87 @@ begin
     SetBreakPoint;
 end;
 
+  {%region
+    *****
+    *****     Register
+    ***** }
+
+{ TLldbDebuggerCommandRegister }
+
+procedure TLldbDebuggerCommandRegister.RegisterInstructionFinished(
+  Sender: TObject);
+var
+  Instr: TLldbInstructionRegister absolute Sender;
+  RegVal: TRegisterValue;
+  n: String;
+  i: Integer;
+begin
+  if not Instr.IsSuccess then begin
+    if FRegisters.DataValidity in [ddsRequested, ddsEvaluating] then
+      FRegisters.DataValidity := ddsInvalid;
+    exit;
+  end;
+
+  FRegisters.DataValidity := ddsEvaluating;
+
+  for i := 0 to Instr.Res.Count - 1 do begin
+    n := Instr.Res.Names[i];
+    RegVal := FRegisters.EntriesByName[n];
+    RegVal.Value := Instr.Res.Values[n];
+    RegVal.DataValidity := ddsValid;
+  end;
+
+  FRegisters.DataValidity := ddsValid;
+  Finished;
+end;
+
+procedure TLldbDebuggerCommandRegister.DoExecute;
+var
+  Instr: TLldbInstructionRegister;
+begin
+  // TODO: store thread/frame when command is created
+  Instr := TLldbInstructionRegister.Create(Debugger.FCurrentThreadId, Debugger.FCurrentStackFrame);
+  Instr.OnFinish := @RegisterInstructionFinished;
+  QueueInstruction(Instr);
+  Instr.ReleaseReference;
+end;
+
+constructor TLldbDebuggerCommandRegister.Create(AOwner: TLldbDebugger;
+  ARegisters: TRegisters);
+begin
+  FRegisters := ARegisters;
+  FRegisters.AddReference;
+  inherited Create(AOwner);
+end;
+
+destructor TLldbDebuggerCommandRegister.Destroy;
+begin
+  ReleaseRefAndNil(FRegisters);
+  inherited Destroy;
+end;
+
+{ TLldbRegisterSupplier }
+
+procedure TLldbRegisterSupplier.Changed;
+begin
+  if CurrentRegistersList <> nil
+  then CurrentRegistersList.Clear;
+end;
+
+procedure TLldbRegisterSupplier.RequestData(ARegisters: TRegisters);
+var
+  Cmd: TLldbDebuggerCommandRegister;
+begin
+  if (Debugger = nil) or not(Debugger.State in [dsPause, dsStop]) then
+    exit;
+
+  Cmd := TLldbDebuggerCommandRegister.Create(TLldbDebugger(Debugger), ARegisters);
+  TLldbDebugger(Debugger).QueueCommand(Cmd);
+  Cmd.ReleaseReference;
+end;
+
+  {%endregion   ^^^^^  Register  ^^^^^   }
+
 { TLldbDebuggerCommandQueue }
 
 function TLldbDebuggerCommandQueue.Get(Index: Integer): TLldbDebuggerCommand;
@@ -997,6 +1146,11 @@ begin
   Result := TLldbBreakPoints.Create(Self, TLldbBreakPoint);
 end;
 
+function TLldbDebugger.CreateRegisters: TRegisterSupplier;
+begin
+  Result := TLldbRegisterSupplier.Create(Self);
+end;
+
 function TLldbDebugger.CreateCallStack: TCallStackSupplier;
 begin
   Result := TLldbCallStack.Create(Self);

components/lazdebuggers/lazdebuggerlldb/lldbinstructions.pas

@@ -209,16 +209,14 @@ type
 
   TLldbInstructionStackTrace = class(TLldbInstruction)
   private
-    FCallstack: TCallStackBase;
     FRes: TStringArray;
     FReading: Boolean;
   protected
     procedure SendCommandDataToDbg(); override;
     function ProcessInputFromDbg(const AData: String): Boolean; override;
   public
-    constructor Create(FrameCount: Integer; ACallstack: TCallStackBase);
+    constructor Create(FrameCount: Integer; AThread: Integer);
     property Res: TStringArray read FRes;
-    property Callstack: TCallStackBase read FCallstack;
   end;
 
 implementation
@@ -821,10 +819,9 @@ begin
 end;
 
 constructor TLldbInstructionStackTrace.Create(FrameCount: Integer;
-  ACallstack: TCallStackBase);
+  AThread: Integer);
 begin
-  FCallstack := ACallstack;
+  inherited Create(Format('bt %d', [FrameCount]), AThread);
-  inherited Create(Format('bt %d', [FrameCount]), ACallstack.ThreadId);
 end;
 
 end.