unit FpPascalBuilder;

Classes, SysUtils, Math, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgInfo,

FpdMemoryTools, FpErrorMessages, FpDbgDwarfDataClasses, FpDbgDwarf,

FpDbgClasses,

{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif},

LazUTF8, LazClasses, LazDebuggerIntfFloatTypes;

TDataDisplayFormat =

(ddfDefault,

ddfStructure,

ddfChar, ddfString,

ddfDecimal, ddfUnsigned, ddfHex, ddfBinary,

ddfPointer,

ddfMemDump

);

TTypeNameFlag = (

tnfOnlyDeclared, // do not return a substitute with ^ symbol

tnfNoSubstitute // do not return "{record}" if debug info has no type name

);

TTypeNameFlags = set of TTypeNameFlag;

TTypeDeclarationFlag = (

tdfNoFirstLineIndent,

tdfIncludeVarName, // like i: Integer

tdfSkipClassBody, // shorten class

tdfSkipRecordBody, // shorten class

tdfDynArrayWithPointer, // TODO, temp, act like gdb

tdfStopAfterPointer

);

TTypeDeclarationFlags = set of TTypeDeclarationFlag;

TFpPrettyPrintValueFlag = (

ppvCreateDbgType,

ppvSkipClassBody, ppvSkipRecordBody

);

TFpPrettyPrintValueFlags = set of TFpPrettyPrintValueFlag;

TFpPrettyPrintOption = (

ppoStackParam

);

TFpPrettyPrintOptions = set of TFpPrettyPrintOption;

PV_FORWARD_FLAGS = [ppvSkipClassBody, ppvSkipRecordBody];

PDBGType = ^TDBGType;

{ TFpPascalPrettyPrinter }

TFpPascalPrettyPrinter = class

private

FAddressSize: Integer;

FContext: TFpDbgLocationContext;

function InternalPrintValue(out APrintedValue: String;

AValue: TFpValue;

AnAddressSize: Integer;

AFlags: TFpPrettyPrintValueFlags;

ANestLevel: Integer; AnIndent: String;

ADisplayFormat: TDataDisplayFormat;

ARepeatCount: Integer = -1;

ADBGTypeInfo: PDBGType = nil;

AOptions: TFpPrettyPrintOptions = []

): Boolean;

public

constructor Create(AnAddressSize: Integer);

function PrintValue(out APrintedValue: String;

AValue: TFpValue;

ADisplayFormat: TDataDisplayFormat = ddfDefault;

ARepeatCount: Integer = -1;

AOptions: TFpPrettyPrintOptions = [];

AFlags: TFpPrettyPrintValueFlags = []

): Boolean;

function PrintValue(out APrintedValue: String;

out ADBGTypeInfo: TDBGType;

AValue: TFpValue;

ADisplayFormat: TDataDisplayFormat = ddfDefault;

ARepeatCount: Integer = -1

): Boolean;

property AddressSize: Integer read FAddressSize write FAddressSize;

property Context: TFpDbgLocationContext read FContext write FContext;

end;

function GetTypeName(out ATypeName: String; ADbgSymbol: TFpSymbol; AFlags: TTypeNameFlags = []): Boolean;

function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpSymbol;

AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean;

function GetParamsAsString(

AThread: TDbgThread;

ADbgCallStack: TDbgCallstackEntry;

AMemManager: TFpDbgMemManager;

ATargetWidth: Byte;

APrettyPrinter: TFpPascalPrettyPrinter): string;

function QuoteText(AText: Utf8String): UTf8String;

function GetParamsAsString(

AThread: TDbgThread;

ADbgCallStack: TDbgCallstackEntry;

AMemManager: TFpDbgMemManager;

ATargetWidth: Byte;

APrettyPrinter: TFpPascalPrettyPrinter): string;

ProcVal: TFpValue;

ProcSymbol: TFpSymbol;

AContext: TFpDbgSimpleLocationContext;

m: TFpValue;

v: String;

i: Integer;

result := '';

ProcSymbol := ADbgCallStack.ProcSymbol;

if assigned(ProcSymbol) then begin

ProcVal := ProcSymbol.Value;

if (ProcVal <> nil) then begin

AContext := TFpDbgSimpleLocationContext.Create(AMemManager,

LocToAddrOrNil(TargetLoc(ADbgCallStack.AnAddress)), ATargetWidth div 8, AThread.ID, ADbgCallStack.Index);

if AContext <> nil then begin

TFpValueDwarf(ProcVal).Context := AContext;

APrettyPrinter.Context := AContext;

APrettyPrinter.AddressSize := AContext.SizeOfAddress;

for i := 0 to ProcVal.MemberCount - 1 do begin

m := ProcVal.Member[i];

if (m <> nil) and (sfParameter in m.DbgSymbol.Flags) then begin

APrettyPrinter.PrintValue(v, m, ddfDefault, -1, [ppoStackParam]);

if result <> '' then result := result + ', ';

result := result + v;

end;

m.ReleaseReference;

end;

TFpValueDwarf(ProcVal).Context := nil;

AContext.ReleaseReference;

end;

ProcVal.ReleaseReference;

end;

if result <> '' then

result := '(' + result + ')';

end;

end;

function GetTypeName(out ATypeName: String; ADbgSymbol: TFpSymbol;

AFlags: TTypeNameFlags): Boolean;

s: String;

sym: TFpSymbol;

ATypeName := '';

Result := ADbgSymbol <> nil;

if not Result then

exit;

if (ADbgSymbol.SymbolType = stValue) then begin

ADbgSymbol := ADbgSymbol.TypeInfo;

Result := ADbgSymbol <> nil;

if not Result then

exit;

end;

ATypeName := ADbgSymbol.Name;

Result := ATypeName <> '';

if Result then

exit;

ATypeName := '';

sym := ADbgSymbol;

while (sym.Kind = skPointer) and (sym.TypeInfo <> nil) do begin

ATypeName := ATypeName + '^';

sym := sym.TypeInfo;

s := sym.Name;

if s <> '' then begin

ATypeName := ATypeName + s;

Result := True;

exit;

end;

end;

if tnfNoSubstitute in AFlags then

exit;

Result := True;

case ADbgSymbol.Kind of

skInstance: ATypeName := '{class}';

skProcedure: ATypeName := '{procedure}';

skFunction: ATypeName := '{function}';

skProcedureRef: ATypeName := '{procedure}';

skFunctionRef: ATypeName := '{function}';

skPointer: ATypeName := '{pointer}';

skInteger: ATypeName := '{signed int}';

skCardinal: ATypeName := '{unsigned int}';

skBoolean: ATypeName := '{boolean}';

skChar: ATypeName := '{char}';

skFloat: ATypeName := '{float}';

skString: ATypeName := '{string}';

skAnsiString: ATypeName := '{string}';

skCurrency: ATypeName := '{currency}';

skVariant: ATypeName := '{variant}';

skWideString: ATypeName := '{widestring}';

skEnum: ATypeName := '{enum}';

skSet: ATypeName := '{set}';

skRecord: ATypeName := '{record}';

skObject: ATypeName := '{object}';

skClass: ATypeName := '{class}';

skInterface: ATypeName := '{interface}';

else begin

ATypeName := '';

Result := False;

end;

end;

end;

function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpSymbol;

AFlags: TTypeDeclarationFlags; AnIndent: Integer): Boolean;

IndentString: String;

function GetIndent: String;

begin

if (IndentString = '') and (AnIndent > 0) then

IndentString := StringOfChar(' ', AnIndent);

Result := IndentString;

end;

function NeedBracket(S: String): Boolean;

var

i, l: Integer;

begin

l := 0;

i := length(s);

while (i > 0) do begin

case s[i] of

'a'..'z', 'A'..'Z', '0'..'9', '_', '$', '^': ;

'(': dec(l);

')': inc(l);

else

if l = 0 then break;

end;

dec(i);

end;

Result := i > 0;

end;

Function MembersAsGdbText(out AText: String; WithVisibilty: Boolean; ANewFlags: TTypeDeclarationFlags = []): Boolean;

var

CurVis: TDbgSymbolMemberVisibility;

procedure AddVisibility(AVis: TDbgSymbolMemberVisibility; AFirst: Boolean);

begin

if not (WithVisibilty and ((CurVis <> AVis) or AFirst)) then

exit;

CurVis := AVis;

case AVis of

svPrivate: AText := AText + GetIndent + ' private' + LineEnding;

svProtected: AText := AText + GetIndent + ' protected' + LineEnding;

svPublic: AText := AText + GetIndent + ' public' + LineEnding;

end;

end;

var

c, i: Integer;

m: TFpSymbol;

s: String;

r: Boolean;

begin

Result := True;

AText := '';

ANewFlags := ANewFlags + AFlags;

c := ADbgSymbol.NestedSymbolCount;

i := 0;

while (i < c) and Result do begin

m := ADbgSymbol.NestedSymbol[i];

AddVisibility(m.MemberVisibility, i= 0);

if tdfStopAfterPointer in ANewFlags then begin

r := GetTypeName(s, m);

s := m.Name + ': ' + s;

end

else

r := GetTypeAsDeclaration(s, m, [tdfIncludeVarName, tdfStopAfterPointer] + ANewFlags, AnIndent + 4);

if r then

AText := AText + GetIndent + s + ';' + LineEnding

else

AText := AText + m.Name + ': <unknown>;' + LineEnding;

inc(i);

end;

end;

function GetPointerType(out ADeclaration: String): Boolean;

var

s: String;

begin

s := '';

while (ADbgSymbol.Kind = skPointer) and (ADbgSymbol.TypeInfo <> nil) do begin

ADbgSymbol := ADbgSymbol.TypeInfo;

s := s + '^';

end;

if (tdfStopAfterPointer in AFlags) then begin

Result := GetTypeName(ADeclaration, ADbgSymbol, []);

end

else begin

Result := GetTypeAsDeclaration(ADeclaration, ADbgSymbol, AFlags + [tdfStopAfterPointer]);

if not Result then

Result := GetTypeName(ADeclaration, ADbgSymbol, []);

end;

if NeedBracket(ADeclaration)

then ADeclaration := s + '(' + ADeclaration + ')'

else ADeclaration := s + ADeclaration;

end;

function GetBaseType(out ADeclaration: String): Boolean;

var

s1, s2: String;

hb, lb: Int64;

begin

if sfSubRange in ADbgSymbol.Flags then begin

case ADbgSymbol.Kind of

// TODO: check bound are in size

skInteger: begin

Result := ADbgSymbol.GetValueBounds(nil, lb, hb);

if Result then ADeclaration := Format('%d..%d', [lb, hb]);

end;

skCardinal: begin

Result := ADbgSymbol.GetValueBounds(nil, lb, hb);

if Result then ADeclaration := Format('%u..%u', [QWord(lb), QWord(hb)]);

end;

skChar: begin

Result := ADbgSymbol.GetValueBounds(nil, lb, hb);

if (lb >= 32) and (hb <= 126)

then s1 := '''' + chr(lb) + ''''

else s1 := '#'+IntToStr(lb);

if (hb >= 32) and (hb <= 126)

then s2 := '''' + chr(hb) + ''''

else s2 := '#'+IntToStr(hb);

if Result then ADeclaration := Format('%s..%s', [s1, s2]);

end;

else

Result := False; // not sure how to show a subrange of skFloat, skBoolean, :

end;

end

else

Result := GetTypeName(ADeclaration, ADbgSymbol, []);

end;

function GetParameterList(out ADeclaration: String): Boolean;

var

i: Integer;

m: TFpSymbol;

name, lname: String;

begin

ADeclaration := '';

lname := '';

for i := 0 to ADbgSymbol.NestedSymbolCount - 1 do begin

m := ADbgSymbol.NestedSymbol[i];

if (m <> nil) and (sfParameter in m.Flags) then begin

GetTypeName(name, m, [tnfOnlyDeclared]);

if (lname <> '') then begin

if (lname = name) then

ADeclaration := ADeclaration + ', '

else

ADeclaration := ADeclaration + ': ' + lname + '; ';

end

else

if ADeclaration <> '' then

ADeclaration := ADeclaration + '; ';

ADeclaration := ADeclaration + m.Name;

lname := name;

end;

end;

if (lname <> '') then

ADeclaration := ADeclaration + ': ' + lname;

Result := True;

end;

function GetFunctionType(out ADeclaration: String): Boolean;

var

s, p: String;

begin

GetTypeAsDeclaration(s, ADbgSymbol.TypeInfo, AFlags);

GetParameterList(p);

ADeclaration := 'function ' + '(' + p + '): ' + s + '';

if sfVirtual in ADbgSymbol.Flags then ADeclaration := ADeclaration + '; virtual';

Result := true;

end;

function GetProcedureType(out ADeclaration: String): Boolean;

var

p: String;

begin

GetParameterList(p);

ADeclaration := 'procedure ' + '(' + p + ')';

if sfVirtual in ADbgSymbol.Flags then ADeclaration := ADeclaration + '; virtual';

Result := true;

end;

function GetClassType(out ADeclaration: String): Boolean;

var

s, s2: String;

begin

Result := tdfSkipClassBody in AFlags;

if Result then begin

GetTypeName(s, ADbgSymbol);

ADeclaration := s + ' {=class}';

exit;

end;

Result := MembersAsGdbText(s, True, [tdfSkipClassBody]);

if not GetTypeName(s2, ADbgSymbol.TypeInfo) then

s2 := '';

if Result then

ADeclaration := Format('class(%s)%s%s%send',

[s2, LineEnding, s, GetIndent]);

end;

function GetRecordType(out ADeclaration: String): Boolean;

var

s: String;

begin

if tdfSkipRecordBody in AFlags then begin

Result := True;

if GetTypeName(s, ADbgSymbol) then

ADeclaration := s + ' {=record}'

else

ADeclaration := Format('record {...};%s%send', [LineEnding, GetIndent]);

exit;

end;

Result := MembersAsGdbText(s, False);

if Result then

ADeclaration := Format('record%s%s%send', [LineEnding, s, GetIndent]);

end;

function GetObjectType(out ADeclaration: String): Boolean;

var

s: String;

begin

if tdfSkipRecordBody in AFlags then begin

Result := True;

if GetTypeName(s, ADbgSymbol) then

ADeclaration := s + ' {=object}'

else

ADeclaration := Format('object {...};%s%send', [LineEnding, GetIndent]);

exit;

end;

Result := MembersAsGdbText(s, False);

if Result then

ADeclaration := Format('object%s%s%send', [LineEnding, s, GetIndent]);

end;

function GetEnumType(out ADeclaration: String): Boolean;

var

i, j, val: Integer;

m: TFpSymbol;

begin

// TODO assigned value (a,b:=3,...)

Result := True;

ADeclaration := '(';

j := 0;

for i := 0 to ADbgSymbol.NestedSymbolCount - 1 do begin

m := ADbgSymbol.NestedSymbol[i];

if i > 0 then ADeclaration := ADeclaration + ', ';

ADeclaration := ADeclaration + m.Name;

if m.HasOrdinalValue then begin

val := m.OrdinalValue;

if j <> val then begin

ADeclaration := ADeclaration + ' := ' + IntToStr(val);

j := val;

continue;

end;

end;

inc(j);

end;

ADeclaration := ADeclaration + ')'

end;

function GetSetType(out ADeclaration: String): Boolean;

var

t: TFpSymbol;

s: String;

lb, hb: Int64;

begin

// TODO assigned value (a,b:=3,...)

t := ADbgSymbol.TypeInfo;

Result := t <> nil;

if not Result then exit;

case t.Kind of

skInteger: begin

Result := t.GetValueBounds(nil, lb, hb);

ADeclaration := format('set of %d..%d', [lb, hb]);

end;

skCardinal: begin

Result := t.GetValueBounds(nil, lb, hb);

ADeclaration := format('set of %u..%u', [QWord(lb), QWord(hb)]);

end;

skEnum: begin

if t.Name <> '' then begin

Result := True;

s := t.Name;

end

else

Result := GetTypeAsDeclaration(s, t, AFlags);

ADeclaration := 'set of ' + s;

end;

else

Result := False;

end;

end;

function GetArrayType(out ADeclaration: String): Boolean;

var

t: TFpSymbol;

s: String;

i: Integer;

lb, hb: Int64;

begin

// TODO assigned value (a,b:=3,...)

t := ADbgSymbol.TypeInfo;

Result := (t <> nil);

if not Result then exit;

s := t.Name;

if s = '' then begin

if tdfStopAfterPointer in AFlags then

Result := GetTypeName(s, t)

else

Result := GetTypeAsDeclaration(s, t, [tdfNoFirstLineIndent, tdfStopAfterPointer] + AFlags, AnIndent + 4); // no class ?

if not Result then exit;

end;

if sfDynArray in ADbgSymbol.Flags then begin //supprts only one level

ADeclaration := 'array of ' + s;

if tdfDynArrayWithPointer in AFlags then

ADeclaration := '^(' + ADeclaration + ')';

end

else begin

ADeclaration := 'array [';

for i := 0 to ADbgSymbol.NestedSymbolCount - 1 do begin

if i > 0 then

ADeclaration := ADeclaration + ', ';

t := ADbgSymbol.NestedSymbol[i];

t.GetValueBounds(nil, lb, hb);

if t.Kind = skCardinal

then ADeclaration := ADeclaration + Format('%u..%u', [QWord(lb), QWord(hb)])

else ADeclaration := ADeclaration + Format('%d..%d', [lb, hb]);

end;

ADeclaration := ADeclaration + '] of ' + s;

end;

end;

VarName: String;

Result := ADbgSymbol <> nil;

if not Result then

exit;

VarName := '';

if (ADbgSymbol.SymbolType = stValue) then begin

if tdfIncludeVarName in AFlags then

VarName := ADbgSymbol.Name;

ADbgSymbol := ADbgSymbol.TypeInfo;

Result := ADbgSymbol <> nil;

if not Result then

exit;

end;

case ADbgSymbol.Kind of

skPointer: Result := GetPointerType(ATypeDeclaration);

skInteger, skCardinal, skBoolean, skChar, skFloat:

Result := GetBaseType(ATypeDeclaration);

skFunction, skFunctionRef: Result := GetFunctionType(ATypeDeclaration);

skProcedure, skProcedureRef: Result := GetProcedureType(ATypeDeclaration);

skClass: Result := GetClassType(ATypeDeclaration);

skRecord: Result := GetRecordType(ATypeDeclaration);

skObject: Result := GetObjectType(ATypeDeclaration);

//skInterface: Result := GetInterfaceType(ATypeDeclaration);

skEnum: Result := GetEnumType(ATypeDeclaration);

skset: Result := GetSetType(ATypeDeclaration);

skArray: Result := GetArrayType(ATypeDeclaration);

skNone: ATypeDeclaration := '<unknown>';

else Result := GetBaseType(ATypeDeclaration);

end;

if VarName <> '' then

ATypeDeclaration := VarName + ': ' + ATypeDeclaration;

if (AnIndent <> 0) and not(tdfNoFirstLineIndent in AFlags) then

ATypeDeclaration := GetIndent + ATypeDeclaration;

end;

function QuoteWideText(AText: WideString): WideString;

HEXCHR: array [0..15] of char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

Len: Integer;

c: WideChar;

RPos, SPos, SEnd, QPos: PWideChar;

if AText = '' then

exit('''''');

Len := Length(AText);

SetLength(Result, Len * 4); // This is the maximal length result can get

RPos := @Result[1];

SPos := @AText[1];

SEnd := @AText[Len] + 1;

repeat

RPos^ := ''''; inc(RPos);

QPos := RPos;

repeat

c := SPos^;

case c of

#0..#31, #127, #$80..#$9F:

break;

'''': begin

RPos^ := c; inc(RPos);

RPos^ := c; inc(RPos);

inc(SPos);

end;

else begin

RPos^ := c; inc(RPos);

inc(SPos);

end;

end;

c := SPos^;

until False;;

if RPos = QPos then

dec(RPos)

else begin

RPos^ := ''''; inc(RPos);

end;

repeat

c := SPos^;

if (c = #0) and (SPos >= SEnd) then begin

// END OF TEXT

Assert(RPos-1 <= @Result[Length(Result)], 'RPos-1 <= @Result[Length(Result)]');

SetLength(Result, RPos - PWideChar(@Result[1]));

exit;

end;

RPos^ := '#'; inc(RPos);

RPos^ := '$'; inc(RPos);

RPos^ := HEXCHR[Byte(c) >> 4]; inc(RPos);

RPos^ := HEXCHR[Byte(c) and 15]; inc(RPos);

inc(SPos);

c := SPos^;

until not(c in [#0..#31, #127, #$80..#$9F]);

until False;

end;

function QuoteText(AText: Utf8String): UTf8String;

HEXCHR: array [0..15] of char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

Len: Integer;

c: Char;

RPos, SPos, SEnd, QPos: PChar;

if AText = '' then

exit('''''');

Len := Length(AText);

SetLength(Result, Len * 4); // This is the maximal length result can get

RPos := @Result[1];

SPos := @AText[1];

SEnd := @AText[Len] + 1;

repeat

RPos^ := ''''; inc(RPos);

QPos := RPos;

repeat

c := SPos^;

case c of

'''': begin

RPos^ := c; inc(RPos);

RPos^ := c; inc(RPos);

inc(SPos);

end;

#32..Pred(''''), Succ('''')..#126: begin

RPos^ := c; inc(RPos);

inc(SPos);

end;

#192..#223: begin

if ((Byte(SPos[1]) and $C0) <> $80)

then

break; // invalid utf8 -> escape

RPos^ := c; inc(RPos);

RPos^ := SPos[1]; inc(RPos);

inc(SPos, 2);

end;

#224..#239: begin

if ((Byte(SPos[1]) and $C0) <> $80) or ((Byte(SPos[2]) and $C0) <> $80)

then

break; // invalid utf8 -> escape

RPos^ := c; inc(RPos);

RPos^ := SPos[1]; inc(RPos);

RPos^ := SPos[2]; inc(RPos);

inc(SPos, 3);

end;

#240..#247: begin

if ((Byte(SPos[1]) and $C0) <> $80) or ((Byte(SPos[2]) and $C0) <> $80) or

((Byte(SPos[3]) and $C0) <> $80)

then

break; // invalid utf8 -> escape

RPos^ := c; inc(RPos);

RPos^ := SPos[1]; inc(RPos);

RPos^ := SPos[2]; inc(RPos);

RPos^ := SPos[3]; inc(RPos);

inc(SPos, 4);

end;

#0: begin

if (SPos < SEnd) then

break; // need escaping

// END OF TEXT

RPos^ := ''''; inc(RPos);

Assert(RPos-1 <= @Result[Length(Result)], 'RPos-1 <= @Result[Length(Result)]');

SetLength(Result, RPos - @Result[1]);

exit;

end;

else

break; // need escaping

end;

c := SPos^;

until False;

if RPos = QPos then

dec(RPos)

else begin

RPos^ := ''''; inc(RPos);

end;

repeat

c := SPos^;

if (c = #0) and (SPos >= SEnd) then begin

// END OF TEXT

Assert(RPos-1 <= @Result[Length(Result)], 'RPos-1 <= @Result[Length(Result)]');

SetLength(Result, RPos - @Result[1]);

exit;

end;

RPos^ := '#'; inc(RPos);

RPos^ := '$'; inc(RPos);

RPos^ := HEXCHR[Byte(c) >> 4]; inc(RPos);

RPos^ := HEXCHR[Byte(c) and 15]; inc(RPos);

inc(SPos);

c := SPos^;

until not(c in [#0..#31, #127, #$80..#$BF]);

until False;

end;

function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;

AValue: TFpValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags;

ANestLevel: Integer; AnIndent: String; ADisplayFormat: TDataDisplayFormat;

ARepeatCount: Integer; ADBGTypeInfo: PDBGType; AOptions: TFpPrettyPrintOptions): Boolean;

function ResTypeName: String;

begin

if not((AValue.TypeInfo<> nil) and

GetTypeName(Result, AValue.TypeInfo, []))

then

Result := '';

end;

function ResTypeName(AVal : TFpValue): String;

begin

if not((AVal.TypeInfo<> nil) and

GetTypeName(Result, AVal.TypeInfo, []))

then

Result := '';

end;

procedure DoPointer(AnAddress: boolean);

var

s: String;

v: QWord;

m: TFpValue;

begin

if ((ADisplayFormat = ddfDefault) and (ANestLevel=0)) or // default for unested: with typename

(ADisplayFormat = ddfStructure)

then

s := ResTypeName

else

s := '';

if AnAddress then

v := AValue.Address.Address

else

v := AValue.AsCardinal;

if (ppvCreateDbgType in AFlags) then begin

ADBGTypeInfo^ := TDBGType.Create(skPointer, s);

ADBGTypeInfo^.Value.AsPointer := Pointer(v); // TODO: no cut off

end;

case ADisplayFormat of

ddfDecimal, ddfUnsigned: APrintedValue := IntToStr(v);

ddfHex: APrintedValue := '$'+IntToHex(v, AnAddressSize*2);

else begin //ddfPointer/Default ;

if v = 0 then

APrintedValue := 'nil'

else

APrintedValue := '$'+IntToHex(v, AnAddressSize*2);

end;

end;

if ADisplayFormat = ddfPointer then begin

if s <> '' then

APrintedValue := s + '(' + APrintedValue + ')';

exit; // no data

end;

(* In Dwarf 2 Strings are Pchar => do not add the typename.

if svfString in AValue.FieldFlags then begin

if v <> 0 then

APrintedValue := APrintedValue + '^: ' + QuoteText(AValue.AsString);

end

else

if svfWideString in AValue.FieldFlags then begin

if v <> 0 then

APrintedValue := APrintedValue + '^: ' + QuoteWideText(AValue.AsWideString)

end

else begin

m := AValue.Member[0];

if (m<>nil) and (svfString in m.FieldFlags) then

APrintedValue := APrintedValue + '^: ' + QuoteText(m.AsString)

else

if (m<>nil) and (svfWideString in m.FieldFlags) then

APrintedValue := APrintedValue + '^: ' + QuoteWideText(m.AsWideString)

else

if s <> '' then

APrintedValue := s + '(' + APrintedValue + ')'; // no typeinfo for strings/pchar

m.ReleaseReference;

end;

Result := True;

end;

procedure DoUnknown;

begin

APrintedValue := 'Unknown type';

if svfAddress in AValue.FieldFlags then

APrintedValue := APrintedValue + '($'+IntToHex(AValue.Address.Address, AnAddressSize*2) + ')'

else

if svfDataAddress in AValue.FieldFlags then

APrintedValue := APrintedValue + '($'+IntToHex(AValue.DataAddress.Address, AnAddressSize*2) + ')';

Result := True;

end;

procedure DoType;

begin

// maybe include tdfIncludeVarName for structure members "TFooClass.SomeField"

if GetTypeAsDeclaration(APrintedValue, AValue.DbgSymbol) then

APrintedValue := 'type ' + APrintedValue

else

DoUnknown;

Result := True;

end;

procedure DoFunction;

var

s: String;

proc, procref: TFpSymbolDwarf;

t, sym: TFpSymbol;

par: TFpValueDwarf;

v: TFpDbgMemLocation;

va: TDBGPtr;

begin

proc := nil;

procref := nil;

v := AValue.DataAddress;

va := v.Address;

if (ppvCreateDbgType in AFlags) then begin

ADBGTypeInfo^ := TDBGType.Create(AValue.Kind, '');

if AValue.Kind in [skFunctionRef, skProcedureRef] then

ADBGTypeInfo^.Value.AsPointer := Pointer(va); // TODO: no cut off

end;

// TODO: depending on verbosity: TypeName($0123456)

if AValue.Kind in [skFunctionRef, skProcedureRef] then begin

if va = 0 then

APrintedValue := 'nil'

else

APrintedValue := '$'+IntToHex(va, AnAddressSize*2);

t := AValue.TypeInfo;

sym := AValue.DbgSymbol;

if (sym is TFpSymbolDwarfDataProc) then begin

proc := TFpSymbolDwarf(sym);

end

else begin

proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindProcSymbol(va));

procref := proc;

end;

if proc <> nil then begin

s := 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

s := par.TypeInfo.Name + '.' + s;

par.ReleaseReference;

end;

APrintedValue := APrintedValue + ' = ' + s; // TODO: offset to startaddress

end;

APrintedValue := APrintedValue + ': ';

end

else

t := AValue.DbgSymbol;

if (t is TFpSymbolDwarfDataProperty) and

(AValue is TFpValueDwarfProperty) and

(TFpValueDwarfProperty(AValue).GetterValue <> nil)

then

t := TFpValueDwarfProperty(AValue).GetterValue.DbgSymbol;

if AFlags * PV_FORWARD_FLAGS <> [] then

GetTypeName(s, t)

else

GetTypeAsDeclaration(s, t);

APrintedValue := APrintedValue + s;

if (AValue.Kind in [skFunction, skProcedure]) and Context.MemModel.IsReadableLocation(v) then begin

APrintedValue := APrintedValue + ' AT ' + '$'+IntToHex(va, AnAddressSize*2);

end;

ReleaseRefAndNil(procref);

Result := True;

end;

procedure DoInt;

var

n: Integer;

ValSize: TFpDbgValueSize;

begin

case ADisplayFormat of

ddfUnsigned: APrintedValue := IntToStr(QWord(AValue.AsInteger));

ddfHex: begin

if (svfSize in AValue.FieldFlags) and AValue.GetSize(ValSize) then

n := SizeToFullBytes(ValSize)* 2

else begin

n := 16;

if QWord(AValue.AsInteger) <= high(Cardinal) then n := 8;

if QWord(AValue.AsInteger) <= high(Word) then n := 3;

if QWord(AValue.AsInteger) <= high(Byte) then n := 2;

end;

APrintedValue := '$'+IntToHex(QWord(AValue.AsInteger), n);

end;

// TODO ddfChar:

else

// 128 bit values only fit in the string representation

if AValue.GetSize(ValSize) and (SizeToFullBytes(ValSize) > SizeOf(QWord)) then

APrintedValue := AValue.AsString

else

APrintedValue := IntToStr(AValue.AsInteger);

end;

if (ppvCreateDbgType in AFlags) then begin

ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);

//ADBGTypeInfo^.Value.As64Bits := QWord(AValue.AsInteger); // TODO: no cut off

end;

Result := True;

end;

procedure DoCardinal;

var

n: Integer;

ValSize: TFpDbgValueSize;

begin

case ADisplayFormat of