unit FpWatchResultData;

{$mode objfpc}{$H+}
{$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF}

interface

uses
  // DbgIntf
  LazDebuggerIntfFloatTypes, DbgIntfBaseTypes, LazDebuggerIntf,
  //
  FpDbgInfo, FpPascalBuilder, FpdMemoryTools, FpErrorMessages, FpDbgDwarf,
  FpDbgDwarfDataClasses, LazClasses, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, fgl, Math,
  SysUtils;

type

  TDbgPtrList = specialize TFPGList<TDBGPtr>;

  { TFpWatchResultConvertor }

  TFpWatchResultConvertor = class
  private const
    MAX_RECURSE_LVL = 10;
    MAX_RECURSE_LVL_ARRAY = 5;
    MAX_RECURSE_LVL_PTR = 8; // max depth for a chain of pointers starting at the initial value
  private
    FContext: TFpDbgLocationContext;
    FExtraDepth: Boolean;
    FFirstIndexOffs: Integer;
    FRecurseCnt, FRecurseCntLow,
    FRecursePointerCnt,
    FRecurseInstanceCnt, FRecurseDynArray, FRecurseArray: integer;
    FRecurseAddrList: TDbgPtrList;
    FLastValueKind: TDbgSymbolKind;
    FHasEmbeddedPointer: Boolean;
    FOuterArrayIdx, FTotalArrayCnt: integer;
    FRepeatCount: Integer;
    FArrayTypeDone: Boolean;
    FEncounteredError: Boolean;
  protected
    function CheckError(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): boolean;

    procedure AddTypeNameToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf; ADeref: Boolean = False);

    function TypeToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function PointerToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;
    function NumToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function CharToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;
    function StringToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;
    function WideStringToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function BoolToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;
    function EnumToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;
    function SetToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function FloatToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function ArrayToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function StructToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function ProcToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean;

    function DoValueToResData(AnFpValue: TFpValue;
                              AnResData: IDbgWatchDataIntf
                             ): Boolean; virtual;
    function DoWriteWatchResultData(AnFpValue: TFpValue;
                                  AnResData: IDbgWatchDataIntf
                                 ): Boolean;
    function DoWritePointerWatchResultData(AnFpValue: TFpValue;
                                  AnResData: IDbgWatchDataIntf;
                                  AnAddr: TDbgPtr
                                 ): Boolean;

    property RecurseCnt: Integer read FRecurseCnt;
    property RecurseCntLow: Integer read FRecurseCntLow;
  public
    constructor Create(AContext: TFpDbgLocationContext);
    destructor Destroy; override;

    function WriteWatchResultData(AnFpValue: TFpValue;
                                  AnResData: IDbgWatchDataIntf;
                                  ARepeatCount: Integer = 0
                                 ): Boolean;
    function WriteWatchResultMemDump(AnFpValue: TFpValue;
                                  AnResData: IDbgWatchDataIntf;
                                  ARepeatCount: Integer = 0
                                 ): Boolean;

    property Context: TFpDbgLocationContext read FContext write FContext;
    property ExtraDepth: Boolean read FExtraDepth write FExtraDepth;
    property FirstIndexOffs: Integer read FFirstIndexOffs write FFirstIndexOffs;
    //property RepeatCount: Integer read FRepeatCount write SetRepeatCount;
  end;



implementation

{ TFpWatchResultConvertor }

function TFpWatchResultConvertor.CheckError(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): boolean;
begin
  Result := AnFpValue = nil;
  if Result then
    exit;
  Result := IsError(AnFpValue.LastError);
  if Result then begin
    FEncounteredError := True;
    if AnResData <> nil then
      AnResData.CreateError(ErrorHandler.ErrorAsString(AnFpValue.LastError));
    AnFpValue.ResetError;
  end;
end;

procedure TFpWatchResultConvertor.AddTypeNameToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf; ADeref: Boolean);
var
  t: TFpSymbol;
  TpName: String;
begin
  if FArrayTypeDone then
    exit;
  t := AnFpValue.TypeInfo;
  if ADeref and (t <> nil) then
    t := t.TypeInfo;
  if (t <> nil) and
     GetTypeName(TpName, t, [tnfNoSubstitute]) and
     (TpName <> '')
  then
    AnResData.SetTypeName(TpName);
end;

function TFpWatchResultConvertor.TypeToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
var
  APrintedValue: String;
begin
  if GetTypeAsDeclaration(APrintedValue, AnFpValue.DbgSymbol) then
    AnResData.CreatePrePrinted('type '+APrintedValue)
  else
    AnResData.CreateError('Unknown type');
  Result := True;
end;

function TFpWatchResultConvertor.PointerToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
var
  DerefRes: IDbgWatchDataIntf;
  DerefVal: TFpValue;
  addr: QWord;
begin
  Result := True;
  addr := AnFpValue.AsCardinal;
  AnResData.CreatePointerValue(addr);
  AddTypeNameToResData(AnFpValue, AnResData);

  if CheckError(AnFpValue, AnResData) then
    exit;

  if addr = 0 then
    exit;

  if svfString in AnFpValue.FieldFlags then begin
    // PChar: Get zero-terminated string, rather than just one single char
    DerefRes := AnResData.SetDerefData;
    if DerefRes <> nil then begin
      DerefRes.CreateString(AnFpValue.AsString);
      AddTypeNameToResData(AnFpValue, DerefRes, True);
      CheckError(AnFpValue, DerefRes);
    end;
  end
  else
  if svfWideString in AnFpValue.FieldFlags then begin
    // PWideChar: Get zero-terminated string, rather than just one single char
    DerefRes := AnResData.SetDerefData;
    if DerefRes <> nil then begin
      DerefRes.CreateWideString(AnFpValue.AsWideString);
      AddTypeNameToResData(AnFpValue, DerefRes, True);
      CheckError(AnFpValue, DerefRes);
    end;
  end
  else begin
    DerefVal := AnFpValue.Member[0];
    if IsError(AnFpValue.LastError) then begin
      CheckError(AnFpValue, AnResData.SetDerefData);
    end
    else
    if (DerefVal <> nil) then begin
      DerefRes := nil;
      if (DerefVal.Kind in [skString, skAnsiString, skChar, skWideString,
          skInteger, skCardinal, skBoolean, skFloat, skCurrency, skEnum, skSet])
      then begin
        (* (Nested) Pointer to
           - Pascal-String type
           - Any basic type (any type that has no reference or internal pointer)
             (skChar should not happen: Should be PChar above)
           - Any other
        *)
        DerefRes := AnResData.SetDerefData;
        if DerefRes <> nil then begin
          // In case of nested pointer MAX_RECURSE_LVL may already be reached. Make an exception here, to allow one more.
          dec(FRecurseCnt);
          DoWritePointerWatchResultData(DerefVal, DerefRes, addr);
          inc(FRecurseCnt);
        end;
      end
      else
      if (DerefVal.Kind =skPointer) and (svfString in DerefVal.FieldFlags) then begin
        DerefRes := AnResData.SetDerefData;
        if DerefRes <> nil then begin
          DerefRes.CreateString(DerefVal.AsString);
          AddTypeNameToResData(DerefVal, DerefRes, True);
        end;
      end
      else
      if (DerefVal.Kind =skPointer) and (svfWideString in DerefVal.FieldFlags) then begin
        DerefRes := AnResData.SetDerefData;
        if DerefRes <> nil then begin
          DerefRes.CreateWideString(DerefVal.AsString);
          AddTypeNameToResData(DerefVal, DerefRes, True);
        end;
      end
      else begin
        DerefRes := AnResData.SetDerefData;
        if DerefRes <> nil then
          DoWritePointerWatchResultData(DerefVal, DerefRes, addr);
      end;

      CheckError(DerefVal, DerefRes);
      DerefVal.ReleaseReference;
    end;
  end;
end;

function TFpWatchResultConvertor.NumToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
begin
  Result := True;
  if AnFpValue.Kind = skCardinal then
    AnResData.CreateNumValue(AnFpValue.AsCardinal, False, SizeToFullBytes(AnFpValue.DataSize))
  else
    AnResData.CreateNumValue(QWord(AnFpValue.AsInteger), True, SizeToFullBytes(AnFpValue.DataSize));
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.CharToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
begin
  Result := True;
  AnResData.CreateCharValue(AnFpValue.AsCardinal, SizeToFullBytes(AnFpValue.DataSize));
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.StringToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
begin
  Result := True;
  AnResData.CreateString(AnFpValue.AsString);
  if svfDataAddress in AnFpValue.FieldFlags then
    AnResData.SetDataAddress(AnFpValue.DataAddress.Address);
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.WideStringToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
begin
  Result := True;
  AnResData.CreateWideString(AnFpValue.AsWideString);
  if svfDataAddress in AnFpValue.FieldFlags then
    AnResData.SetDataAddress(AnFpValue.DataAddress.Address);
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.BoolToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
begin
  Result := True;
  AnResData.CreateBoolValue(AnFpValue.AsCardinal, SizeToFullBytes(AnFpValue.DataSize));
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.EnumToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
var
  ValSize: TFpDbgValueSize;
begin
  Result := True;
  if not( (svfSize in AnFpValue.FieldFlags) and AnFpValue.GetSize(ValSize) ) then
    ValSize := ZeroSize;
  if IsError(AnFpValue.LastError) then
    ValSize := ZeroSize;
  AnFpValue.ResetError;

  AnResData.CreateEnumValue(AnFpValue.AsCardinal, AnFpValue.AsString, SizeToFullBytes(ValSize), AnFpValue.Kind=skEnumValue);
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.SetToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
var
  m: TFpValue;
  Names: array of String;
  i: Integer;
begin
  Result := True;
  SetLength(Names, AnFpValue.MemberCount);
  for i := 0 to AnFpValue.MemberCount-1 do begin
    m := AnFpValue.Member[i];
    if svfIdentifier in m.FieldFlags then
      Names[i] := m.AsString
    else
    if svfOrdinal in m.FieldFlags then // set of byte
      Names[i] := IntToStr(m.AsCardinal)
    else
      Names[i] := '';
    m.ReleaseReference;
  end;
  AnResData.CreateSetValue(Names);
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.FloatToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
begin
  Result := True;
  case AnFpValue.FloatPrecission of
    fpSingle:   AnResData.CreateFloatValue(AnFpValue.AsSingle);
    fpDouble:   AnResData.CreateFloatValue(AnFpValue.AsDouble);
    fpExtended: AnResData.CreateFloatValue(AnFpValue.AsExtended);
  end;
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.ArrayToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
const
  MAX_TOTAL_ARRAY_CNT = 5000;
  MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH = 3500; // reset
var
  Cnt, i, CurRecurseDynArray, OuterIdx, CacheCnt: Integer;
  LowBnd, StartIdx, CacheMax, CacheSize, j: Int64;
  Addr: TDBGPtr;
  ti: TFpSymbol;
  EntryRes: IDbgWatchDataIntf;
  MemberValue, TmpVal: TFpValue;
  Cache: TFpDbgMemCacheBase;
  Dummy: QWord;
  MLoc: TFpDbgMemLocation;
  ForceVariant: Boolean;
begin
  Result := True;

  Cnt := AnFpValue.MemberCount;
  if CheckError(AnFpValue, AnResData) then begin
    AddTypeNameToResData(AnFpValue, AnResData);
    exit;
  end;
  CurRecurseDynArray := FRecurseDynArray;
  OuterIdx := FOuterArrayIdx;

  if (AnFpValue.IndexTypeCount = 0) or (not AnFpValue.IndexType[0].GetValueLowBound(AnFpValue, LowBnd)) then
    LowBnd := 0;

  Addr := 0;
  ti := AnFpValue.TypeInfo;
  if (ti = nil) or (ti.Flags * [sfDynArray, sfStatArray] = []) then begin
    EntryRes := AnResData.CreateArrayValue(datUnknown, Cnt, LowBnd);
  end
  else
  if (sfDynArray in ti.Flags) and (LowBnd = 0) then begin // LowBnd = 0 => there is some bug, reporting some dyn arrays as stat.
    EntryRes := AnResData.CreateArrayValue(datDynArray, Cnt, 0);
    if AnFpValue.FieldFlags * [svfInteger, svfCardinal] <> [] then
      Addr := AnFpValue.AsCardinal
    else
    if svfDataAddress in AnFpValue.FieldFlags then
      Addr := AnFpValue.DataAddress.Address;
    AnResData.SetDataAddress(Addr);

    if FRecurseCnt >= 0 then
      inc(FRecurseDynArray);
  end
  else begin
    EntryRes := AnResData.CreateArrayValue(datStatArray, Cnt, LowBnd);
  end;

  AddTypeNameToResData(AnFpValue, AnResData);

  inc(FRecurseArray);
  Cache := nil;
  try
    if (Cnt <= 0) or
       (FHasEmbeddedPointer) or
       (FRecurseCnt > MAX_RECURSE_LVL_ARRAY) or
       ( (FRecurseCnt > 0) and (FTotalArrayCnt > MAX_TOTAL_ARRAY_CNT) )
    then
      exit;

    StartIdx := 0;
    If (FOuterArrayIdx < 0) and (FRecurseCnt = FRecurseCntLow) then
      StartIdx := FFirstIndexOffs;
    Cnt := max(1, Cnt - StartIdx);

    if (Context.MemManager.MemLimits.MaxArrayLen > 0) and (Cnt > Context.MemManager.MemLimits.MaxArrayLen) then
      Cnt := Context.MemManager.MemLimits.MaxArrayLen;

    If (FOuterArrayIdx < 0) and (FRecurseCnt = FRecurseCntLow) and (FRepeatCount > 0) then Cnt := FRepeatCount
    else if (FRecurseCnt > 1) and (FOuterArrayIdx >  10) and (Cnt >   10) then Cnt := 10
    else if (FRecurseCnt > 1) and (FOuterArrayIdx >   1) and (Cnt >   20) then Cnt := 20
    else if (FRecurseCnt > 0) and (FOuterArrayIdx > 100) and (Cnt >   10) then Cnt := 10
    else if (FRecurseCnt > 0) and (FOuterArrayIdx >   1) and (Cnt >   50) then Cnt := 50;

    /////////////////////
    // Bound types ??

    CacheMax  := StartIdx;
    CacheSize := 0;
    CacheCnt  := 200;
    //if (ti = nil) or (ti.Flags * [sfDynArray, sfStatArray] = []) then
    if (ti = nil) then
      MemberValue := nil  // could be mapped array slice, with non consecutive entries
    else
      MemberValue := AnFpValue.Member[StartIdx+LowBnd]; // // TODO : CheckError // ClearError for AnFpValue
    if (MemberValue = nil) or (not IsTargetNotNil(MemberValue.Address)) or
       (Context.MemManager.CacheManager = nil)
    then begin
      CacheMax := StartIdx + Cnt; // no caching possible
    end
    else begin
      repeat
        TmpVal := AnFpValue.Member[StartIdx + Min(CacheCnt, Cnt) + LowBnd]; // // TODO : CheckError // ClearError for AnFpValue
        if (TmpVal <> nil) and IsTargetNotNil(TmpVal.Address) then begin
          {$PUSH}{$R-}{$Q-}
          CacheSize := TmpVal.Address.Address - MemberValue.Address.Address;
          TmpVal.ReleaseReference;
          {$POP}
          if CacheSize > Context.MemManager.MemLimits.MaxMemReadSize then begin
            CacheSize := 0;
            CacheCnt := CacheCnt div 2;
            if CacheCnt <= 1 then
              break;
            continue;
          end;
        end;
        break;
      until false;
      if CacheSize = 0 then
        CacheMax := StartIdx + Cnt; // no caching possible
    end;
    MemberValue.ReleaseReference;

    ForceVariant := vfArrayOfVariant in AnFpValue.Flags;

    inc(FTotalArrayCnt, Cnt);
    for i := StartIdx to StartIdx + Cnt - 1 do begin
      if (FRecurseCnt < 0) and (FTotalArrayCnt > MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH) then
        FTotalArrayCnt := MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH;
      if i > FOuterArrayIdx then
        FOuterArrayIdx := i;

      MemberValue := AnFpValue.Member[i+LowBnd]; // // TODO : CheckError // ClearError for AnFpValue
      if (i >= CacheMax) and (CacheSize > 0) and (MemberValue <> nil) then begin
        if Cache <> nil then
          Context.MemManager.CacheManager.RemoveCache(Cache);
        Cache := nil;

        if IsTargetNotNil(MemberValue.Address) then begin
          CacheMax := Min(i + CacheCnt, StartIdx + Cnt);
          if (CacheMax > i + 1) then begin
            j := CacheMax - i;
            if j < CacheCnt then
              CacheSize := (CacheSize div CacheCnt) * j + j div 2;

            if CacheSize > 0 then
              Cache := Context.MemManager.CacheManager.AddCache(MemberValue.Address.Address, CacheSize)
          end;
        end
        else
          CacheMax := StartIdx + Cnt; // no caching possible
      end;

      EntryRes := AnResData.SetNextArrayData;
      if MemberValue = nil then begin
        EntryRes.CreateError('Error: Could not get member');
      end
      else begin
        if ForceVariant and not (vfVariant in MemberValue.Flags) then // vfVariant => variant will be created
          EntryRes := EntryRes.CreateVariantValue;
        DoWritePointerWatchResultData(MemberValue, EntryRes, Addr);
      end;

      if (i = StartIdx) and (MemberValue <> nil) and FEncounteredError and
         (ti <> nil) and (ti.Flags * [sfDynArray, sfStatArray] <> [])
      then begin
        FEncounteredError := False;
        MLoc := MemberValue.Address;
        if IsValidLoc(MLoc) then
          Context.ReadMemory(MLoc, SizeVal(1), @Dummy);
        if ( IsError(Context.LastMemError) or (not IsValidLoc(MLoc)) ) and
           (MLoc <> AnFpValue.DataAddress) and (IsValidLoc(AnFpValue.DataAddress))
        then
          Context.ReadMemory(AnFpValue.DataAddress, SizeVal(1), @Dummy);
        if IsError(Context.LastMemError) then begin
          // array is in unreadable memory
          AnResData.CreateError(ErrorHandler.ErrorAsString(Context.LastMemError));
          MemberValue.ReleaseReference;
          exit;
        end;
      end;

      MemberValue.ReleaseReference;
      if FRecurseArray = 1 then
        FArrayTypeDone := True;
    end;
    DebugLn(IsError(AnFpValue.LastError), ['!!! ArrayToResData() unexpected error in array value', ErrorHandler.ErrorAsString(AnFpValue.LastError)]);
    AnFpValue.ResetError;

  finally
    if FRecurseArray = 1 then
      FArrayTypeDone := False;
    FRecurseDynArray := CurRecurseDynArray;
    FOuterArrayIdx := OuterIdx;
    dec(FRecurseArray);
    if Cache <> nil then
      Context.MemManager.CacheManager.RemoveCache(Cache);
  end
end;

function TFpWatchResultConvertor.StructToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;

  procedure AddVariantMembers(VariantPart: TFpValue; ResAnch: IDbgWatchDataIntf);
  var
    VariantContainer, VMember: TFpValue;
    i, j, CurRecurseArray: Integer;
    ResField, ResList: IDbgWatchDataIntf;
    discr: QWord;
    hasDiscr, FoundDiscr, UseDefault, CurArrayTypeDone: Boolean;
    MBVis: TLzDbgFieldVisibility;
    n: String;
  begin
    VariantContainer := VariantPart.Member[-1];
    if VariantContainer = nil then
      exit;

    CurRecurseArray := FRecurseArray;
    CurArrayTypeDone := FArrayTypeDone;
    FArrayTypeDone := False;
    FRecurseArray := 0; // Allow an inside array to optimize
    try

    ResList := ResAnch.AddField('', dfvUnknown, [dffVariant]);
    ResList.CreateArrayValue(datUnknown);

    hasDiscr := (VariantContainer <> nil) and
      (VariantContainer.FieldFlags * [svfInteger, svfCardinal, svfOrdinal] <> []);
    if hasDiscr then begin
      discr := VariantContainer.AsCardinal;

      n := '';
      MBVis := dfvUnknown;
      if (VariantContainer.DbgSymbol <> nil) then begin
        n := VariantContainer.DbgSymbol.Name;
        case VariantContainer.DbgSymbol.MemberVisibility of
          svPrivate:   MBVis := dfvPrivate;
          svProtected: MBVis := dfvProtected;
          svPublic:    MBVis := dfvPublic;
          else         MBVis := dfvUnknown;
        end;
      end;

      if n <> '' then begin
        ResField := ResList.SetNextArrayData;
        ResField := ResField.CreateVariantValue(n, MBVis);
        if not DoWritePointerWatchResultData(VariantContainer, ResField, 0) then // addr
          ResField.CreateError('Unknown');
      end;
    end;
    VariantContainer.ReleaseReference;

    FoundDiscr := False;
    For UseDefault := (not hasDiscr) to True do begin
      for i := 0 to VariantPart.MemberCount - 1 do begin
        VariantContainer := VariantPart.Member[i];
        if (VariantContainer.DbgSymbol <> nil) and
           (VariantContainer.DbgSymbol is TFpSymbolDwarfTypeVariant) and
           ( ( (not UseDefault) and
               (TFpSymbolDwarfTypeVariant(VariantContainer.DbgSymbol).MatchesDiscr(discr))
             ) or
             ( (UseDefault) and
               (TFpSymbolDwarfTypeVariant(VariantContainer.DbgSymbol).IsDefaultDiscr)
             )
           )
        then begin
          FoundDiscr := True;
          for j := 0 to VariantContainer.MemberCount - 1 do begin
            VMember := VariantContainer.Member[j];
            n := '';
            MBVis := dfvUnknown;
            if (VMember.DbgSymbol <> nil) then begin
              n := VMember.DbgSymbol.Name;
              case VariantContainer.DbgSymbol.MemberVisibility of
                svPrivate:   MBVis := dfvPrivate;
                svProtected: MBVis := dfvProtected;
                svPublic:    MBVis := dfvPublic;
                else         MBVis := dfvUnknown;
              end;
            end;

// TODO visibility
            ResField := ResList.SetNextArrayData;
            ResField := ResField.CreateVariantValue(n, MBVis);
            if not DoWritePointerWatchResultData(VMember, ResField, 0) then // addr
              ResField.CreateError('Unknown');
            VMember.ReleaseReference;
          end;
        end;

        VariantContainer.ReleaseReference;
      end;
      if FoundDiscr then
        break;
    end;
    finally
      FRecurseArray := CurRecurseArray;
      FArrayTypeDone := CurArrayTypeDone;
    end;
  end;

type
  TAnchestorMap = specialize TFPGMap<PtrUInt, IDbgWatchDataIntf>;
var
  vt: TLzDbgStructType;
  Cache: TFpDbgMemCacheBase;
  AnchestorMap: TAnchestorMap;
  i, j, WasRecurseInstanceCnt: Integer;
  MemberValue: TFpValue;
  ti, sym: TFpSymbol;
  ResAnch, ResField, TopAnch, UnkAnch: IDbgWatchDataIntf;
  MbName: String;
  MBVis: TLzDbgFieldVisibility;
  Addr: TDBGPtr;
  Dummy: QWord;
  MLoc: TFpDbgMemLocation;
begin
  Result := True;

  case AnFpValue.Kind of
    skRecord:    vt := dstRecord;
    skObject:    vt := dstObject;
    skClass:     vt := dstClass;
    skInterface: vt := dstInterface;
    else         vt := dstUnknown;
  end;

  if not Context.MemManager.CheckDataSize(SizeToFullBytes(AnFpValue.DataSize)) then begin
    AnResData.CreateError(ErrorHandler.ErrorAsString(Context.LastMemError));
    exit;
  end;

  Addr := 0;
  if (AnFpValue.Kind in [skClass, skInterface]) then begin
    if AnFpValue.FieldFlags * [svfInteger, svfCardinal, svfOrdinal] <> [] then
      Addr := AnFpValue.AsCardinal
    else
    if svfDataAddress in AnFpValue.FieldFlags then
      Addr := AnFpValue.DataAddress.Address;
  end;

  AnResData.CreateStructure(vt, Addr);
  AddTypeNameToResData(AnFpValue, AnResData);

  if (AnFpValue.Kind in [skClass, skInterface]) and
     ( (Addr = 0) or
       (FRecurseInstanceCnt >= 1) or (FRecurseDynArray >= 2)
     )
  then
    exit;
  if FHasEmbeddedPointer then
    exit;

  if Context.MemManager.CacheManager <> nil then
    Cache := Context.MemManager.CacheManager.AddCache(AnFpValue.DataAddress.Address, SizeToFullBytes(AnFpValue.DataSize))
  else
    Cache := nil;

  AnchestorMap := TAnchestorMap.Create;
  WasRecurseInstanceCnt := FRecurseInstanceCnt;
  if (AnFpValue.Kind in [skClass, skInterface]) and (FRecurseCnt >= 0) then
    inc(FRecurseInstanceCnt);
  try
    TopAnch := AnResData;
    UnkAnch := nil;
    ti := AnFpValue.TypeInfo;
    if ti <> nil then
      ti := ti.InternalTypeInfo;

    if ti <> nil then begin
      AnchestorMap.Add(PtrUInt(ti), AnResData);

      if (AnFpValue.Kind in [skObject, skClass, skInterface]) then begin
        ti := ti.TypeInfo;
        ResAnch := AnResData;
        while ti <> nil do begin
          ResAnch := ResAnch.SetAnchestor(ti.Name);
          AnchestorMap.Add(PtrUInt(ti), ResAnch);
          ti := ti.TypeInfo;
        end;
        TopAnch := ResAnch;
      end;
    end;

    for i := 0 to AnFpValue.MemberCount-1 do begin
      MemberValue := AnFpValue.Member[i];
      if (MemberValue = nil) or (MemberValue.Kind in [skProcedure, skFunction]) then begin
        MemberValue.ReleaseReference;
        (* Has Field
           - $vmt => Constructor or Destructor
           - $vmt_aftercontstruction_local => Constructor
        *)
        continue;
      end;

      ResAnch := nil;
      ti := MemberValue.ParentTypeInfo; // TODO: variant returens nil, membervalue.sturcturevalue.parenttypesymbol
      if ti <> nil then
        ti := ti.InternalTypeInfo;
      j := AnchestorMap.IndexOf(PtrUInt(ti));
      if j >= 0 then begin
        ResAnch := AnchestorMap.Data[j];
      end
      else
      if UnkAnch <> nil then begin
        ResAnch := UnkAnch;
      end
      else begin
        UnkAnch := TopAnch.SetAnchestor('');
        ResAnch := UnkAnch;
      end;

      if MemberValue.Kind = skVariantPart then begin
        AddVariantMembers(MemberValue, ResAnch);
        MemberValue.ReleaseReference;
        continue;
      end;

      sym := MemberValue.DbgSymbol;
      MbName := MemberValue.Name;
      if sym <> nil then begin
        case sym.MemberVisibility of
          svPrivate:   MBVis := dfvPrivate;
          svProtected: MBVis := dfvProtected;
          svPublic:    MBVis := dfvPublic;
          else         MBVis := dfvUnknown;
        end;
      end
      else begin
        MBVis := dfvUnknown;
      end;

      ResField := ResAnch.AddField(MbName, MBVis, []);
      if not DoWritePointerWatchResultData(MemberValue, ResField, Addr) then
        ResField.CreateError('Unknown');

      if (i = 0) and (MemberValue <> nil) and FEncounteredError then begin
        MLoc := MemberValue.Address;
        if IsValidLoc(MLoc) then
          Context.ReadMemory(MemberValue.Address, SizeVal(1), @Dummy);
        if ( IsError(Context.LastMemError) or (not IsValidLoc(MLoc)) ) and
           (MLoc <> AnFpValue.DataAddress) and (IsValidLoc(AnFpValue.DataAddress))
        then
          Context.ReadMemory(AnFpValue.DataAddress, SizeVal(1), @Dummy);
        if IsError(Context.LastMemError) then begin
          // struct is in unreadable memory
          AnResData.CreateError(ErrorHandler.ErrorAsString(Context.LastMemError));
          MemberValue.ReleaseReference;
          exit;
        end;
      end;

      MemberValue.ReleaseReference;
    end;
  finally
    FRecurseInstanceCnt := WasRecurseInstanceCnt;
    AnchestorMap.Free;
    if Cache <> nil then
      Context.MemManager.CacheManager.RemoveCache(Cache)
  end;
end;

function TFpWatchResultConvertor.ProcToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
var
  addr: TDBGPtr;
  s, LocName: String;
  t, sym: TFpSymbol;
  proc: TFpSymbolDwarf;
  par: TFpValueDwarf;
begin
  Result := True;
  addr := AnFpValue.DataAddress.Address;

  LocName := '';
  if AnFpValue.Kind in [skFunctionRef, skProcedureRef] then begin
    t := AnFpValue.TypeInfo;
    sym := AnFpValue.DbgSymbol;
    proc := nil;
    if (sym <> nil) and (sym is TFpSymbolDwarfDataProc) then
      proc := TFpSymbolDwarf(sym)
    else
    if t <> nil then
      proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindProcSymbol(addr));

    if proc <> nil then begin
      LocName := proc.Name;
      if (proc is TFpSymbolDwarfDataProc) then begin
        par := TFpSymbolDwarfDataProc(proc).GetSelfParameter; // Has no Context set, but we only need TypeInfo.Name
        if (par <> nil) and (par.TypeInfo <> nil) then
          LocName := par.TypeInfo.Name + '.' + LocName;
        par.ReleaseReference;
      end;
      ReleaseRefAndNil(proc);
    end;
  end
  else
    t := AnFpValue.DbgSymbol;

  GetTypeAsDeclaration(s, t);

  case AnFpValue.Kind of
    skProcedure:    AnResData.CreateProcedure(addr, False, LocName, s);
    skFunction:     AnResData.CreateProcedure(addr, True, LocName, s);
    skProcedureRef: AnResData.CreateProcedureRef(addr, False, LocName, s);
    skFunctionRef:  AnResData.CreateProcedureRef(addr, True, LocName, s);
  end;
  AddTypeNameToResData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.DoValueToResData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
var
  PrettyPrinter: TFpPascalPrettyPrinter;
  s: String;
begin
  Result := False;
  FEncounteredError := False;
  case AnFpValue.Kind of
    skPointer:  Result := PointerToResData(AnFpValue, AnResData);
    skInteger,
    skCardinal: Result := NumToResData(AnFpValue, AnResData);
    skFloat:    Result := FloatToResData(AnFpValue, AnResData);

    skChar:       Result := CharToResData(AnFpValue, AnResData);
    skString,
    skAnsiString: Result := StringToResData(AnFpValue, AnResData);
    skWideString: Result := WideStringToResData(AnFpValue, AnResData);

    skRecord,
    skObject,
    skClass,
    skInterface: Result := StructToResData(AnFpValue, AnResData);

    //skNone: ;
    //skInstance: ;
    skUnit: begin
        AnResData.CreatePrePrinted('Unit: '+AnFpValue.DbgSymbol.Name);
        Result := True;
      end;
    skType: Result := TypeToResData(AnFpValue, AnResData);
    skProcedure,
    skFunction,
    skProcedureRef,
    skFunctionRef: Result := ProcToResData(AnFpValue, AnResData);
    skSimple: ;
    skBoolean:   Result := BoolToResData(AnFpValue, AnResData);
    skCurrency: ;
    skVariant: ;
    skEnum,
    skEnumValue: Result := EnumToResData(AnFpValue, AnResData);
    skSet:       Result := SetToResData(AnFpValue, AnResData);
    skArray:     Result := ArrayToResData(AnFpValue, AnResData);
    //skRegister: ;
    //skAddress: ;
    else begin
        if IsError(AnFpValue.LastError) then  // will be handled after the case
          AnResData.CreateError('Unknown data');
        Result := True;
      end;
  end;
  if Result then
    CheckError(AnFpValue, AnResData)
  else
  if FRecurseCnt > 0 then begin
    PrettyPrinter := TFpPascalPrettyPrinter.Create(Context.SizeOfAddress);
    PrettyPrinter.Context := Context;
    PrettyPrinter.PrintValue(s, AnFpValue, ddfDefault, 1, [], [ppvSkipClassBody]);
    AnResData.CreatePrePrinted(s);
    PrettyPrinter.Free;
    Result := True;
  end;

end;

function TFpWatchResultConvertor.DoWriteWatchResultData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf): Boolean;
var
  DidHaveEmbeddedPointer: Boolean;
begin
  // FRecurseCnt should be handled by the caller
  Result := (FRecurseCnt > MAX_RECURSE_LVL) or (AnFpValue = nil);
  if Result then
    exit;

  Result := False;

  DidHaveEmbeddedPointer := FHasEmbeddedPointer;
  if (FRecurseCnt <= 0) and
     ( (FLastValueKind = skPointer) or (FRecurseCnt=-1) ) and
     (AnFpValue.Kind = skPointer) and
     (FRecursePointerCnt < MAX_RECURSE_LVL_PTR)
  then begin
    inc(FRecursePointerCnt);
  end
  else begin
    inc(FRecurseCnt);
    if (AnFpValue.Kind = skPointer) then
      FHasEmbeddedPointer := True
    else
    if FHasEmbeddedPointer and (FLastValueKind <> skPointer) then // TODO: create a value as marker // also arrays cannot store the absence of a value
      exit(True); // not an error
      // Allow only one level, after an embedded pointer (pointer nested in other data-type)
  end;
  FLastValueKind := AnFpValue.Kind;
  try
    if vfVariant in AnFpValue.Flags then
      AnResData := AnResData.CreateVariantValue;

    Result := DoValueToResData(AnFpValue, AnResData);
  finally
    if FRecursePointerCnt > 0 then
      dec(FRecursePointerCnt)
    else
      dec(FRecurseCnt);
    FHasEmbeddedPointer := DidHaveEmbeddedPointer;
  end;
end;

function TFpWatchResultConvertor.DoWritePointerWatchResultData(
  AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf; AnAddr: TDbgPtr
  ): Boolean;
begin
  if FRecurseAddrList.IndexOf(AnAddr) >= 0 then begin
    AnResData.CreateError('Recursive Value at '+HexStr(AnAddr, 16)); // TOOD: correct size // TODO: dedicated entry
    exit(True);
  end;
  if AnAddr <> 0 then
    FRecurseAddrList.Add(AnAddr);
  Result := DoWriteWatchResultData(AnFpValue, AnResData);
  if AnAddr <> 0 then
    FRecurseAddrList.Remove(AnAddr);
end;

constructor TFpWatchResultConvertor.Create(AContext: TFpDbgLocationContext);
begin
  inherited Create;
  FRecurseAddrList := TDbgPtrList.Create;
  FContext := AContext;
end;

destructor TFpWatchResultConvertor.Destroy;
begin
  inherited Destroy;
  FRecurseAddrList.Free;
end;

function TFpWatchResultConvertor.WriteWatchResultData(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf; ARepeatCount: Integer): Boolean;
begin
  Result := False;
  if AnResData = nil then
    exit;
  if AnFpValue = nil then begin
    AnResData.CreateError('No Data');
    exit;
  end;
  if CheckError(AnFpValue, AnResData) then begin
    Result := True;
    exit;
  end;

  FRecurseAddrList.Clear;
  FRepeatCount := ARepeatCount;
  FRecurseCnt         := -1;
  if FExtraDepth then
    FRecurseCnt         := -2;
  FRecurseInstanceCnt :=  0;
  FRecurseDynArray    :=  0;
  FRecurseArray       := 0;
  FRecursePointerCnt := 0;
  FRecurseCntLow := FRecurseCnt+1;
  FOuterArrayIdx := -1;
  FTotalArrayCnt :=  0;
  FArrayTypeDone := False;

  FLastValueKind := AnFpValue.Kind;
  FHasEmbeddedPointer := False;
  Result := DoWriteWatchResultData(AnFpValue, AnResData);
end;

function TFpWatchResultConvertor.WriteWatchResultMemDump(AnFpValue: TFpValue;
  AnResData: IDbgWatchDataIntf; ARepeatCount: Integer): Boolean;
var
  MemAddr: TFpDbgMemLocation;
  MemSize: Integer;
  ValSize: TFpDbgValueSize;
  MemDest: RawByteString;
begin
  Result := True;

  MemAddr := UnInitializedLoc;
  if svfDataAddress in AnFpValue.FieldFlags then begin
    MemAddr := AnFpValue.DataAddress;
    MemSize := SizeToFullBytes(AnFpValue.DataSize);
  end
  else
  if svfAddress in AnFpValue.FieldFlags then begin
    MemAddr := AnFpValue.Address;
    if not AnFpValue.GetSize(ValSize) then
      ValSize := SizeVal(256);
    MemSize := SizeToFullBytes(ValSize);
  end
  else if AnFpValue is TFpValueConstNumber then begin
    MemAddr := TargetLoc(AnFpValue.AsCardinal);
    MemSize := 256;
  end;
  if MemSize < ARepeatCount then MemSize := ARepeatCount;
  if MemSize <= 0 then MemSize := 256;

  if not IsTargetAddr(MemAddr) then begin
    AnResData.CreateError('Value not in memory');
    exit;
  end;

  if not Context.MemManager.SetLength(MemDest, MemSize) then begin
    AnResData.CreateError(ErrorHandler.ErrorAsString(Context.MemManager.LastError));
    exit;
  end;

  if not FContext.ReadMemory(MemAddr, SizeVal(MemSize), @MemDest[1]) then begin
    AnResData.CreateError(ErrorHandler.ErrorAsString(Context.MemManager.LastError));
    exit;
  end;

  AnResData.CreateMemDump(MemDest);
  AnResData.SetDataAddress(MemAddr.Address);
end;

end.