lazarus/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas

{
 ---------------------------------------------------------------------------
 FpDebugDebuggerWorkThreads
 ---------------------------------------------------------------------------

 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************
}

unit FpDebugDebuggerWorkThreads;

(*
  This unit contains the classes for executing work in the worker thread:
  - The general structure of the classes
  - The code that is to be executed in the worker thread
      procedure DoExecute;

  - The classes are extended in the main FpDebugDebugger unit with any code
    running in the main debugger thread.

  This split accross the units should help with identifying what may be accessed
  in the worker thread.
*)

{$mode objfpc}{$H+}
{$IF FPC_Fullversion=30202}{$Optimization NOPEEPHOLE}{$ENDIF}
{$TYPEDADDRESS on}
{$ModeSwitch advancedrecords}

interface

uses
  FpDebugDebuggerUtils, FpDebugValueConvertors, DbgIntfDebuggerBase,
  DbgIntfBaseTypes, FpDbgClasses, FpDbgUtil, FPDbgController, FpPascalBuilder,
  FpdMemoryTools, FpDbgInfo, FpPascalParser, FpErrorMessages,
  FpDebugDebuggerBase, FpDebuggerResultData, FpDbgCallContextInfo, FpDbgDwarf,
  FpDbgDwarfDataClasses, FpWatchResultData, FpDbgDwarfFreePascal, FpDbgDisasX86, LazDebuggerIntf,
  LazDebuggerValueConverter, Forms, fgl, math, Classes, sysutils, LazClasses,
  {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif};

type

  TFpDbgAsyncMethod = procedure() of object;

  { TFpDbgDebggerThreadWorkerItem }

  TFpDbgDebggerThreadWorkerItem = class(TFpThreadPriorityWorkerItem)
  protected type
    THasQueued = (hqNotQueued, hqQueued, hqBlocked);
  protected
    FDebugger: TFpDebugDebuggerBase;
    FHasQueued: THasQueued;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase; APriority: TFpThreadWorkerPriority);

    procedure Queue(aMethod: TDataEvent; Data: PtrInt = 0);
    (* Unqueue_DecRef also prevents new queuing
       Unqueue_DecRef allows for destruction (no more access to object)
       => therefor UnQueue_DecRef and ALL/most methods executing  unqueue_DecRef are named *_DecRef
    *)
    procedure UnQueue_DecRef(ABlockQueuing: Boolean = True);
  end;

  { TFpDbgDebggerThreadWorkerLinkedItem }

  TFpDbgDebggerThreadWorkerLinkedItem = class(TFpDbgDebggerThreadWorkerItem)
  protected
    FNextWorker: TFpDbgDebggerThreadWorkerLinkedItem; // linked list for use by TFPCallStackSupplier
    procedure DoRemovedFromLinkedList; virtual;
  end;

  { TFpDbgDebggerThreadWorkerLinkedList }

  TFpDbgDebggerThreadWorkerLinkedList = object
  private
    FNextWorker: TFpDbgDebggerThreadWorkerLinkedItem;
    FLocked: Boolean;
  public
    procedure Add(AWorkItem: TFpDbgDebggerThreadWorkerLinkedItem); // Does not add ref / uses existing ref
    procedure ClearFinishedWorkers;
    procedure RequestStopForWorkers;
    procedure WaitForWorkers(AStop: Boolean); // Only call in IDE thread (main thread)
  end;

  { TFpThreadWorkerControllerRun }

  TFpThreadWorkerControllerRun = class(TFpDbgDebggerThreadWorkerItem)
  private
    FWorkerThreadId: TThreadID;
  protected
    FStartSuccessfull: boolean;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase);
    property StartSuccesfull: boolean read FStartSuccessfull;
    property WorkerThreadId: TThreadID read FWorkerThreadId;
  end;

  { TFpThreadWorkerRunLoop }

  TFpThreadWorkerRunLoop = class(TFpDbgDebggerThreadWorkerItem)
  protected
    procedure LoopFinished_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase);
  end;

  { TFpThreadWorkerRunLoopAfterIdle }

  TFpThreadWorkerRunLoopAfterIdle = class(TFpDbgDebggerThreadWorkerItem)
  protected
    procedure CheckIdleOrRun_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase);
  end;

  { TFpThreadWorkerAsyncMeth }

  TFpThreadWorkerAsyncMeth = class(TFpDbgDebggerThreadWorkerItem)
  protected
    FAsyncMethod: TFpDbgAsyncMethod;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase; AnAsyncMethod: TFpDbgAsyncMethod);
  end;

  { TFpThreadWorkerPrepareCallStackEntryList }

  TFpThreadWorkerPrepareCallStackEntryList = class(TFpDbgDebggerThreadWorkerLinkedItem)
  (* Do not accesss   CallStackEntryList.Items[]   while this is running *)
  protected
    FRequiredMinCount: Integer;
    FThread: TDbgThread;
    procedure PrepareCallStackEntryList(AFrameRequired: Integer; AThread: TDbgThread);
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase; ARequiredMinCount: Integer; APriority: TFpThreadWorkerPriority = twpStack);
    constructor Create(ADebugger: TFpDebugDebuggerBase; ARequiredMinCount: Integer; AThread: TDbgThread);
  end;

  { TFpThreadWorkerCallStackCount }

  TFpThreadWorkerCallStackCount = class(TFpThreadWorkerPrepareCallStackEntryList)
  protected
    procedure UpdateCallstack_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  end;

  { TFpThreadWorkerCallEntry }

  TFpThreadWorkerCallEntry = class(TFpThreadWorkerPrepareCallStackEntryList)
  protected
    FCallstackIndex: Integer;
    FValid: Boolean;
    FSrcClassName, FFunctionName, FSourceFile: String;
    FAnAddress: TDBGPtr;
    FLine: Integer;
    FParamAsString: String;
    procedure UpdateCallstackEntry_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  end;

  { TFpThreadWorkerThreads }

  TFpThreadWorkerThreads = class(TFpThreadWorkerPrepareCallStackEntryList)
  protected
    procedure UpdateThreads_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase);
  end;

  { TFpThreadWorkerLocals }

  TFpThreadWorkerLocals = class(TFpDbgDebggerThreadWorkerLinkedItem)
  protected type
  protected
    FLocals: IDbgLocalsListIntf;
    FThreadId, FStackFrame: Integer;
    procedure UpdateLocals_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  end;

  { TFpThreadWorkerModify }

  TFpThreadWorkerModify = class(TFpDbgDebggerThreadWorkerLinkedItem)
  private
    FExpression, FNewVal: String;
    FStackFrame, FThreadId: Integer;
    FSuccess: Boolean;
  protected
    procedure DoCallback_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
    property Success: Boolean read FSuccess;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase;
                       //APriority: TFpThreadWorkerPriority;
                       const AnExpression, ANewValue: String;
                       AStackFrame, AThreadId: Integer
                      );
    function DebugText: String; override;
  end;

  { TFpThreadWorkerEvaluate }

  TFpThreadWorkerEvaluate = class(TFpDbgDebggerThreadWorkerLinkedItem)
  private
    FAllowFunctions, FAllowFunctionsAllThread: Boolean;
    FExpressionScope: TFpDbgSymbolScope;

    function DoFindIntrinsic(AnExpression: TFpPascalExpression; AStart: PChar; ALen: Integer
      ): TFpPascalExpressionPartIntrinsicBase;
    function DoWatchFunctionCall(AnExpressionPart: TFpPascalExpressionPart;
      AFunctionValue, ASelfValue: TFpValue; AParams: TFpPascalExpressionPartList;
      out AResult: TFpValue; var AnError: TFpError): boolean;
  protected
    FWatchValue: IDbgWatchValueIntf;
    function EvaluateExpression(const AnExpression: String;
                                AStackFrame, AThreadId: Integer;
                                ARepeatCnt: Integer;
                                AnEvalFlags: TWatcheEvaluateFlags;
                                out AResText: String;
                                out ATypeInfo: TDBGType
                               ): Boolean;
  public
  end;

  { TFpThreadWorkerEvaluateExpr }

  TFpThreadWorkerEvaluateExpr = class(TFpThreadWorkerEvaluate)
  private
    FExpression: String;
    FStackFrame, FThreadId: Integer;
    FRepeatCnt: Integer;
    FEvalFlags: TWatcheEvaluateFlags;
  protected
    FRes: Boolean;
    FResText: String;
    FResDbgType: TDBGType;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase;
                       APriority: TFpThreadWorkerPriority;
                       const AnExpression: String;
                       AStackFrame, AThreadId: Integer;
                       ARepeatCnt: Integer;
                       AnEvalFlags: TWatcheEvaluateFlags
                      );
    function DebugText: String; override;
  end;

  { TFpThreadWorkerCmdEval }

  TFpThreadWorkerCmdEval = class(TFpThreadWorkerEvaluateExpr)
  protected
    FCallback: TDBGEvaluateResultCallback;
    procedure DoCallback_DecRef(Data: PtrInt = 0);
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase;
                       APriority: TFpThreadWorkerPriority;
                       const AnExpression: String;
                       AStackFrame, AThreadId: Integer;
                       AnEvalFlags: TWatcheEvaluateFlags;
                       ACallback: TDBGEvaluateResultCallback
                      );
    destructor Destroy; override;
    procedure Abort;
  end;

  { TFpThreadWorkerWatchValueEval }

  TFpThreadWorkerWatchValueEval = class(TFpThreadWorkerEvaluateExpr)
  protected
    procedure UpdateWatch_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  end;

  { TFpThreadWorkerBreakPoint }

  TFpThreadWorkerBreakPoint = class(TFpDbgDebggerThreadWorkerItem)
  public
    procedure AbortSetBreak; virtual;
  end;

  { TFpThreadWorkerBreakPointSet }

  TFpThreadWorkerBreakPointSet = class(TFpThreadWorkerBreakPoint)
  private
    FInternalBreakpoint: FpDbgClasses.TFpDbgBreakpoint;
    FKind: TDBGBreakPointKind;
    FAddress: TDBGPtr;
    FSource: String;
    FLine: Integer;
    FStackFrame, FThreadId: Integer;
    FWatchData: String;
    FWatchScope: TDBGWatchPointScope;
    FWatchKind: TDBGWatchPointKind;
  protected
    FResetBreakPoint: longint;
    procedure UpdateBrkPoint_DecRef(Data: PtrInt = 0); virtual; abstract;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase; AnAddress: TDBGPtr);
    constructor Create(ADebugger: TFpDebugDebuggerBase; ASource: String; ALine: Integer);
    constructor Create(ADebugger: TFpDebugDebuggerBase;
      AWatchData: String; AWatchScope: TDBGWatchPointScope; AWatchKind: TDBGWatchPointKind;
      AStackFrame, AThreadId: Integer);
    property InternalBreakpoint: FpDbgClasses.TFpDbgBreakpoint read FInternalBreakpoint write FInternalBreakpoint;
  end;

  { TFpThreadWorkerBreakPointRemove }

  TFpThreadWorkerBreakPointRemove = class(TFpThreadWorkerBreakPoint)
  protected
    FInternalBreakpoint: FpDbgClasses.TFpDbgBreakpoint;
    procedure DoExecute; override;
  public
    constructor Create(ADebugger: TFpDebugDebuggerBase; AnInternalBreakpoint: FpDbgClasses.TFpDbgBreakpoint);
    property InternalBreakpoint: FpDbgClasses.TFpDbgBreakpoint read FInternalBreakpoint;
  end;

implementation
var
  DBG_VERBOSE, DBG_WARNINGS, FPDBG_FUNCCALL: PLazLoggerLogGroup;

{ TFpDbgDebggerThreadWorkerItem }

constructor TFpDbgDebggerThreadWorkerItem.Create(ADebugger: TFpDebugDebuggerBase;
  APriority: TFpThreadWorkerPriority);
begin
  inherited Create(APriority);
  FDebugger := ADebugger;
  AddRef;
end;

procedure TFpDbgDebggerThreadWorkerItem.Queue(aMethod: TDataEvent; Data: PtrInt
  );
begin
  FDebugger.LockList.Lock;
  try
    if (FHasQueued <> hqBlocked) then begin
      assert(FHasQueued = hqNotQueued, 'TFpDbgDebggerThreadWorkerItem.Queue: FHasQueued = hqNotQueued');
      FHasQueued := hqQueued;
      AddRef;
      Application.QueueAsyncCall(aMethod, 0);
    end;
  finally
    FDebugger.LockList.UnLock;
  end;
end;

procedure TFpDbgDebggerThreadWorkerItem.UnQueue_DecRef(ABlockQueuing: Boolean);
var
  HasQ: THasQueued;
begin
  FDebugger.LockList.Lock;
  HasQ := FHasQueued;
  if ABlockQueuing then begin
    FHasQueued := hqBlocked;
    FDebugger.LockList.UnLock; // unlock first.
    Application.RemoveAsyncCalls(Self);
  end
  else begin
    FHasQueued := hqNotQueued;
    try
      Application.RemoveAsyncCalls(Self);
    finally
      FDebugger.LockList.UnLock;
    end;
  end;

  if HasQ = hqQueued then
    DecRef; // may call destroy
end;

{ TFpDbgDebggerThreadWorkerLinkedItem }

procedure TFpDbgDebggerThreadWorkerLinkedItem.DoRemovedFromLinkedList;
begin
  UnQueue_DecRef;
end;

{ TFpDbgDebggerThreadWorkerLinkedList }

procedure TFpDbgDebggerThreadWorkerLinkedList.Add(
  AWorkItem: TFpDbgDebggerThreadWorkerLinkedItem);
begin
  AWorkItem.FNextWorker := FNextWorker;
  FNextWorker := AWorkItem;
end;

procedure TFpDbgDebggerThreadWorkerLinkedList.ClearFinishedWorkers;
var
  WorkItem, w: TFpDbgDebggerThreadWorkerLinkedItem;
begin
  assert(system.ThreadID = classes.MainThreadID, 'TFpDbgDebggerThreadWorkerLinkedList.ClearFinishedCountWorkers: system.ThreadID = classes.MainThreadID');
  if FLocked then
    exit;
  FLocked := True;
  WorkItem := FNextWorker;
  try
    while (WorkItem <> nil) and (WorkItem.RefCount = 1) do begin
      w := WorkItem;
      WorkItem := w.FNextWorker;
      w.DoRemovedFromLinkedList;
      w.DecRef;
    end;
  finally
    FNextWorker := WorkItem;
    FLocked := False;
  end;
end;

procedure TFpDbgDebggerThreadWorkerLinkedList.RequestStopForWorkers;
var
  WorkItem: TFpDbgDebggerThreadWorkerLinkedItem;
begin
  WorkItem := FNextWorker;
  while (WorkItem <> nil) do begin
    WorkItem.RequestStop;
    WorkItem := WorkItem.FNextWorker;
  end;
end;

procedure TFpDbgDebggerThreadWorkerLinkedList.WaitForWorkers(AStop: Boolean);
var
  WorkItem, w: TFpDbgDebggerThreadWorkerLinkedItem;
begin
  assert(system.ThreadID = classes.MainThreadID, 'TFpDbgDebggerThreadWorkerLinkedList.WaitForWorkers: system.ThreadID = classes.MainThreadID');
  assert(not FLocked, 'TFpDbgDebggerThreadWorkerLinkedList.WaitForWorkers: not FLocked');
  if AStop then
    RequestStopForWorkers;

  FLocked := True;
  WorkItem := FNextWorker;
  FNextWorker := nil;
  try
    while (WorkItem <> nil) do begin
      w := WorkItem;
      WorkItem := w.FNextWorker;
      if w.IsCancelled then
        w.FDebugger.WorkQueue.RemoveItem(w)
      else
        w.FDebugger.WorkQueue.WaitForItem(w);
      w.DoRemovedFromLinkedList;
      w.DecRef;
    end;
  finally
    FLocked := False;
  end;
end;

{ TFpThreadWorkerControllerRun }

procedure TFpThreadWorkerControllerRun.DoExecute;
begin
  FStartSuccessfull := FDebugger.DbgController.Run;
  FWorkerThreadId := ThreadID;
end;

constructor TFpThreadWorkerControllerRun.Create(ADebugger: TFpDebugDebuggerBase);
begin
  inherited Create(ADebugger, twpContinue);
end;

{ TFpThreadWorkerRunLoop }

procedure TFpThreadWorkerRunLoop.DoExecute;
begin
  FDebugger.ClearCachedData;
  FDebugger.DbgController.ProcessLoop;
  Queue(@LoopFinished_DecRef);
end;

constructor TFpThreadWorkerRunLoop.Create(ADebugger: TFpDebugDebuggerBase);
begin
  inherited Create(ADebugger, twpContinue);
end;

{ TFpThreadWorkerRunLoopAfterIdle }

procedure TFpThreadWorkerRunLoopAfterIdle.DoExecute;
begin
  Queue(@CheckIdleOrRun_DecRef);
end;

constructor TFpThreadWorkerRunLoopAfterIdle.Create(ADebugger: TFpDebugDebuggerBase);
begin
  inherited Create(ADebugger, twpContinue);
end;

{ TFpThreadWorkerAsyncMeth }

procedure TFpThreadWorkerAsyncMeth.DoExecute;
begin
  FAsyncMethod();
end;

constructor TFpThreadWorkerAsyncMeth.Create(ADebugger: TFpDebugDebuggerBase;
  AnAsyncMethod: TFpDbgAsyncMethod);
begin
  inherited Create(ADebugger, twpUser);
  FAsyncMethod := AnAsyncMethod;
end;

{ TFpThreadWorkerPrepareCallStackEntryList }

procedure TFpThreadWorkerPrepareCallStackEntryList.PrepareCallStackEntryList(
  AFrameRequired: Integer; AThread: TDbgThread);
var
  ThreadCallStack: TDbgCallstackEntryList;
  CurCnt, ReqCnt: Integer;
begin
  ThreadCallStack := AThread.CallStackEntryList;

  if ThreadCallStack = nil then begin
    AThread.PrepareCallStackEntryList(-2); // Only create the list
    ThreadCallStack := AThread.CallStackEntryList;
    if ThreadCallStack = nil then
      exit;
  end;

  FDebugger.LockList.GetLockFor(ThreadCallStack);
  try
    CurCnt := ThreadCallStack.Count;
    while (not StopRequested) and
          ( (FRequiredMinCount > CurCnt) or (FRequiredMinCount < 0) ) and
          (not ThreadCallStack.HasReadAllAvailableFrames)
    do begin
      ReqCnt := Min(CurCnt + 5, FRequiredMinCount);
      AThread.PrepareCallStackEntryList(ReqCnt);
      CurCnt := ThreadCallStack.Count;
      if CurCnt < ReqCnt then
        exit;
    end;
  finally
    FDebugger.LockList.FreeLockFor(ThreadCallStack);
  end;
end;

procedure TFpThreadWorkerPrepareCallStackEntryList.DoExecute;
var
  t: TDbgThread;
begin
  if FRequiredMinCount < -1 then
    exit;
  if FThread = nil then begin
    for t in FDebugger.DbgController.CurrentProcess.ThreadMap do begin
      PrepareCallStackEntryList(FRequiredMinCount, t);
      if StopRequested then
        break;
    end;
  end
  else
    PrepareCallStackEntryList(FRequiredMinCount, FThread);
end;

constructor TFpThreadWorkerPrepareCallStackEntryList.Create(
  ADebugger: TFpDebugDebuggerBase; ARequiredMinCount: Integer;
  APriority: TFpThreadWorkerPriority);
begin
  inherited Create(ADebugger, APriority);
  FRequiredMinCount := ARequiredMinCount;
  FThread := nil;
end;

constructor TFpThreadWorkerPrepareCallStackEntryList.Create(
  ADebugger: TFpDebugDebuggerBase; ARequiredMinCount: Integer; AThread: TDbgThread);
begin
  Create(ADebugger, ARequiredMinCount);
  FThread := AThread;
end;

{ TFpThreadWorkerCallStackCount }

procedure TFpThreadWorkerCallStackCount.DoExecute;
begin
  inherited DoExecute;
  Queue(@UpdateCallstack_DecRef);
end;

{ TFpThreadWorkerCallEntry }

procedure TFpThreadWorkerCallEntry.DoExecute;
var
  PrettyPrinter: TFpPascalPrettyPrinter;
  Prop: TFpDebugDebuggerProperties;
  DbgCallStack: TDbgCallstackEntry;
begin
  inherited DoExecute;

  DbgCallStack := FThread.CallStackEntryList[FCallstackIndex];
  FValid := (DbgCallStack <> nil) and (not StopRequested);
  if FValid then begin
    Prop := TFpDebugDebuggerProperties(FDebugger.GetProperties);
    PrettyPrinter := TFpPascalPrettyPrinter.Create(DBGPTRSIZE[FDebugger.DbgController.CurrentProcess.Mode]);
    PrettyPrinter.Context := FDebugger.DbgController.DefaultContext;

    FDebugger.MemManager.MemLimits.MaxArrayLen            := Prop.MemLimits.MaxStackArrayLen;
    FDebugger.MemManager.MemLimits.MaxStringLen           := Prop.MemLimits.MaxStackStringLen;
    FDebugger.MemManager.MemLimits.MaxNullStringSearchLen := Prop.MemLimits.MaxStackNullStringSearchLen;

    FSrcClassName := DbgCallStack.SrcClassName;
    FAnAddress := DbgCallStack.AnAddress;
    FFunctionName := DbgCallStack.FunctionName;
    FSourceFile := DbgCallStack.SourceFile;
    FLine := DbgCallStack.Line;

    FParamAsString := GetParamsAsString(FThread, DbgCallStack, FDebugger.MemManager, FDebugger.TargetWidth, PrettyPrinter);
    PrettyPrinter.Free;

    FDebugger.MemManager.MemLimits.MaxArrayLen            := Prop.MemLimits.MaxArrayLen;
    FDebugger.MemManager.MemLimits.MaxStringLen           := Prop.MemLimits.MaxStringLen;
    FDebugger.MemManager.MemLimits.MaxNullStringSearchLen := Prop.MemLimits.MaxNullStringSearchLen;
  end;

  Queue(@UpdateCallstackEntry_DecRef);
end;

{ TFpThreadWorkerThreads }

procedure TFpThreadWorkerThreads.DoExecute;
begin
  inherited DoExecute;
  Queue(@UpdateThreads_DecRef);
end;

constructor TFpThreadWorkerThreads.Create(ADebugger: TFpDebugDebuggerBase);
begin
  inherited Create(ADebugger, 1, twpThread);
end;

{ TFpThreadWorkerLocals }

procedure TFpThreadWorkerLocals.DoExecute;
var
  LocalScope: TFpDbgSymbolScope;
  ProcVal, m: TFpValue;
  i: Integer;
  WatchResConv: TFpLazDbgWatchResultConvertor;
  ResData: IDbgWatchDataIntf;
begin
  LocalScope := FDebugger.DbgController.CurrentProcess.FindSymbolScope(FThreadId, FStackFrame);
  if (LocalScope = nil) or (LocalScope.SymbolAtAddress = nil) then begin
    LocalScope.ReleaseReference;
    exit;
  end;

  ProcVal := LocalScope.ProcedureAtAddress;
  if (ProcVal = nil) then begin
    LocalScope.ReleaseReference;
    exit;
  end;

  WatchResConv := TFpLazDbgWatchResultConvertor.Create(LocalScope.LocationContext);
  WatchResConv.MaxArrayConv := TFpDebugDebuggerProperties(FDebugger.GetProperties).MemLimits.MaxArrayConversionCnt;
  WatchResConv.MaxTotalConv := TFpDebugDebuggerProperties(FDebugger.GetProperties).MemLimits.MaxTotalConversionCnt;
  WatchResConv.Debugger := FDebugger;
  WatchResConv.ExpressionScope := LocalScope;

  for i := 0 to ProcVal.MemberCount - 1 do begin
    m := ProcVal.Member[i];
    if m <> nil then begin
      ResData := FLocals.Add(m.DbgSymbol.Name);
      if not  WatchResConv.WriteWatchResultData(m, ResData)
      then begin
        ResData.CreateError('Unknown Error');
      end;
      m.ReleaseReference;
    end;
    if StopRequested then
      Break;
  end;

  WatchResConv.Free;
  ProcVal.ReleaseReference;
  LocalScope.ReleaseReference;

  Queue(@UpdateLocals_DecRef);
end;

{ TFpThreadWorkerModify }

procedure TFpThreadWorkerModify.DoExecute;
var
  APasExpr: TFpPascalExpression;
  ResValue: TFpValue;
  ExpressionScope: TFpDbgSymbolScope;
  i64: int64;
  c64: QWord;
begin
  FSuccess := False;
  ExpressionScope := FDebugger.DbgController.CurrentProcess.FindSymbolScope(FThreadId, FStackFrame);
  if ExpressionScope = nil then
    exit;

  APasExpr := TFpPascalExpression.Create(FExpression, ExpressionScope, True);
  APasExpr.IntrinsicPrefix := TFpDebugDebuggerProperties(FDebugger.GetProperties).IntrinsicPrefix;
  APasExpr.AutoDeref := TFpDebugDebuggerProperties(FDebugger.GetProperties).AutoDeref;
  APasExpr.Parse;
  try
    APasExpr.ResultValue; // trigger full validation
    if not APasExpr.Valid then
      exit;

    ResValue := APasExpr.ResultValue;
    if ResValue = nil then
      exit;

    FSuccess := True;
    try
      case ResValue.Kind of
        skInteger:   if TryStrToInt64(FNewVal, i64)
                     then ResValue.AsInteger := i64
                     else FSuccess := False;
        skCardinal:  if TryStrToQWord(FNewVal, c64)
                     then ResValue.AsCardinal := c64
                     else FSuccess := False;
        skBoolean:   case LowerCase(trim(FNewVal)) of
            'true':  ResValue.AsBool := True;
            'false': ResValue.AsBool := False;
            otherwise FSuccess := False;
          end;
        skChar:      ResValue.AsString := FNewVal;
        skEnum:      ResValue.AsString := FNewVal;
        skSet:       ResValue.AsString := FNewVal;
        skPointer:   if TryStrToQWord(FNewVal, c64) then
                     ResValue.AsCardinal := c64
                     else FSuccess := False;
        //skFloat: ;
        //skCurrency: ;
        //skVariant: ;
        otherwise
          FSuccess := False;
      end;
    except
      FSuccess := False;
    end;

  finally
    APasExpr.Free;
    ExpressionScope.ReleaseReference;
    Queue(@DoCallback_DecRef);
  end;
end;

constructor TFpThreadWorkerModify.Create(ADebugger: TFpDebugDebuggerBase;
  const AnExpression, ANewValue: String; AStackFrame, AThreadId: Integer);
begin
  inherited Create(ADebugger, twpModify);
  FExpression := AnExpression;
  FNewVal := ANewValue;
  FStackFrame := AStackFrame;
  FThreadId := AThreadId;
end;

function TFpThreadWorkerModify.DebugText: String;
begin
  Result := inherited DebugText;
end;

{ TFpThreadWorkerEvaluate }

function TFpThreadWorkerEvaluate.DoWatchFunctionCall(
  AnExpressionPart: TFpPascalExpressionPart; AFunctionValue,
  ASelfValue: TFpValue; AParams: TFpPascalExpressionPartList; out
  AResult: TFpValue; var AnError: TFpError): boolean;
var
  FunctionSymbolData, FunctionSymbolType, FunctionResultSymbolType,
  TempSymbol, StringSymbol: TFpSymbol;
  ExprParamVal: TFpValue;
  ProcAddress: TFpDbgMemLocation;
  FunctionResultDataSize, ChrSize: TFpDbgValueSize;

  SelfTypeSym: TFpSymbol;
  ParameterSymbolArr: array of record
    ParamVal: TFpValue;
    TypeSym: TFpSymbol;
    TempAnsiStringDataAddr: TDbgPtr;
    TempWideStringDataAddr: TDbgPtr;
  end;
  CallContext: TFpDbgInfoCallContext;
  PCnt, i, FoundIdx: Integer;
  rk: TDbgSymbolKind;
  StringResultAddr, StringResultDecRefAddress: TDBGPtr;
  StringAnsiSetLenAddress, StringAnsiDecRefAddress: TDBGPtr;
  StringWideSetLenAddress, StringWideDecRefAddress: TDBGPtr;
  ParRes: Boolean;
begin
  Result := False;
  if FExpressionScope = nil then
    exit;
(*
   AFunctionValue =>  TFpValueDwarfSubroutine  // gotten from <== TFpSymbolDwarfDataProc.GetValueObject;
                   .DataSympol = TFpSymbolDwarfDataProc  from which we were created
                   .TypeSymbol = TFpSymbolDwarfTypeProc.TypeInfo : TFpSymbolDwarfType

   AFunctionFpSymbol => TFpSymbolDwarfTypeProc;
   val
*)

  FunctionSymbolData := AFunctionValue.DbgSymbol;  // AFunctionValue . FDataSymbol
  FunctionSymbolType := FunctionSymbolData.TypeInfo;
  FunctionResultSymbolType := FunctionSymbolType.TypeInfo;

  if not (FunctionResultSymbolType.Kind in [skInteger, skCurrency, skPointer, skEnum,
      skCardinal, skBoolean, skChar, skClass, skString, skAnsiString, skWideString])
  then begin
    DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, ['Error result kind  ', dbgs(FunctionSymbolType.Kind)]);
    AnError := CreateError(fpErrAnyError, ['Result type of function not supported']);
    exit;
  end;

  // TODO: pass a value object
  if (not FunctionResultSymbolType.ReadSize(nil, FunctionResultDataSize)) or
     (FunctionResultDataSize >  FDebugger.MemManager.RegisterSize(0))
  then begin
    DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, ['Error result size', dbgs(FunctionResultDataSize)]);
    //ReturnMessage := 'Unable to call function. The size of the function-result exceeds the content-size of a register.';
    AnError := CreateError(fpErrAnyError, ['Result type of function not supported']);
    exit;
  end;

  try
    ParameterSymbolArr := nil;
    StringResultDecRefAddress := 0; // Wide OR Ansi-DecRef
    StringAnsiDecRefAddress := 0;
    StringWideDecRefAddress := 0;
    StringAnsiSetLenAddress := 0;
    StringWideSetLenAddress := 0;
    StringResultAddr := 0;
    SelfTypeSym := nil;

    if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString])
    then begin
      if (FunctionResultSymbolType.Kind = skWideString) then
        StringResultDecRefAddress := FDebugger.GetCached_FPC_WIDESTR_DECR_REF
      else
        StringResultDecRefAddress := FDebugger.GetCached_FPC_ANSISTR_DECR_REF;

      if (StringResultDecRefAddress = 0) then begin
        DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, ['Error result kind  ', dbgs(FunctionSymbolType.Kind)]);
        AnError := CreateError(fpErrAnyError, ['Result type of function not supported']);
        exit;
      end;

      for i := 0 to FunctionSymbolType.NestedSymbolCount - 1 do begin
        StringSymbol := FunctionSymbolType.NestedSymbol[i];
        if sfParameter in StringSymbol.Flags then
          Continue;
        if StringSymbol.Name = '$result' then
          break;
      end;
      if StringSymbol = nil then begin
        AnError := CreateError(fpErrAnyError, ['Result for string not found']);
        exit;
      end;
    end;

    // check params

    ProcAddress := AFunctionValue.EntryPCAddress;
    if not FExpressionScope.MemModel.IsReadableMemory(ProcAddress)  then begin
      DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, ['Error proc addr']);
      AnError := CreateError(fpErrAnyError, ['Unable to calculate function address']);
      exit;
    end;

    PCnt := AParams.Count;
    FoundIdx := 0;
    if ASelfValue <> nil then
      FoundIdx := -1;

    SetLength(ParameterSymbolArr, PCnt);
    for i := 0 to High(ParameterSymbolArr) do begin
      ParameterSymbolArr[i].ParamVal := nil;
      ParameterSymbolArr[i].TypeSym  := nil;
      ParameterSymbolArr[i].TempAnsiStringDataAddr:= 0;
      ParameterSymbolArr[i].TempWideStringDataAddr:= 0;
    end;

    for i := 0 to FunctionSymbolType.NestedSymbolCount - 1 do begin
      TempSymbol := FunctionSymbolType.NestedSymbol[i];
      if sfParameter in TempSymbol.Flags then begin
        if FoundIdx >= PCnt then begin
          FoundIdx := -2; // error
          break;
        end;

        // Type Compatibility
        if FoundIdx = -1 then begin
          // TODO: check self param
          SelfTypeSym := TempSymbol;
          SelfTypeSym.AddReference;
        end
        else begin
          ExprParamVal := AParams.Items[FoundIdx].ResultValue;
          if (ExprParamVal = nil) then begin
            DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'Internal error for arg %d ', [FoundIdx]);
            AnError := AnExpressionPart.Expression.Error;
            if not IsError(AnError) then
              AnError := CreateError(fpErrAnyError, ['internal error, computing parameter']);
            exit;
          end;

          rk := ExprParamVal.Kind;
          if not(rk in [skInteger, {skCurrency,} skPointer, skEnum, skCardinal, skBoolean, skChar, skClass, skRecord, skString, skAnsiString, skWideString])
          then begin
            DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'Error not supported kind arg %d : %s ', [FoundIdx, dbgs(rk)]);
            AnError := CreateError(fpErrAnyError, ['parameter type not supported']);
            exit;
          end;
          // Handle string/char - literals, constants, expression-results
          if (rk in [skString, skAnsiString, skChar]) and (ExprParamVal.FieldFlags * [svfAddress, svfDataAddress] = []) and
             ( (TempSymbol.Kind in [skString, skAnsiString]) or
               ((TempSymbol.Kind in [skPointer]) and (TempSymbol.TypeInfo <> nil) and
                (TempSymbol.TypeInfo.TypeInfo <> nil) and
                (TempSymbol.TypeInfo.TypeInfo.Kind=skChar) and
                (TempSymbol.TypeInfo.TypeInfo.ReadSize(nil, ChrSize)) and
                (SizeToFullBytes(ChrSize) = 1)  // pchar
                // TODO: if value is variable, then pass existing address
                // TODO: if value is variable: Char then give error
               )
             )
          then begin
            StringAnsiDecRefAddress := FDebugger.GetCached_FPC_ANSISTR_DECR_REF;
            StringAnsiSetLenAddress := FDebugger.GetCached_FPC_ANSISTR_SETLENGTH;
            if (StringAnsiDecRefAddress = 0) or (StringAnsiSetLenAddress = 0) or
               (not FDebugger.CreateAnsiStringInTarget(StringAnsiSetLenAddress,
                    ParameterSymbolArr[FoundIdx].TempAnsiStringDataAddr,
                    ExprParamVal.AsString, FExpressionScope.LocationContext) )
            then begin
              AnError := CreateError(fpErrAnyError, ['constant string failed']);
              ParameterSymbolArr[FoundIdx].TempAnsiStringDataAddr := 0;
              exit;
            end;
          end
          else
          // Handle wide-string/char - literals, constants, expression-results
          if (rk in [skWideString, skString, skAnsiString, skChar]) and (ExprParamVal.FieldFlags * [svfAddress, svfDataAddress] = []) and
             ( (TempSymbol.Kind in [skWideString]) or
               ((TempSymbol.Kind in [skPointer]) and (TempSymbol.TypeInfo <> nil) and
                (TempSymbol.TypeInfo.TypeInfo <> nil) and
                (TempSymbol.TypeInfo.TypeInfo.Kind=skChar) and
                (TempSymbol.TypeInfo.TypeInfo.ReadSize(nil, ChrSize)) and
                (SizeToFullBytes(ChrSize) = 2)  // pchar
                // TODO: if value is variable, then pass existing address
                // TODO: if value is variable: Char then give error
               )
             )
          then begin
            StringWideDecRefAddress := FDebugger.GetCached_FPC_WIDESTR_DECR_REF;
            StringWideSetLenAddress := FDebugger.GetCached_FPC_WIDESTR_SETLENGTH;
            if (StringWideDecRefAddress = 0) or (StringWideSetLenAddress = 0) or
               (not FDebugger.CreateWideStringInTarget(StringWideSetLenAddress,
                    ParameterSymbolArr[FoundIdx].TempWideStringDataAddr,
                    ExprParamVal.AsWideString, FExpressionScope.LocationContext) )
            then begin
              AnError := CreateError(fpErrAnyError, ['constant string failed']);
              ParameterSymbolArr[FoundIdx].TempWideStringDataAddr := 0;
              exit;
            end;
          end
          else
          if (TempSymbol.Kind <> rk) and
             not ( (TempSymbol.Kind in [skInteger, skCardinal]) and (rk in [skInteger, skCardinal]) ) and
             not ( (TempSymbol.Kind in [skString, skAnsiString]) and (rk in [skString, skAnsiString]) )
          then begin
            DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'Error kind mismatch for arg %d : %s <> %s', [FoundIdx, dbgs(TempSymbol.Kind), dbgs(rk)]);
            AnError := CreateError(fpErrAnyError, ['wrong type for parameter']);
            exit;
          end;

          TempSymbol.AddReference;
          ParameterSymbolArr[FoundIdx].ParamVal := ExprParamVal;
          ParameterSymbolArr[FoundIdx].TypeSym  := TempSymbol;
        end;
        //if not IsTargetOrRegNotNil(FDebugger.DbgController.CurrentProcess.CallParamDefaultLocation(FoundIdx)) then begin
        //  DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'error to many args / not supported / arg > %d ', [FoundIdx]);
        //  AnError := CreateError(fpErrAnyError, ['too many parameter / not supported']);
        //  exit;
        //end;
        inc(FoundIdx)
      end;
    end;

    if (FoundIdx <> PCnt) then begin
      DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, ['Error param count']);
      AnError := CreateError(fpErrAnyError, ['wrong amount of parameters']);
      exit;
    end;


    CallContext := FDebugger.DbgController.Call(ProcAddress, FExpressionScope.LocationContext,
      FDebugger.MemReader, FDebugger.MemConverter);
    if CallContext = nil then begin
      AnError := CreateError(fpErrAnyError, ['function call not possible']);
      exit;
    end;

    try
      if (ASelfValue <> nil) then begin
        if not CallContext.AddParam(SelfTypeSym.TypeInfo, ASelfValue) then begin
          DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'Internal error for self');
          AnError := CallContext.LastError;
          exit;
        end;
      end;

      if (StringResultDecRefAddress <> 0) then begin
        if not CallContext.AddStringResult then begin
          DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'Internal error for string result');
          AnError := CallContext.LastError;
          exit;
        end;
      end;

      for i := 0 to High(ParameterSymbolArr) do begin
        if ParameterSymbolArr[i].TempAnsiStringDataAddr <> 0 then
          ParRes := CallContext.AddOrdinalParam(ParameterSymbolArr[i].TempAnsiStringDataAddr)
        else
        if ParameterSymbolArr[i].TempWideStringDataAddr <> 0 then
          ParRes := CallContext.AddOrdinalParam(ParameterSymbolArr[i].TempWideStringDataAddr)
        else
          ParRes := CallContext.AddParam(ParameterSymbolArr[i].TypeSym.TypeInfo, ParameterSymbolArr[i].ParamVal);
        if not ParRes then begin
          DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'Internal error for arg %d ', [i]);
          AnError := CallContext.LastError;
          exit;
        end;
      end;

      if not CallContext.FinalizeParams then begin
        DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, 'Internal error after params');
        AnError := CallContext.LastError;
        exit;
      end;

      FDebugger.BeforeWatchEval(CallContext);
      FDebugger.RunProcessLoop(not FAllowFunctionsAllThread);

      if not CallContext.IsValid then begin
        DebugLn(FPDBG_FUNCCALL or DBG_WARNINGS, ['Error in call ',CallContext.Message]);
        //ReturnMessage := CallContext.Message;
        AnError := CallContext.LastError;
        if not IsError(AnError) then
          if CallContext.Message <> '' then
            AnError := CreateError(fpErrAnyError, [CallContext.Message])
          else
            AnError := CreateError(fpErrAnyError, ['Error in function execution']);
        exit;
      end;

      if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString]) then begin
        if not CallContext.GetStringResultAsPointer(StringResultAddr) then begin
          AnError := CallContext.LastError;
        end
        else
        if (FunctionResultSymbolType.Kind = skWideString) then begin
          if not CallContext.GetWideStringResult(AResult, FunctionSymbolType.TypeInfo) then begin
            AnError := CallContext.LastError;
          end;
        end
        else begin
          if not CallContext.GetStringResult(AResult, FunctionSymbolType.TypeInfo) then begin
            AnError := CallContext.LastError;
          end;
        end;
      end
      else begin
        AResult := CallContext.CreateParamSymbol(-1, FunctionSymbolType, FunctionSymbolData.Name);
      end;
      Result := AResult <> nil;
    finally
      FDebugger.DbgController.AbortCurrentCommand(True);
      CallContext.ReleaseReference;
    end;

    if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString]) and (StringResultAddr <> 0) then begin
      FDebugger.CallTargetFuncStringDecRef(StringResultDecRefAddress, StringResultAddr, FExpressionScope.LocationContext);
    end;

  finally
    FDebugger.DbgController.CurrentThread.RestoreStackMem;

    SelfTypeSym.ReleaseReference;
    for i := 0 to High(ParameterSymbolArr) do begin
      if ParameterSymbolArr[i].TypeSym <> nil then
        ParameterSymbolArr[i].TypeSym.ReleaseReference;
      if ParameterSymbolArr[i].TempAnsiStringDataAddr <> 0 then
        FDebugger.CallTargetFuncStringDecRef(StringAnsiDecRefAddress, ParameterSymbolArr[i].TempAnsiStringDataAddr, FExpressionScope.LocationContext);
      if ParameterSymbolArr[i].TempWideStringDataAddr <> 0 then
        FDebugger.CallTargetFuncStringDecRef(StringWideDecRefAddress, ParameterSymbolArr[i].TempWideStringDataAddr, FExpressionScope.LocationContext);
      end;
  end;

end;

function TFpThreadWorkerEvaluate.DoFindIntrinsic(AnExpression: TFpPascalExpression; AStart: PChar;
  ALen: Integer): TFpPascalExpressionPartIntrinsicBase;
begin
  Result := nil;
  if (ALen = 3) and (strlicomp(AStart, pchar('i2o'), 3) = 0) and
     (FDebugger.DbgController.CurrentProcess.Disassembler is TX86AsmDecoder)
  then
    Result := TFpPascalExpressionPartIntrinsicIntfToObj.Create(AnExpression,
      AStart, AStart+ALen,
      TX86AsmDecoder(FDebugger.DbgController.CurrentProcess.Disassembler)
    );
end;

function TFpThreadWorkerEvaluate.EvaluateExpression(const AnExpression: String;
  AStackFrame, AThreadId: Integer; ARepeatCnt: Integer; AnEvalFlags: TWatcheEvaluateFlags;
  out AResText: String; out ATypeInfo: TDBGType): Boolean;
var
  APasExpr, PasExpr2: TFpPascalExpression;
  PrettyPrinter: TFpPascalPrettyPrinter;
  ResValue: TFpValue;
  CastName, ResText2: String;
  WatchResConv: TFpLazDbgWatchResultConvertor;
  ResData: IDbgWatchDataIntf;
  i: Integer;
  ddf: TDataDisplayFormat;
  AMemDump: Boolean;
begin
  Result := False;
  AResText := '';
  ATypeInfo := nil;

  FExpressionScope := FDebugger.DbgController.CurrentProcess.FindSymbolScope(AThreadId, AStackFrame);
  if FExpressionScope = nil then begin
    if FWatchValue <> nil then
      FWatchValue.Validity := ddsInvalid;
    exit;
  end;

  PrettyPrinter := nil;
  APasExpr := TFpPascalExpression.Create(AnExpression, FExpressionScope, True);
  APasExpr.IntrinsicPrefix := TFpDebugDebuggerProperties(FDebugger.GetProperties).IntrinsicPrefix;
  APasExpr.AutoDeref := TFpDebugDebuggerProperties(FDebugger.GetProperties).AutoDeref;
  APasExpr.GlobalCache := FDebugger.DbgController.CurrentProcess.GlobalCache;
  APasExpr.OnFindIntrinsc := @DoFindIntrinsic;
  APasExpr.Parse;
  try
    if FAllowFunctions and (dfEvalFunctionCalls in FDebugger.EnabledFeatures) then
      APasExpr.OnFunctionCall  := @DoWatchFunctionCall;
    APasExpr.ResultValue; // trigger full validation
    if not APasExpr.Valid then begin
      ErrorHandler.OnErrorTextLookup := @GetErrorText;
      AResText := ErrorHandler.ErrorAsString(APasExpr.Error);
      if FWatchValue <> nil then begin
        FWatchValue.BeginUpdate;
        FWatchValue.ResData.CreateError(AResText);
        FWatchValue.EndUpdate;
      end;
      exit;
    end;

    ResValue := APasExpr.ResultValue;
    if ResValue = nil then begin
      AResText := 'Error';
      if FWatchValue <> nil then begin
        FWatchValue.BeginUpdate;
        FWatchValue.ResData.CreateError(AResText);
        FWatchValue.EndUpdate;
      end;
      exit;
    end;

    if StopRequested then begin
      if FWatchValue <> nil then
        FWatchValue.Validity := ddsInvalid;
      exit;
    end;
    if (ResValue.Kind = skClass) and (ResValue.AsCardinal <> 0) and
       (not IsError(ResValue.LastError)) and (defClassAutoCast in AnEvalFlags)
    then begin
      if ResValue.GetInstanceClassName(CastName) then begin
        PasExpr2 := TFpPascalExpression.Create(CastName+'('+AnExpression+')', FExpressionScope, True);
        PasExpr2.IntrinsicPrefix := TFpDebugDebuggerProperties(FDebugger.GetProperties).IntrinsicPrefix;
        PasExpr2.AutoDeref := TFpDebugDebuggerProperties(FDebugger.GetProperties).AutoDeref;
        PasExpr2.GlobalCache := FDebugger.DbgController.CurrentProcess.GlobalCache;
        PasExpr2.Parse;
        PasExpr2.ResultValue;
        if PasExpr2.Valid then begin
          APasExpr.Free;
          APasExpr := PasExpr2;
          ResValue := APasExpr.ResultValue;
        end
        else
          PasExpr2.Free;
      end
      else begin
        ResValue.ResetError; // in case GetInstanceClassName did set an error
        // TODO: indicate that typecasting to instance failed
      end;
    end;

    if StopRequested then begin
      if FWatchValue <> nil then
        FWatchValue.Validity := ddsInvalid;
      exit;
    end;

    AMemDump := (defMemDump in AnEvalFlags) or
                ( (ResValue <> nil) and (ResValue.Kind = skAddress) );

    if (FWatchValue <> nil) and (ResValue <> nil) and (not AMemDump)
    then begin
      WatchResConv := TFpLazDbgWatchResultConvertor.Create(FExpressionScope.LocationContext);
      WatchResConv.MaxArrayConv := TFpDebugDebuggerProperties(FDebugger.GetProperties).MemLimits.MaxArrayConversionCnt;
      WatchResConv.MaxTotalConv := TFpDebugDebuggerProperties(FDebugger.GetProperties).MemLimits.MaxTotalConversionCnt;
      WatchResConv.ExtraDepth := defExtraDepth in FWatchValue.EvaluateFlags;
      WatchResConv.FirstIndexOffs := FWatchValue.FirstIndexOffs;
      if not (defSkipValConv in AnEvalFlags) then begin
        if (FWatchValue.GetDbgValConverter <> nil) and
           (FWatchValue.GetDbgValConverter.GetConverter.GetObject is TFpDbgValueConverter)
        then
          WatchResConv.ValConfig := FWatchValue.GetDbgValConverter
        else
          WatchResConv.ValConvList := ValueConverterConfigList;
        WatchResConv.Debugger := FDebugger;
      end;
      WatchResConv.ExpressionScope := FExpressionScope;
      ResData := FWatchValue.ResData;
      Result := WatchResConv.WriteWatchResultData(ResValue, ResData, FWatchValue.RepeatCount);

      if Result and APasExpr.HasPCharIndexAccess and not IsError(ResValue.LastError) then begin
      // TODO: Only dwarf 2
        ResData := ResData.SetPCharShouldBeStringValue;
        if ResData <> nil then begin
          APasExpr.FixPCharIndexAccess := True;
          APasExpr.ResetEvaluation;
          ResValue := APasExpr.ResultValue;
          WatchResConv.WriteWatchResultData(ResValue, ResData, FWatchValue.RepeatCount);
        end;
      end;

      WatchResConv.Free;
      if Result then
        exit;
    end;

    PrettyPrinter := TFpPascalPrettyPrinter.Create(FExpressionScope.SizeOfAddress);
    PrettyPrinter.Context := FExpressionScope.LocationContext;

    ddf := ddfDefault;
    if AMemDump then ddf := ddfMemDump;
    if defNoTypeInfo in AnEvalFlags then
      Result := PrettyPrinter.PrintValue(AResText, ResValue, ddf, ARepeatCnt)
    else
      Result := PrettyPrinter.PrintValue(AResText, ATypeInfo, ResValue, ddf, ARepeatCnt);

    // PCHAR/String
    if Result and APasExpr.HasPCharIndexAccess and not IsError(ResValue.LastError) then begin
    // TODO: Only dwarf 2
      APasExpr.FixPCharIndexAccess := True;
      APasExpr.ResetEvaluation;
      ResValue := APasExpr.ResultValue;
      if (ResValue=nil) or (not PrettyPrinter.PrintValue(ResText2, ResValue, ddf, ARepeatCnt)) then
        ResText2 := 'Failed';
      AResText := 'PChar: '+AResText+ LineEnding + 'String: '+ResText2;
    end;

    if Result then
      Result := not IsError(ResValue.LastError) // AResText should be set from Prettyprinter
    else
      AResText := 'Error';

    if not Result then
      FreeAndNil(ATypeInfo);
    if FWatchValue <> nil then begin
      FWatchValue.BeginUpdate;
      FWatchValue.ResData.CreatePrePrinted(AResText);
      FWatchValue.TypeInfo := ATypeInfo;
      FWatchValue.Validity := ddsValid;
      FWatchValue.EndUpdate;
    end;
  finally
    PrettyPrinter.Free;
    APasExpr.Free;
    FExpressionScope.ReleaseReference;
  end;
end;

{ TFpThreadWorkerEvaluateExpr }

procedure TFpThreadWorkerEvaluateExpr.DoExecute;
begin
  FRes := EvaluateExpression(FExpression, FStackFrame, FThreadId,
    FRepeatCnt, FEvalFlags, FResText, FResDbgType);
end;

constructor TFpThreadWorkerEvaluateExpr.Create(ADebugger: TFpDebugDebuggerBase;
  APriority: TFpThreadWorkerPriority; const AnExpression: String; AStackFrame,
  AThreadId: Integer; ARepeatCnt: Integer; AnEvalFlags: TWatcheEvaluateFlags);
begin
  inherited Create(ADebugger, APriority);
  FExpression := AnExpression;
  FStackFrame := AStackFrame;
  FThreadId := AThreadId;
  FRepeatCnt := ARepeatCnt;
  FEvalFlags := AnEvalFlags;
  FAllowFunctions := defAllowFunctionCall in AnEvalFlags;
  FAllowFunctionsAllThread := defFunctionCallRunAllThreads in AnEvalFlags;
  FRes := False;
end;

function TFpThreadWorkerEvaluateExpr.DebugText: String;
begin
  Result := inherited DebugText;
  if self = nil then exit;
  Result := Format('%s Expr: "%s" T: %s S: %s', [Result, FExpression, dbgs(FThreadId), dbgs(FStackFrame)]);
end;

{ TFpThreadWorkerCmdEval }

procedure TFpThreadWorkerCmdEval.DoCallback_DecRef(Data: PtrInt);
var
  CB: TDBGEvaluateResultCallback;
  Dbg: TFpDebugDebuggerBase;
  Res: Boolean;
  ResText: String;
  ResDbgType: TDBGType;
begin
  assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCmdEval.DoCallback_DecRef: system.ThreadID = classes.MainThreadID');
  CB := nil;
  try
    if FEvalFlags * [defNoTypeInfo, defSimpleTypeInfo, defFullTypeInfo] = [defNoTypeInfo] then
      FreeAndNil(FResText);

    if (FCallback <> nil) then begin
      // All to local vars, because SELF may be destroyed before/while the callback happens
      CB := FCallback;
      Dbg := FDebugger;
      Res := FRes;
      ResText := FResText;
      ResDbgType := FResDbgType;
      FResDbgType := nil; // prevent from being freed => will be freed in callback
      FCallback := nil; // Ensure callback is never called a 2nd time (e.g. if Self.Abort is called, while in Callback)
      (* We cannot call Callback here, because ABORT can be called, and prematurely call UnQueue_DecRef,
         removing the last ref to this object *)
    end;
  except
  end;

  UnQueue_DecRef;

  // Self may now be invalid, unless FDebugger.FEvalWorkItem still has a reference.
  // Abort may be called (during CB), removing this refence.
  // Abort would be called, if a new Evaluate Request is made. FEvalWorkItem<>nil
  if CB <> nil then
    CB(Dbg, Res, ResText, ResDbgType);
end;

procedure TFpThreadWorkerCmdEval.DoExecute;
begin
  inherited DoExecute;
  Queue(@DoCallback_DecRef);
end;

constructor TFpThreadWorkerCmdEval.Create(ADebugger: TFpDebugDebuggerBase;
  APriority: TFpThreadWorkerPriority; const AnExpression: String; AStackFrame,
  AThreadId: Integer; AnEvalFlags: TWatcheEvaluateFlags;
  ACallback: TDBGEvaluateResultCallback);
begin
  inherited Create(ADebugger, APriority, AnExpression, AStackFrame, AThreadId, 0, AnEvalFlags);
  FCallback := ACallback;
end;

destructor TFpThreadWorkerCmdEval.Destroy;
begin
  inherited Destroy;
  FreeAndNil(FResDbgType);
end;

procedure TFpThreadWorkerCmdEval.Abort;
begin
  RequestStop;
  FDebugger.WorkQueue.RemoveItem(Self);
  DoCallback_DecRef;
end;

{ TFpThreadWorkerWatchValueEval }

procedure TFpThreadWorkerWatchValueEval.DoExecute;
begin
  inherited DoExecute;
  Queue(@UpdateWatch_DecRef);
end;

{ TFpThreadWorkerBreakPoint }

procedure TFpThreadWorkerBreakPoint.AbortSetBreak;
begin
  //
end;

{ TFpThreadWorkerBreakPointSet }

procedure TFpThreadWorkerBreakPointSet.DoExecute;
var
  CurContext: TFpDbgSymbolScope;
  WatchPasExpr: TFpPascalExpression;
  R: TFpValue;
  s: TFpDbgValueSize;
begin
  if (FInternalBreakpoint <> nil) then begin
    FDebugger.DbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint);
    FreeAndNil(FInternalBreakpoint);
  end;

  if InterlockedExchange(FResetBreakPoint, 0) = 0 then begin
    case FKind of
      bpkAddress:
        FInternalBreakpoint := FDebugger.DbgController.CurrentProcess.AddUserBreak(FAddress, True);
      bpkSource:
        FInternalBreakpoint := FDebugger.DbgController.CurrentProcess.AddBreak(FSource, FLine, True);
      bpkData: begin
        CurContext := FDebugger.DbgController.CurrentProcess.FindSymbolScope(FThreadId, FStackFrame);
        if CurContext <> nil then begin
          WatchPasExpr := TFpPascalExpression.Create(FWatchData, CurContext, True);
          WatchPasExpr.IntrinsicPrefix := TFpDebugDebuggerProperties(FDebugger.GetProperties).IntrinsicPrefix;
          WatchPasExpr.AutoDeref := TFpDebugDebuggerProperties(FDebugger.GetProperties).AutoDeref;
          WatchPasExpr.Parse;
          R := WatchPasExpr.ResultValue; // Address and Size
          // TODO: Cache current value
          if WatchPasExpr.Valid and IsTargetNotNil(R.Address) and R.GetSize(s) then begin
            // pass context
            FInternalBreakpoint := FDebugger.DbgController.CurrentProcess.AddWatch(R.Address.Address, SizeToFullBytes(s), FWatchKind, FWatchScope);
          end;
          WatchPasExpr.Free;
          CurContext.ReleaseReference;
        end;
      end;
    end;
  end;

  if InterlockedExchange(FResetBreakPoint, 0) = 1 then begin
    if (FInternalBreakpoint <> nil) then begin
      FDebugger.DbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint);
      FreeAndNil(FInternalBreakpoint);
    end;
  end;
  Queue(@UpdateBrkPoint_DecRef);
end;

constructor TFpThreadWorkerBreakPointSet.Create(ADebugger: TFpDebugDebuggerBase; AnAddress: TDBGPtr);
begin
  FKind := bpkAddress;
  FAddress := AnAddress;
  inherited Create(ADebugger, twpUser);
end;

constructor TFpThreadWorkerBreakPointSet.Create(
  ADebugger: TFpDebugDebuggerBase; ASource: String; ALine: Integer);
begin
  FKind := bpkSource;
  FSource := ASource;
  FLine   := ALine;
  inherited Create(ADebugger, twpUser);
end;

constructor TFpThreadWorkerBreakPointSet.Create(
  ADebugger: TFpDebugDebuggerBase; AWatchData: String;
  AWatchScope: TDBGWatchPointScope; AWatchKind: TDBGWatchPointKind;
  AStackFrame, AThreadId: Integer);
begin
  FKind := bpkData;
  FWatchData  := AWatchData;
  FWatchScope := AWatchScope;
  FWatchKind  := AWatchKind;
  FStackFrame := AStackFrame;
  FThreadId   := AThreadId;
  inherited Create(ADebugger, twpUser);
end;

{ TFpThreadWorkerBreakPointRemove }

procedure TFpThreadWorkerBreakPointRemove.DoExecute;
begin
  if (FDebugger.DbgController <> nil) and (FDebugger.DbgController.CurrentProcess <> nil) then
    FDebugger.DbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint);
  FreeAndNil(FInternalBreakpoint);
end;

constructor TFpThreadWorkerBreakPointRemove.Create(
  ADebugger: TFpDebugDebuggerBase;
  AnInternalBreakpoint: FpDbgClasses.TFpDbgBreakpoint);
begin
  FInternalBreakpoint := AnInternalBreakpoint;
  inherited Create(ADebugger, twpUser);
end;

initialization
  DBG_VERBOSE     := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
  DBG_WARNINGS    := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
  FPDBG_FUNCCALL := DebugLogger.FindOrRegisterLogGroup('FPDBG_FUNCCALL' {$IFDEF FPDBG_FUNCCALL} , True {$ENDIF} );

end.