lldb debugger: locals / fixes crash in stack

git-svn-id: trunk@58438 -

components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas

@@ -95,6 +95,21 @@ type
     procedure DoExecute; override;
   end;
 
+  { TLldbDebuggerCommandLocals }
+
+  TLldbDebuggerCommandLocals = class(TLldbDebuggerCommand)
+  private
+    FLocals: TLocals;
+    FLocalsInstr: TLldbInstructionLocals;
+    procedure DoLocalsFreed(Sender: TObject);
+    procedure LocalsInstructionFinished(Sender: TObject);
+  protected
+    procedure DoExecute; override;
+  public
+    constructor Create(AOwner: TLldbDebugger; ALocals: TLocals);
+    destructor Destroy; override;
+  end;
+
   { TLldbDebuggerCommandEvaluate }
 
   TLldbDebuggerCommandEvaluate = class(TLldbDebuggerCommand)
@@ -153,7 +168,7 @@ type
     property CommandQueue: TLldbDebuggerCommandQueue read FCommandQueue;
   protected
     function  CreateBreakPoints: TDBGBreakPoints; override;
-    //function  CreateLocals: TLocalsSupplier; override;
+    function  CreateLocals: TLocalsSupplier; override;
     //function  CreateLineInfo: TDBGLineInfo; override;
     function  CreateRegisters: TRegisterSupplier; override;
     function  CreateCallStack: TCallStackSupplier; override;
@@ -257,6 +272,20 @@ type
 
   {%endregion   ^^^^^  CallStack  ^^^^^   }
 
+  {%region
+    *****
+    *****     Locals
+    ***** }
+
+  { TLldbLocals }
+
+  TLldbLocals = class(TLocalsSupplier)
+  public
+    procedure RequestData(ALocals: TLocals); override;
+  end;
+
+  {%endregion   ^^^^^  Locals  ^^^^^   }
+
   {%region
     *****
     *****     Watches
@@ -344,6 +373,68 @@ type
     procedure RequestData(ARegisters: TRegisters); override;
   end;
 
+{ TLldbDebuggerCommandLocals }
+
+procedure TLldbDebuggerCommandLocals.LocalsInstructionFinished(Sender: TObject
+  );
+var
+  n: String;
+  i: Integer;
+begin
+  if FLocals <> nil then begin
+    FLocals.Clear;
+    for i := 0 to FLocalsInstr.Res.Count - 1 do begin
+      n := FLocalsInstr.Res.Names[i];
+      FLocals.Add(n, FLocalsInstr.Res.Values[n]);
+    end;
+    FLocals.SetDataValidity(ddsValid);
+  end;
+
+  ReleaseRefAndNil(FLocalsInstr);
+  Finished;
+end;
+
+procedure TLldbDebuggerCommandLocals.DoLocalsFreed(Sender: TObject);
+begin
+  FLocals := nil;
+  if FLocalsInstr <> nil then begin
+    FLocalsInstr.OnFinish := nil;
+    FLocalsInstr.Cancel;
+    ReleaseRefAndNil(FLocalsInstr);
+    Finished;
+  end;
+end;
+
+procedure TLldbDebuggerCommandLocals.DoExecute;
+begin
+  if FLocalsInstr <> nil then begin
+    FLocalsInstr.OnFinish := nil;
+    ReleaseRefAndNil(FLocalsInstr);
+  end;
+  FLocalsInstr := TLldbInstructionLocals.Create();
+  FLocalsInstr.OnFinish := @LocalsInstructionFinished;
+  TLldbDebugger(Debugger).DebugInstructionQueue.QueueInstruction(FLocalsInstr);
+end;
+
+constructor TLldbDebuggerCommandLocals.Create(AOwner: TLldbDebugger;
+  ALocals: TLocals);
+begin
+  FLocals := ALocals;
+  FLocals.AddFreeNotification(@DoLocalsFreed);
+  inherited Create(AOwner);
+end;
+
+destructor TLldbDebuggerCommandLocals.Destroy;
+begin
+  if FLocalsInstr <> nil then begin
+    FLocalsInstr.OnFinish := nil;
+    ReleaseRefAndNil(FLocalsInstr);
+  end;
+  if FLocals <> nil then
+    FLocals.RemoveFreeNotification(@DoLocalsFreed);
+  inherited Destroy;
+end;
+
   {%endregion   ^^^^^  Register  ^^^^^   }
 
 {%region
@@ -484,7 +575,7 @@ end;
 procedure TLldbDebuggerCommandCallStack.DoCallstackFreed(Sender: TObject);
 begin
   FCurrentCallStack := nil;
-  //cancel
+  //TODO cancel
 end;
 
 procedure TLldbDebuggerCommandCallStack.DoExecute;
@@ -520,7 +611,8 @@ end;
 
 destructor TLldbDebuggerCommandCallStack.Destroy;
 begin
-  FCurrentCallStack.RemoveFreeeNotification(@DoCallstackFreed);
+  if FCurrentCallStack <> nil then
+    FCurrentCallStack.RemoveFreeNotification(@DoCallstackFreed);
   inherited Destroy;
 end;
 
@@ -591,12 +683,27 @@ end;
 
 {%endregion   ^^^^^  CallStack  ^^^^^   }
 
+{ TLldbLocals }
+
+procedure TLldbLocals.RequestData(ALocals: TLocals);
+var
+  Cmd: TLldbDebuggerCommandLocals;
+begin
+  if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
+
+  Cmd := TLldbDebuggerCommandLocals.Create(TLldbDebugger(Debugger), ALocals);
+  TLldbDebugger(Debugger).QueueCommand(Cmd);
+  Cmd.ReleaseReference;
+end;
+
 { TLldbWatches }
 
 procedure TLldbWatches.InternalRequestData(AWatchValue: TWatchValue);
 var
   Cmd: TLldbDebuggerCommandEvaluate;
 begin
+  if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
+
   Cmd := TLldbDebuggerCommandEvaluate.Create(TLldbDebugger(Debugger), AWatchValue);
   TLldbDebugger(Debugger).QueueCommand(Cmd);
   Cmd.ReleaseReference;
@@ -1464,6 +1571,11 @@ begin
   Result := TLldbBreakPoints.Create(Self, TLldbBreakPoint);
 end;
 
+function TLldbDebugger.CreateLocals: TLocalsSupplier;
+begin
+  Result := TLldbLocals.Create(Self);
+end;
+
 function TLldbDebugger.CreateRegisters: TRegisterSupplier;
 begin
   Result := TLldbRegisterSupplier.Create(Self);

components/lazdebuggers/lazdebuggerlldb/lldbinstructions.pas

@@ -190,12 +190,35 @@ type
     constructor Create(AnIndex: Integer);
   end;
 
+  { TLldbInstructionValueBase }
+
+  TLldbInstructionValueBase = class(TLldbInstruction)
+  private
+    FCurly: Integer;
+  protected
+    function ParseStruct(ALine: string): Boolean;
+  end;
+
+  { TLldbInstructionLocals }
+
+  TLldbInstructionLocals = class(TLldbInstructionValueBase)
+  private
+    FRes: TStringList;
+    FCurVal, FCurName: String;
+  protected
+    function ProcessInputFromDbg(const AData: String): Boolean; override;
+    procedure SendCommandDataToDbg(); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property Res: TStringList read FRes;
+  end;
+
   { TLldbInstructionExpression }
 
-  TLldbInstructionExpression = class(TLldbInstruction)
+  TLldbInstructionExpression = class(TLldbInstructionValueBase)
   private
     FRes: String;
-    FCurly: Integer;
   protected
     function ProcessInputFromDbg(const AData: String): Boolean; override;
   public
@@ -268,6 +291,25 @@ type
 
 implementation
 
+{ TLldbInstructionValueBase }
+
+function TLldbInstructionValueBase.ParseStruct(ALine: string): Boolean;
+var
+  i: Integer;
+begin
+  i := 1;
+  while i <= Length(ALine) do begin
+    case ALine[i] of
+      '"': break; // string always goes to end of line
+      '{': inc(FCurly);
+      '}': dec(FCurly);
+    end;
+    inc(i);
+    if FCurly<0 then debugln(['ParseStruct curly too low ', FCurly]);
+  end;
+  Result := FCurly <= 0;
+end;
+
 { TLldbInstructionBreakOrWatchSet }
 
 function TLldbInstructionBreakOrWatchSet.ProcessInputFromDbg(const AData: String
@@ -688,26 +730,67 @@ begin
   inherited Create(Format('frame select %d', [AnIndex]));
 end;
 
+{ TLldbInstructionLocals }
+
+function TLldbInstructionLocals.ProcessInputFromDbg(const AData: String
+  ): Boolean;
+var
+  found: TStringArray;
+begin
+  Result := True;
+
+  if StrStartsWith(AData, 'version') then begin
+    MarkAsSuccess;
+    Exit;
+  end;
+
+  if FCurVal <> '' then begin
+    FCurVal := FCurVal + AData;
+    if ParseStruct(AData) then begin
+      FRes.Values[FCurName] := FCurVal;
+      FCurName := '';
+      FCurVal := '';
+    end;
+    exit;
+  end;
+
+  if StrMatches(AData, ['(', ')', ' = ', ''], found) then begin
+    FCurName := found[1];
+    FCurVal := found[2];
+    FCurly := 0;
+    if ParseStruct(found[2]) then begin
+      FRes.Values[FCurName] := FCurVal;
+      FCurName := '';
+      FCurVal := '';
+    end;
+    exit;
+  end;
+
+  Result := inherited ProcessInputFromDbg(AData);
+end;
+
+procedure TLldbInstructionLocals.SendCommandDataToDbg();
+begin
+  inherited SendCommandDataToDbg();
+  Queue.SendDataToDBG(Self, 'version'); // end marker // do not sent before new prompt
+end;
+
+constructor TLldbInstructionLocals.Create;
+begin
+  inherited Create('frame variable -P 1 -D 5'); // TODO: make -D 5 configurable
+  FRes := TStringList.Create;
+end;
+
+destructor TLldbInstructionLocals.Destroy;
+begin
+  inherited Destroy;
+  FRes.Free;
+end;
+
 { TLldbInstructionExpression }
 
 function TLldbInstructionExpression.ProcessInputFromDbg(const AData: String
   ): Boolean;
-  function ParseStruct(ALine: string): Boolean;
-  var
-    i: Integer;
-  begin
-    i := 1;
-    while i <= Length(ALine) do begin
-      case ALine[i] of
-        '"': break; // string always goes to end of line
-        '{': inc(FCurly);
-        '}': dec(FCurly);
-      end;
-      inc(i);
-if FCurly<0 then debugln(['ParseStruct curly too low ', FCurly]);
-    end;
-    Result := FCurly = 0;
-  end;
 var
   found: TStringArray;
 begin