LLDB-FP Debugger: New debugger based on lldb with fpdebug / alpha

git-svn-id: trunk@58277 -

.gitattributes

@@ -2552,6 +2552,9 @@ components/lazdebuggers/lazdebuggerfpgdbmi/test/TestFpGdbmi.lpr svneol=native#te
 components/lazdebuggers/lazdebuggerfpgdbmi/test/fpclist.txt.sample svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfpgdbmi/test/gdblist.txt.sample svneol=native#text/plain
 components/lazdebuggers/lazdebuggerfpgdbmi/test/testwatches.pas svneol=native#text/pascal
+components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas svneol=native#text/plain
+components/lazdebuggers/lazdebuggerfplldb/lazdebuggerfplldb.lpk svneol=native#text/plain
+components/lazdebuggers/lazdebuggerfplldb/lazdebuggerfplldb.pas svneol=native#text/plain
 components/lazdebuggers/lazdebuggerlldb/lazdebuggerlldb.lpk svneol=native#text/plain
 components/lazdebuggers/lazdebuggerlldb/lazdebuggerlldb.pas svneol=native#text/plain
 components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas svneol=native#text/plain

components/lazdebuggers/lazdebuggerfplldb/lazdebuggerfplldb.lpk

@@ -0,0 +1,42 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="LazDebuggerFpLldb"/>
+    <Type Value="RunAndDesignTime"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Other>
+        <CustomOptions Value="$(IDEBuildOptions)"/>
+      </Other>
+    </CompilerOptions>
+    <Files Count="1">
+      <Item1>
+        <Filename Value="fplldbdebugger.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="FpLldbDebugger"/>
+      </Item1>
+    </Files>
+    <RequiredPkgs Count="3">
+      <Item1>
+        <PackageName Value="fpdebug"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LazDebuggerLldb"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+      </Item3>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

components/lazdebuggers/lazdebuggerfplldb/lazdebuggerfplldb.pas

@@ -0,0 +1,22 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit LazDebuggerFpLldb;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  FpLldbDebugger, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+  RegisterUnit('FpLldbDebugger', @FpLldbDebugger.Register);
+end;
+
+initialization
+  RegisterPackage('LazDebuggerFpLldb', @Register);
+end.

components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas

@@ -26,6 +26,7 @@ type
   TLldbDebuggerCommandQueue = class(TRefCntObjList)
   private
     FDebugger: TLldbDebugger;
+    FLockQueueRun: Integer;
     function Get(Index: Integer): TLldbDebuggerCommand;
     procedure Put(Index: Integer; const AValue: TLldbDebuggerCommand);
   private
@@ -36,6 +37,8 @@ type
   public
     constructor Create(ADebugger: TLldbDebugger);
     destructor Destroy; override;
+    procedure LockQueueRun;
+    procedure UnLockQueueRun;
     property Items[Index: Integer]: TLldbDebuggerCommand read Get write Put; default;
     procedure QueueCommand(AValue: TLldbDebuggerCommand);
   end;
@@ -46,11 +49,11 @@ type
   private
     FOwner: TLldbDebugger;
     function GetDebuggerState: TDBGState;
-    procedure Finished;
     function GetCommandQueue: TLldbDebuggerCommandQueue;
     function GetInstructionQueue: TLldbInstructionQueue;
   protected
     procedure DoExecute; virtual; abstract;
+    procedure Finished;
 
     procedure InstructionSucceeded(AnInstruction: TObject);
     procedure InstructionFailed(AnInstruction: TObject);
@@ -128,19 +131,25 @@ type
 
     procedure DoAfterLineReceived(var ALine: String);
     procedure DoBeforeLineReceived(var ALine: String);
-    procedure DoBeginReceivingLines(Sender: TObject);
     procedure DoCmdLineDebuggerTerminated(Sender: TObject);
-    procedure DoEndReceivingLines(Sender: TObject);
     function  LldbRun: Boolean;
     function  LldbStep(AStepAction: TLldbInstructionProcessStepAction): Boolean;
     function  LldbStop: Boolean;
     function  LldbEvaluate(const AExpression: String; EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
   protected
+    procedure DoBeginReceivingLines(Sender: TObject);
+    procedure DoEndReceivingLines(Sender: TObject);
     procedure LockRelease; override;
     procedure UnlockRelease; override;
+    procedure QueueCommand(const ACommand: TLldbDebuggerCommand);
     procedure SetState(const AValue: TDBGState);
     //procedure DoState(const OldState: TDBGState); override;
     //procedure DoBeforeState(const OldState: TDBGState); override;
+    property CurrentThreadId: Integer read FCurrentThreadId;
+    property CurrentStackFrame: Integer read FCurrentStackFrame;
+    property CurrentLocation: TDBGLocationRec read FCurrentLocation;
+    property DebugInstructionQueue: TLldbInstructionQueue read FDebugInstructionQueue;
+    property CommandQueue: TLldbDebuggerCommandQueue read FCommandQueue;
   protected
     function  CreateBreakPoints: TDBGBreakPoints; override;
     //function  CreateLocals: TLocalsSupplier; override;
@@ -168,13 +177,6 @@ type
 
     function GetLocation: TDBGLocationRec; override;
 //    function GetProcessList({%H-}AList: TRunningProcessInfoList): boolean; override;
-
-//    //LockCommandProcessing is more than just QueueExecuteLock
-//    //LockCommandProcessing also takes care to run the queue, if unlocked and not already running
-//    procedure LockCommandProcessing; override;
-//    procedure UnLockCommandProcessing; override;
-
-
 //    function NeedReset: Boolean; override;
   end;
 
@@ -354,7 +356,7 @@ var
   Cmd: TLldbDebuggerCommandEvaluate;
 begin
   Cmd := TLldbDebuggerCommandEvaluate.Create(TLldbDebugger(Debugger), AWatchValue);
-  TLldbDebugger(Debugger).FCommandQueue.QueueCommand(Cmd);
+  TLldbDebugger(Debugger).QueueCommand(Cmd);
   Cmd.ReleaseReference;
 end;
 
@@ -374,7 +376,7 @@ debugln(['TLldbBreakPoint.SetBreakPoint ']);
     s := Source;
   Instr := TLldbInstructionBreakSet.Create(s, Line);
   Instr.OnFinish := @BreakInstructionFinished;
-//  TLldbDebugger(Debugger).FCommandQueue.QueueCommand();
+//  TLldbDebugger(Debugger).QueueCommand();
   TLldbDebugger(Debugger).FDebugInstructionQueue.QueueInstruction(Instr);
   Instr.ReleaseReference;
 end;
@@ -442,13 +444,14 @@ end;
 
 procedure TLldbDebuggerCommandQueue.QueueCommand(AValue: TLldbDebuggerCommand);
 begin
+debugln(['CommandQueue.QueueCommand ', AValue.ClassName]);
   Insert(Count, AValue);
   Run;
 end;
 
 procedure TLldbDebuggerCommandQueue.Run;
 begin
-  if FRunningCommand <> nil then
+  if (FRunningCommand <> nil) or (FLockQueueRun > 0) then
     exit;
   if Count = 0 then
     exit;
@@ -490,6 +493,19 @@ DebugLnExit(['<<< CommandQueue.Run (Destroy)', FRunningCommand.ClassName, ', ',
   inherited Destroy;
 end;
 
+procedure TLldbDebuggerCommandQueue.LockQueueRun;
+begin
+  inc(FLockQueueRun);
+  debugln(['TLldbDebuggerCommandQueue.LockQueueRun ',FLockQueueRun]);
+end;
+
+procedure TLldbDebuggerCommandQueue.UnLockQueueRun;
+begin
+  debugln(['TLldbDebuggerCommandQueue.UnLockQueueRun ',FLockQueueRun]);
+  dec(FLockQueueRun);
+  if FLockQueueRun = 0 then Run;
+end;
+
 { TLldbDebuggerCommand }
 
 function TLldbDebuggerCommand.GetDebuggerState: TDBGState;
@@ -698,7 +714,7 @@ begin
     SetState(dsInit);
 
   Cmd := TLldbDebuggerCommandRun.Create(Self);
-  FCommandQueue.QueueCommand(Cmd);
+  QueueCommand(Cmd);
   Cmd.ReleaseReference;
 end;
 
@@ -785,7 +801,7 @@ begin
   Result := True;
 
   Cmd := TLldbDebuggerCommandStop.Create(Self);
-  FCommandQueue.QueueCommand(Cmd);
+  QueueCommand(Cmd);
   Cmd.ReleaseReference;
 end;
 
@@ -795,7 +811,7 @@ var
   Cmd: TLldbDebuggerCommandEvaluate;
 begin
   Cmd := TLldbDebuggerCommandEvaluate.Create(Self, AExpression, EvalFlags, ACallback);
-  FCommandQueue.QueueCommand(Cmd);
+  QueueCommand(Cmd);
   Cmd.ReleaseReference;
   Result := True;
 end;
@@ -810,6 +826,11 @@ begin
   inherited UnlockRelease;
 end;
 
+procedure TLldbDebugger.QueueCommand(const ACommand: TLldbDebuggerCommand);
+begin
+  FCommandQueue.QueueCommand(ACommand);
+end;
+
 procedure TLldbDebugger.SetState(const AValue: TDBGState);
 begin
   inherited;
@@ -917,7 +938,7 @@ begin
   inherited Init;
 
   Cmd := TLldbDebuggerCommandInit.Create(Self);
-  FCommandQueue.QueueCommand(Cmd);
+  QueueCommand(Cmd);
   Cmd.ReleaseReference;
   DebugLnExit('*** Init');
 end;

components/lazdebuggers/lazdebuggerlldb/lldbinstructions.pas

@@ -5,8 +5,8 @@ unit LldbInstructions;
 interface
 
 uses
-  SysUtils, math, LazLoggerBase, DbgIntfDebuggerBase, DebugInstructions,
-  LldbHelper;
+  SysUtils, math, Classes, LazLoggerBase, DbgIntfDebuggerBase, DbgIntfBaseTypes,
+  DebugInstructions, LldbHelper;
 
 type
 
@@ -149,6 +149,37 @@ type
     property Res: String read FRes;
   end;
 
+  { TLldbInstructionMemory }
+
+  TArrayOfByte = array of byte;
+
+  TLldbInstructionMemory = class(TLldbInstruction)
+  private
+    FRes: TArrayOfByte;
+    FReading: Boolean;
+  protected
+    function ProcessInputFromDbg(const AData: String): Boolean; override;
+    procedure SendCommandDataToDbg(); override;
+  public
+    constructor Create(AnAddress: TDBGPtr; ALen: Cardinal);
+    property Res: TArrayOfByte read FRes;
+  end;
+
+  { TLldbInstructionRegister }
+
+  TLldbInstructionRegister = class(TLldbInstruction)
+  private
+    FRes: TStringList;
+    FReading: Boolean;
+  protected
+    procedure DoFree; override;
+    function ProcessInputFromDbg(const AData: String): Boolean; override;
+    procedure SendCommandDataToDbg(); override;
+  public
+    constructor Create(AThread, AFrame: Integer);
+    property Res: TStringList read FRes;
+  end;
+
   { TLldbInstructionStackTrace }
 
   TLldbInstructionStackTrace = class(TLldbInstruction)
@@ -500,6 +531,141 @@ begin
   inherited Create(Format('expression -T -- %s', [UpperCase(AnExpression)]), AThread, AFrame);
 end;
 
+{ TLldbInstructionMemory }
+
+function TLldbInstructionMemory.ProcessInputFromDbg(const AData: String
+  ): Boolean;
+var
+  found: TStringArray;
+  n, l, i: Integer;
+  s: String;
+begin
+  Result := False;
+  if StrStartsWith(AData, Command) then begin
+    FReading := True;
+  end;
+
+  if not FReading then
+    exit;
+
+  Result := True;
+  if CheckForIgnoredError(AData) then
+    exit;
+
+
+
+  if StrMatches(AData, ['0x', ': ', ''], found) then begin
+    // todo check the address
+    l := Length(FRes);
+    s := found[1];
+    n := (Length(s)+1) div 5;
+    SetLength(FRes, l+n);
+    for i := l to l + n-1 do begin
+      FRes[i] := StrToIntDef(copy(s,1,4), 0);
+      delete(s,1,5);
+    end;
+    exit;
+  end;
+//<< << TCmdLineDebugger.ReadLn "0x005ff280: 0x60 0x10 0x77 0x04"
+
+
+  if StrMatches(AData, ['(', ')', ' = ', '112234', '']) then begin
+    MarkAsSuccess;
+    Exit;
+  end;
+
+  Result := inherited ProcessInputFromDbg(AData);
+end;
+
+procedure TLldbInstructionMemory.SendCommandDataToDbg();
+begin
+  inherited SendCommandDataToDbg();
+  Queue.SendDataToDBG(Self, 'p 112234'); // end marker // do not sent before new prompt
+end;
+
+constructor TLldbInstructionMemory.Create(AnAddress: TDBGPtr; ALen: Cardinal);
+begin
+  inherited Create(Format('memory read --force --size 1 --format x --count %u %u', [ALen, AnAddress]));
+end;
+
+{ TLldbInstructionRegister }
+
+procedure TLldbInstructionRegister.DoFree;
+begin
+  FreeAndNil(FRes);
+  inherited DoFree;
+end;
+
+function TLldbInstructionRegister.ProcessInputFromDbg(const AData: String
+  ): Boolean;
+var
+  found: TStringArray;
+  i: Integer;
+  s, reg, val: String;
+begin
+  Result := False;
+  if StrStartsWith(AData, Command) then begin
+    FReading := True;
+  end;
+
+  if not FReading then
+    exit;
+
+  Result := True;
+  if CheckForIgnoredError(AData) then
+    exit;
+
+  if StrStartsWith(AData, 'General Purpose Registers:') then
+    exit;
+
+  if StrMatches(AData, ['  ', ' = ', ''], found) then begin
+    if FRes = nil then FRes := TStringList.Create;
+      reg := UpperCase(trim(found[0]));
+      i := pos(' ', found[1]);
+      if i < 1 then i := Length(found[1]);
+      val := copy(found[1], 1, i);
+      FRes.Values[reg] := val;
+    exit;
+  end;
+
+  if StrMatches(AData, ['(', ')', ' = ', '112235', '']) then begin
+    MarkAsSuccess;
+    Exit;
+  end;
+
+  Result := inherited ProcessInputFromDbg(AData);
+
+(*
+   << Finished Instruction: register read --all // True
+  << Current Instruction:
+  TDBGInstructionQueue.RunQueue nil / nil
+  << << TCmdLineDebugger.ReadLn "General Purpose Registers:"
+  << << TCmdLineDebugger.ReadLn "       eax = 0x00000000"
+  << << TCmdLineDebugger.ReadLn "       ebx = 0x005AF750  VMT_$UNIT1_$$_TFORM1"
+  << << TCmdLineDebugger.ReadLn "       ecx = 0x04696C7C"
+  << << TCmdLineDebugger.ReadLn "       edx = 0x00000002"
+  << << TCmdLineDebugger.ReadLn "       edi = 0x005AF750  VMT_$UNIT1_$$_TFORM1"
+  << << TCmdLineDebugger.ReadLn "       esi = 0x046F1060"
+  << << TCmdLineDebugger.ReadLn "       ebp = 0x0262FDF8"
+  << << TCmdLineDebugger.ReadLn "       esp = 0x0262FDA8"
+  << << TCmdLineDebugger.ReadLn "       eip = 0x004294A8  project1.exe`FORMCREATE + 104 at unit1.pas:39"
+  << << TCmdLineDebugger.ReadLn "    eflags = 0b00000000000000000000001001000110"
+  << << TCmdLineDebugger.ReadLn ""
+< TLldbDebugger.UnlockRelease 1
+*)
+end;
+
+procedure TLldbInstructionRegister.SendCommandDataToDbg();
+begin
+  inherited SendCommandDataToDbg();
+  Queue.SendDataToDBG(Self, 'p 112235'); // end marker // do not sent before new prompt
+end;
+
+constructor TLldbInstructionRegister.Create(AThread, AFrame: Integer);
+begin
+  inherited Create('register read --all', AThread, AFrame);
+end;
+
 { TLldbInstructionStackTrace }
 
 procedure TLldbInstructionStackTrace.SendCommandDataToDbg();