1 {
2 ---------------------------------------------------------------------------
3 fpdbgdwarf.pas - Native Freepascal debugger - Dwarf symbol processing
4 ---------------------------------------------------------------------------
5
6 This unit contains helper classes for handling and evaluating of debuggee data
7 described by DWARF debug symbols
8
9 ---------------------------------------------------------------------------
10
11 @created(Mon Aug 1st WET 2006)
12 @lastmod($Date$)
13 @author(Marc Weustink <marc@@dommelstein.nl>)
14 @author(Martin Friebe)
15
16 ***************************************************************************
17 * *
18 * This source is free software; you can redistribute it and/or modify *
19 * it under the terms of the GNU General Public License as published by *
20 * the Free Software Foundation; either version 2 of the License, or *
21 * (at your option) any later version. *
22 * *
23 * This code is distributed in the hope that it will be useful, but *
24 * WITHOUT ANY WARRANTY; without even the implied warranty of *
25 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
26 * General Public License for more details. *
27 * *
28 * A copy of the GNU General Public License is available on the World *
29 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
30 * obtain it by writing to the Free Software Foundation, *
31 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
32 * *
33 ***************************************************************************
34 }
35 unit FpDbgDwarf;
36
37 {$mode objfpc}{$H+}
38 {$TYPEDADDRESS on}
39 {off $INLINE OFF}
40
41 (* Notes:
42
43 * FpDbgDwarfValues and Context
44 The Values do not add a reference to the Context. Yet they require the Context.
45 It is the users responsibility to keep the context, as long as any value exists.
46
47 *)
48
49 interface
50
51 uses
52 Classes, SysUtils, types, math, FpDbgInfo, FpDbgDwarfDataClasses,
53 FpdMemoryTools, FpErrorMessages, FpDbgUtil, FpDbgDwarfConst, FpDbgCommon,
54 DbgIntfBaseTypes, LazUTF8, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazClasses;
55
56 type
57 TFpDwarfInfo = FpDbgDwarfDataClasses.TFpDwarfInfo;
58
59 { TFpDwarfDefaultSymbolClassMap }
60
61 TFpDwarfDefaultSymbolClassMap = class(TFpSymbolDwarfClassMap)
62 private
63 class var ExistingClassMap: TFpSymbolDwarfClassMap;
64 protected
GetExistingClassMapnull65 class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
66 public
ClassCanHandleCompUnitnull67 class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
68 public
CanHandleCompUnitnull69 //function CanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
70 function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
CreateScopeForSymbolnull71 function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
CreateProcSymbolnull72 function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
73 AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase; override;
CreateUnitSymbolnull74 function CreateUnitSymbol(ACompilationUnit: TDwarfCompilationUnit;
75 AInfoEntry: TDwarfInformationEntry; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase; override;
76 end;
77
78 TFpValueDwarf = class;
79 TFpSymbolDwarf = class;
80 TFpDwarfInfoSymbolScope = class;
81
82 TDwarfCompilationUnitArray = array of TDwarfCompilationUnit;
83
84 { TFpThreadWorkerFindSymbolInUnits }
85
86 TFpThreadWorkerFindSymbolInUnits = class(TFpThreadWorkerItem)
87 protected
88 FScope: TFpDwarfInfoSymbolScope;
89 FCUs: TDwarfCompilationUnitArray;
90 FNameInfo: TNameSearchInfo;
91
92 FFoundInfoEntry: TDwarfInformationEntry;
93 FIsExt: Boolean;
94 procedure DoExecute; override;
95 public
96 constructor Create(AScope: TFpDwarfInfoSymbolScope; CUs: TDwarfCompilationUnitArray; const ANameInfo: TNameSearchInfo);
97 destructor Destroy; override;
98 end;
99
100 { TFpDwarfInfoSymbolScope }
101
102 TFpDwarfInfoSymbolScope = class(TFpDbgSymbolScope)
103 private
104 FSymbol: TFpSymbolDwarf;
105 FSelfParameter: TFpValueDwarf;
106 FAddress: TDBGPtr; // same as LocationContext.Address
107 FDwarf: TFpDwarfInfo;
108 protected
GetSymbolAtAddressnull109 function GetSymbolAtAddress: TFpSymbol; override;
GetProcedureAtAddressnull110 function GetProcedureAtAddress: TFpValue; override;
GetSizeOfAddressnull111 function GetSizeOfAddress: Integer; override;
GetMemManagernull112 function GetMemManager: TFpDbgMemManager; override;
113
114 property Symbol: TFpSymbolDwarf read FSymbol;
115 property Dwarf: TFpDwarfInfo read FDwarf;
116
117 procedure ApplyContext(AVal: TFpValue); inline;
SymbolToValuenull118 function SymbolToValue(ASym: TFpSymbolDwarf): TFpValue; inline;
GetSelfParameternull119 function GetSelfParameter: TFpValueDwarf;
120
FindExportedSymbolInUnitnull121 function FindExportedSymbolInUnit(CU: TDwarfCompilationUnit; const ANameInfo: TNameSearchInfo;
122 out AnInfoEntry: TDwarfInformationEntry; out AnIsExternal: Boolean): Boolean; inline;
FindExportedSymbolInUnitsnull123 function FindExportedSymbolInUnits(const AName: String; const ANameInfo: TNameSearchInfo;
124 SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpValue; const OnlyUnitNameLower: String = ''): Boolean;
FindSymbolInStructurenull125 function FindSymbolInStructure(const AName: String; const ANameInfo: TNameSearchInfo;
126 InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; inline;
127 // FindLocalSymbol: for the subroutine itself
FindLocalSymbolnull128 function FindLocalSymbol(const AName: String; const ANameInfo: TNameSearchInfo;
129 InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; virtual;
130 public
131 constructor Create(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo);
132 destructor Destroy; override;
FindSymbolnull133 function FindSymbol(const AName: String; const OnlyUnitName: String = ''): TFpValue; override;
134 end;
135
136 TFpSymbolDwarfType = class;
137 TFpSymbolDwarfData = class;
138 TFpSymbolDwarfDataClass = class of TFpSymbolDwarfData;
139 TFpSymbolDwarfTypeClass = class of TFpSymbolDwarfType;
140
141 PFpSymbolDwarfData = ^TFpSymbolDwarfData;
142
143 {%region Value objects }
144
145 { TFpValueDwarfBase }
146
147 TFpValueDwarfBase = class(TFpValue)
148 strict private
149 FLocContext: TFpDbgLocationContext;
150 procedure SetContext(AValue: TFpDbgLocationContext);
151 public
152 destructor Destroy; override;
153 property Context: TFpDbgLocationContext read FLocContext write SetContext;
154 end;
155
156 { TFpValueDwarfTypeDefinition }
157
158 TFpValueDwarfTypeDefinition = class(TFpValueDwarfBase)
159 private
160 FSymbol: TFpSymbolDwarf; // stType
161 protected
GetKindnull162 function GetKind: TDbgSymbolKind; override;
GetDbgSymbolnull163 function GetDbgSymbol: TFpSymbol; override;
164
GetMemberCountnull165 function GetMemberCount: Integer; override;
GetMemberByNamenull166 function GetMemberByName(const AIndex: String): TFpValue; override;
GetMembernull167 function GetMember(AIndex: Int64): TFpValue; override;
168 public
169 constructor Create(ASymbol: TFpSymbolDwarf); // Only for stType
170 destructor Destroy; override;
GetTypeCastedValuenull171 function GetTypeCastedValue(ADataVal: TFpValue): TFpValue; override;
172 end;
173
174 { TFpValueDwarf }
175
176 TFpValueDwarf = class(TFpValueDwarfBase)
177 private
178 FTypeSymbol: TFpSymbolDwarfType; // the creator, usually the type
179 FDataSymbol: TFpSymbolDwarfData;
180 FTypeCastSourceValue: TFpValue;
181
182 FCachedAddress, FCachedDataAddress: TFpDbgMemLocation;
183 (* FParentTypeSymbol
184 Container of any Symbol returned by GetNestedSymbol. (Set by GetNestedValue only)
185 E.g. For Members: the class in which they are declared (in case StructureValue is inherited)
186 Also: Enums, Array (others may set this but not used)
187 FParentTypeSymbol is hold as part of the type chain in FTypeSymbol // Therefore it does not need AddReference
188 *)
189 FParentTypeSymbol: TFpSymbolDwarfType;
190 FStructureValue: TFpValueDwarf;
191 FForcedSize: TFpDbgValueSize; // for typecast from array member
192 procedure SetStructureValue(AValue: TFpValueDwarf);
193 protected
GetSizeFornull194 function GetSizeFor(AnOtherValue: TFpValue; out ASize: TFpDbgValueSize): Boolean; inline;
AddressSizenull195 function AddressSize: Byte; inline;
196
197 // Address of the symbol (not followed any type deref, or location)
GetAddressnull198 function GetAddress: TFpDbgMemLocation; override;
DoGetSizenull199 function DoGetSize(out ASize: TFpDbgValueSize): Boolean; override;
OrdOrAddressnull200 function OrdOrAddress: TFpDbgMemLocation;
201 // Address of the data (followed type deref, location, ...)
OrdOrDataAddrnull202 function OrdOrDataAddr: TFpDbgMemLocation;
GetDataAddressnull203 function GetDataAddress: TFpDbgMemLocation; override;
GetDwarfDataAddressnull204 function GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TFpSymbolDwarfType = nil): Boolean;
GetStructureDwarfDataAddressnull205 function GetStructureDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
206 ATargetType: TFpSymbolDwarfType = nil): Boolean;
207
208 procedure Reset; override; // keeps lastmember and structureninfo
GetFieldFlagsnull209 function GetFieldFlags: TFpValueFieldFlags; override;
HasTypeCastInfonull210 function HasTypeCastInfo: Boolean;
IsValidTypeCastnull211 function IsValidTypeCast: Boolean; virtual;
GetKindnull212 function GetKind: TDbgSymbolKind; override;
GetMemberCountnull213 function GetMemberCount: Integer; override;
GetMemberByNamenull214 function GetMemberByName(const AIndex: String): TFpValue; override;
GetMembernull215 function GetMember(AIndex: Int64): TFpValue; override;
GetDbgSymbolnull216 function GetDbgSymbol: TFpSymbol; override;
GetTypeInfonull217 function GetTypeInfo: TFpSymbol; override;
GetParentTypeInfonull218 function GetParentTypeInfo: TFpSymbol; override;
219
220 property TypeCastSourceValue: TFpValue read FTypeCastSourceValue;
221 public
222 constructor Create(ADwarfTypeSymbol: TFpSymbolDwarfType);
223 destructor Destroy; override;
224 property TypeInfo: TFpSymbolDwarfType read FTypeSymbol;
MemManagernull225 function MemManager: TFpDbgMemManager; inline;
226 procedure SetDataSymbol(AValueSymbol: TFpSymbolDwarfData);
SetTypeCastInfonull227 function SetTypeCastInfo(ASource: TFpValue): Boolean; // Used for Typecast
228 // StructureValue: Any Value returned via GetMember points to its structure
229 property StructureValue: TFpValueDwarf read FStructureValue write SetStructureValue;
230 end;
231
232 TFpValueDwarfUnknown = class(TFpValueDwarf)
233 end;
234
235 { TFpValueDwarfSized }
236
237 TFpValueDwarfSized = class(TFpValueDwarf)
238 protected
CanUseTypeCastAddressnull239 function CanUseTypeCastAddress: Boolean;
GetFieldFlagsnull240 function GetFieldFlags: TFpValueFieldFlags; override;
241 end;
242
243 { TFpValueDwarfNumeric }
244
245 TFpValueDwarfNumeric = class(TFpValueDwarfSized)
246 protected
247 FEvaluated: set of (doneUInt, doneInt, doneAddr, doneFloat);
248 protected
249 procedure Reset; override;
GetFieldFlagsnull250 function GetFieldFlags: TFpValueFieldFlags; override; // svfOrdinal
IsValidTypeCastnull251 function IsValidTypeCast: Boolean; override;
252 public
253 constructor Create(ADwarfTypeSymbol: TFpSymbolDwarfType);
254 end;
255
256 { TFpValueDwarfInteger }
257
258 TFpValueDwarfInteger = class(TFpValueDwarfNumeric)
259 private
260 FIntValue: Int64;
261 protected
GetFieldFlagsnull262 function GetFieldFlags: TFpValueFieldFlags; override;
GetAsCardinalnull263 function GetAsCardinal: QWord; override;
GetAsIntegernull264 function GetAsInteger: Int64; override;
265 procedure SetAsInteger(AValue: Int64); override;
266 procedure SetAsCardinal(AValue: QWord); override;
267 end;
268
269 { TFpValueDwarfCardinal }
270
271 TFpValueDwarfCardinal = class(TFpValueDwarfNumeric)
272 private
273 FValue: QWord;
274 protected
GetAsCardinalnull275 function GetAsCardinal: QWord; override;
GetAsIntegernull276 function GetAsInteger: Int64; override;
277 procedure SetAsCardinal(AValue: QWord); override;
GetFieldFlagsnull278 function GetFieldFlags: TFpValueFieldFlags; override;
279 end;
280
281 { TFpValueDwarfFloat }
282
283 TFpValueDwarfFloat = class(TFpValueDwarfNumeric) // TDbgDwarfSymbolValue
284 // TODO: typecasts to int should convert
285 private
286 FValue: Extended;
287 protected
GetFieldFlagsnull288 function GetFieldFlags: TFpValueFieldFlags; override;
GetAsFloatnull289 function GetAsFloat: Extended; override;
290 end;
291
292 { TFpValueDwarfBoolean }
293
294 TFpValueDwarfBoolean = class(TFpValueDwarfCardinal)
295 protected
GetFieldFlagsnull296 function GetFieldFlags: TFpValueFieldFlags; override;
GetAsBoolnull297 function GetAsBool: Boolean; override;
298 procedure SetAsBool(AValue: Boolean); override;
299 end;
300
301 { TFpValueDwarfChar }
302
303 TFpValueDwarfChar = class(TFpValueDwarfCardinal)
304 protected
305 // returns single char(byte) / widechar
GetFieldFlagsnull306 function GetFieldFlags: TFpValueFieldFlags; override;
GetAsStringnull307 function GetAsString: AnsiString; override;
GetAsWideStringnull308 function GetAsWideString: WideString; override;
309 procedure SetAsString(AValue: AnsiString); override;
310 end;
311
312 { TFpValueDwarfPointer }
313
314 TFpValueDwarfPointer = class(TFpValueDwarfNumeric)
315 private
316 FPointedToAddr: TFpDbgMemLocation;
GetDerefAddressnull317 function GetDerefAddress: TFpDbgMemLocation;
318 protected
GetAsCardinalnull319 function GetAsCardinal: QWord; override;
320 procedure SetAsCardinal(AValue: QWord); override;
GetFieldFlagsnull321 function GetFieldFlags: TFpValueFieldFlags; override;
GetDataAddressnull322 function GetDataAddress: TFpDbgMemLocation; override;
GetAsStringnull323 function GetAsString: AnsiString; override;
GetAsWideStringnull324 function GetAsWideString: WideString; override;
GetMembernull325 function GetMember(AIndex: Int64): TFpValue; override;
326 end;
327
328 { TFpValueDwarfEnum }
329
330 TFpValueDwarfEnum = class(TFpValueDwarfNumeric)
331 private
332 FValue: QWord;
333 FMemberIndex: Integer;
334 FMemberValueDone: Boolean;
335 procedure InitMemberIndex;
336 protected
337 procedure Reset; override;
IsValidTypeCastnull338 //function IsValidTypeCast: Boolean; override;
339 function GetFieldFlags: TFpValueFieldFlags; override;
GetAsCardinalnull340 function GetAsCardinal: QWord; override;
341 procedure SetAsCardinal(AValue: QWord); override;
GetAsStringnull342 function GetAsString: AnsiString; override;
343 procedure SetAsString(AValue: AnsiString); override;
344 // Has exactly 0 (if the ordinal value is out of range) or 1 member (the current value's enum)
345 function GetMemberCount: Integer; override;
346 function GetMember({%H-}AIndex: Int64): TFpValue; override;
347 end;
348
349 { TFpValueDwarfEnumMember }
350
351 TFpValueDwarfEnumMember = class(TFpValueDwarf)
352 private
353 FOwnerVal: TFpSymbolDwarfData;
354 protected
355 function GetFieldFlags: TFpValueFieldFlags; override;
356 function GetAsCardinal: QWord; override;
357 function GetAsString: AnsiString; override;
358 function IsValidTypeCast: Boolean; override;
359 function GetKind: TDbgSymbolKind; override;
360 public
361 constructor Create(AOwner: TFpSymbolDwarfData);
362 end;
363
364 { TFpValueDwarfConstNumber }
365
366 TFpValueDwarfConstNumber = class(TFpValueConstNumber)
367 protected
368 procedure Update(AValue: QWord; ASigned: Boolean);
369 end;
370
371 { TFpValueDwarfSet }
372
373 TFpValueDwarfSet = class(TFpValueDwarfSized)
374 private
375 FMem: array of Byte;
376 FMemberCount: Integer;
377 FMemberMap: array of Integer;
378 FNumValue: TFpValueDwarfConstNumber;
379 FTypedNumValue: TFpValue;
380 procedure InitMap;
381 protected
382 procedure Reset; override;
383 function GetFieldFlags: TFpValueFieldFlags; override;
384 function GetMemberCount: Integer; override;
385 function GetMember(AIndex: Int64): TFpValue; override;
386 function GetAsCardinal: QWord; override; // only up to qmord
387 function IsValidTypeCast: Boolean; override;
388 procedure SetAsString(AValue: AnsiString); override;
389 public
390 destructor Destroy; override;
391 end;
392
393 { TFpValueDwarfStruct }
394
395 { TFpValueDwarfStructBase }
396
397 TFpValueDwarfStructBase = class(TFpValueDwarf)
398 protected
399 function GetMember(AIndex: Int64): TFpValue; override;
400 function GetMemberByName(const AIndex: String): TFpValue; override;
401 end;
402
403 TFpValueDwarfStruct = class(TFpValueDwarfStructBase)
404 private
405 FDataAddressDone: Boolean;
406 protected
407 procedure Reset; override;
408 function GetFieldFlags: TFpValueFieldFlags; override;
409 function GetAsCardinal: QWord; override;
410 procedure SetAsCardinal(AValue: QWord); override;
411 function GetDataSize: TFpDbgValueSize; override;
412 function IsValidTypeCast: Boolean; override;
413 end;
414
415 { TFpValueDwarfConstAddress }
416
417 TFpValueDwarfConstAddress = class(TFpValueConstAddress)
418 protected
419 procedure Update(AnAddress: TFpDbgMemLocation);
420 end;
421
422 { TFpValueDwarfArray }
423 TFpSymbolDwarfTypeArray = class;
424
425 TFpValueDwarfArray = class(TFpValueDwarf)
426 private
427 FEvalFlags: set of (efMemberSizeDone, efMemberSizeUnavail,
428 efStrideDone, efStrideUnavail,
429 efMainStrideDone, efMainStrideUnavail,
430 efRowMajorDone, efRowMajorUnavail,
431 efBoundsDone, efBoundsUnavail);
432 FAddrObj: TFpValueDwarfConstAddress;
433 FArraySymbol: TFpSymbolDwarfTypeArray;
434 FLastMember: TFpValueDwarf;
435 FRowMajor: Boolean;
436 FMemberSize: TFpDbgValueSize;
437 FStride, FMainStride: TFpDbgValueSize;
438 FStrides: array of bitpacked record Stride: TFpDbgValueSize; Done, Unavail: Boolean; end; // nested idx
439 FBounds: array of array[0..1] of int64;
440 procedure DoGetBounds; virtual;
441 protected
442 procedure Reset; override;
443 function GetFieldFlags: TFpValueFieldFlags; override;
444 function GetKind: TDbgSymbolKind; override;
445 function GetAsCardinal: QWord; override;
446 function GetMember(AIndex: Int64): TFpValue; override;
447 function GetMemberEx(const AIndex: array of Int64): TFpValue; override;
448 function GetMemberCount: Integer; override;
449 function GetMemberCountEx(const AIndex: array of Int64): Integer; override;
450 function GetHasBounds: Boolean; override;
451 function GetOrdLowBound: Int64; override;
452 function GetOrdHighBound: Int64; override;
453 function GetIndexType(AIndex: Integer): TFpSymbol; override;
454 function GetIndexTypeCount: Integer; override;
455 function IsValidTypeCast: Boolean; override;
456 function DoGetOrdering(out ARowMajor: Boolean): Boolean; virtual;
457 function DoGetStride(out AStride: TFpDbgValueSize): Boolean; virtual;
458 function DoGetMemberSize(out ASize: TFpDbgValueSize): Boolean; virtual; // array.stride or typeinfe.size
459 function DoGetMainStride(out AStride: TFpDbgValueSize): Boolean; virtual;
460 function DoGetDimStride(AnIndex: integer; out AStride: TFpDbgValueSize): Boolean; virtual;
461 public
462 constructor Create(ADwarfTypeSymbol: TFpSymbolDwarfType; AnArraySymbol :TFpSymbolDwarfTypeArray);
463 destructor Destroy; override;
464 function GetOrdering(out ARowMajor: Boolean): Boolean; inline;
465 function GetStride(out AStride: TFpDbgValueSize): Boolean; inline; // UnAdjusted Stride
466 function GetMemberSize(out ASize: TFpDbgValueSize): Boolean; inline; // array.stride or typeinfe.size
467 function GetMainStride(out AStride: TFpDbgValueSize): Boolean; inline; // Most inner idx
468 function GetDimStride(AnIndex: integer; out AStride: TFpDbgValueSize): Boolean; inline; // outer idx // AnIndex start at 1
469 end;
470
471 { TFpValueDwarfSubroutine }
472
473 TFpValueDwarfSubroutine = class(TFpValueDwarf)
474 protected
475 function IsValidTypeCast: Boolean; override;
476 end;
477 {%endregion Value objects }
478
479 {%region Symbol objects }
480
481 TInitLocParserData = record
482 (* DW_AT_data_member_location: Is always pushed on stack
483 DW_AT_data_location: Is avalibale for DW_OP_push_object_address
484 *)
485 ObjectDataAddress: TFpDbgMemLocation;
486 ObjectDataAddrPush: Boolean; // always push ObjectDataAddress on stack: DW_AT_data_member_location
487 end;
488 PInitLocParserData = ^TInitLocParserData;
489
490 (* TFpDwarfAtEntryDataReadState
491 Since Dwarf-3 several DW_AT_* can be const, expression or reference.
492 *)
493 TFpDwarfAtEntryDataReadState = (rfNotRead, rfNotFound, rfError, rfConst, rfValue, rfExpression);
494 PFpDwarfAtEntryDataReadState = ^TFpDwarfAtEntryDataReadState;
495
496 { TFpSymbolDwarf }
497
498 TFpSymbolDwarf = class(TDbgDwarfSymbolBase)
499 private
500 FNestedTypeInfo: TFpSymbolDwarfType;
501 (* FLocalProcInfo: the procedure in which a local symbol is defined/used *)
502 FLocalProcInfo: TFpSymbolDwarf;
503 FDwarfReadFlags: set of (didtNameRead, didtTypeRead, didtArtificialRead, didtIsArtifical);
504 function GetNestedTypeInfo: TFpSymbolDwarfType;
505 function GetTypeInfo: TFpSymbolDwarfType; inline;
506 protected
507 procedure SetLocalProcInfo(AValue: TFpSymbolDwarf); virtual;
508
509 function DoGetNestedTypeInfo: TFpSymbolDwarfType; virtual;
510 function ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
511 function IsArtificial: Boolean; // usud by formal param and subprogram
512 procedure NameNeeded; override;
513 procedure TypeInfoNeeded; override;
514 property NestedTypeInfo: TFpSymbolDwarfType read GetNestedTypeInfo;
515
516 // LocalProcInfo: funtion for local var / param
517 property LocalProcInfo: TFpSymbolDwarf read FLocalProcInfo write SetLocalProcInfo;
518
519 function DoForwardReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; inline;
520 function DoReadDataSize(const AValueObj: TFpValue; out ADataSize: TFpDbgValueSize): Boolean; virtual;
521 protected
522 function InitLocationParser(const {%H-}ALocationParser: TDwarfLocationExpression;
523 AnInitLocParserData: PInitLocParserData = nil): Boolean; virtual;
524 function ComputeDataMemberAddress(const AnInformationEntry: TDwarfInformationEntry;
525 AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation): Boolean; inline;
526 function ConstRefOrExprFromAttrData(const AnAttribData: TDwarfAttribData;
527 AValueObj: TFpValueDwarf; out AValue: Int64;
528 AReadState: PFpDwarfAtEntryDataReadState = nil;
529 ADataSymbol: PFpSymbolDwarfData = nil): Boolean;
530 function LocationFromAttrData(const AnAttribData: TDwarfAttribData; AValueObj: TFpValueDwarf;
531 var AnAddress: TFpDbgMemLocation; // kept, if tag does not exist
532 AnInitLocParserData: PInitLocParserData = nil;
533 AnAdjustAddress: Boolean = False
534 ): Boolean;
535 function LocationFromTag(ATag: Cardinal; AValueObj: TFpValueDwarf;
536 var AnAddress: TFpDbgMemLocation; // kept, if tag does not exist
537 AnInitLocParserData: PInitLocParserData = nil;
538 ASucessOnMissingTag: Boolean = False
539 ): Boolean; // deprecated
540 function ConstantFromTag(ATag: Cardinal; out AConstData: TByteDynArray;
541 var AnAddress: TFpDbgMemLocation; // kept, if tag does not exist
542 AnInformationEntry: TDwarfInformationEntry = nil;
543 ASucessOnMissingTag: Boolean = False
544 ): Boolean;
545 // GetDataAddress: data of a class, or string
546 function GetDataAddress(AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation;
547 ATargetType: TFpSymbolDwarfType = nil): Boolean;
548 function GetNextTypeInfoForDataAddress(ATargetType: TFpSymbolDwarfType): TFpSymbolDwarfType; virtual;
549 function GetDataAddressNext(AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation;
550 out ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean; virtual;
551 function HasAddress: Boolean; virtual;
552
553 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; virtual;
554 function GetNestedSymbolExByName(const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; virtual;
555 function GetNestedSymbol(AIndex: Int64): TFpSymbol; override;
556 function GetNestedSymbolByName(const AIndex: String): TFpSymbol; override;
557
558 procedure Init; override;
559 public
560 class function CreateSubClass(const AName: String; AnInformationEntry: TDwarfInformationEntry): TFpSymbolDwarf;
561 destructor Destroy; override;
562 function GetNestedValue(AIndex: Int64): TFpValueDwarf; inline;
563 function GetNestedValueByName(const AIndex: String): TFpValueDwarf; inline;
564 function StartScope: TDbgPtr; // return 0, if none. 0 includes all anyway
565 property TypeInfo: TFpSymbolDwarfType read GetTypeInfo;
566 end;
567
568 { TFpSymbolDwarfData }
569
570 TFpSymbolDwarfData = class(TFpSymbolDwarf) // var, const, member, ...
571 protected
572 function GetValueAddress({%H-}AValueObj: TFpValueDwarf;{%H-} out AnAddress: TFpDbgMemLocation): Boolean; virtual;
573 procedure KindNeeded; override;
574 procedure MemberVisibilityNeeded; override;
575
576 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
577 function GetNestedSymbolExByName(const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
578 function GetNestedSymbolCount: Integer; override;
579
580 procedure Init; override;
581 public
582 class function CreateValueSubClass(const AName: String; AnInformationEntry: TDwarfInformationEntry): TFpSymbolDwarfData;
583 end;
584
585 { TFpSymbolDwarfDataWithLocation }
586
587 TFpSymbolDwarfDataWithLocation = class(TFpSymbolDwarfData)
588 private
589 procedure FrameBaseNeeded(ASender: TObject); // Sender = TDwarfLocationExpression
590 protected
591 function GetValueObject: TFpValue; override;
592 function InitLocationParser(const ALocationParser: TDwarfLocationExpression;
593 AnInitLocParserData: PInitLocParserData): Boolean; override;
594 end;
595
596 { TFpSymbolDwarfFunctionResult }
597
598 TFpSymbolDwarfFunctionResult = class(TFpSymbolDwarfDataWithLocation)
599 protected
600 function GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean; override;
601 procedure Init; override;
602 end;
603
604 TFpSymbolDwarfThirdPartyExtension = class(TFpSymbolDwarf)
605 end;
606
607 { TFpSymbolDwarfType }
608
609 (* Types and allowed tags in dwarf 2
610
611 DW_TAG_enumeration_type, DW_TAG_subroutine_type, DW_TAG_union_type,
612 DW_TAG_ptr_to_member_type, DW_TAG_set_type, DW_TAG_subrange_type, DW_TAG_file_type,
613 DW_TAG_thrown_type
614
615 DW_TAG_base_type
616 DW_AT_encoding Y
617 DW_AT_bit_offset Y
618 DW_AT_bit_size Y
619
620 DW_TAG_base_type
621 | DW_TAG_typedef
622 | | DW_TAG_string_type
623 | | | DW_TAG_array_type
624 | | | |
625 | | | | DW_TAG_class_type
626 | | | | | DW_TAG_structure_type
627 | | | | | |
628 | | | | | | DW_TAG_enumeration_type
629 | | | | | | | DW_TAG_set_type
630 | | | | | | | | DW_TAG_enumerator
631 | | | | | | | | | DW_TAG_subrange_type
632 DW_AT_name Y Y Y Y Y Y Y Y Y Y
633 DW_AT_sibling Y Y Y Y Y Y Y Y Y Y
634 DECL Y Y Y Y Y Y Y Y Y
635 DW_AT_byte_size Y Y Y Y Y Y Y Y
636 DW_AT_abstract_origin Y Y Y Y Y Y Y Y
637 DW_AT_accessibility Y Y Y Y Y Y Y Y
638 DW_AT_declaration Y Y Y Y Y Y Y Y
639 DW_AT_start_scope Y Y Y Y Y Y Y
640 DW_AT_visibility Y Y Y Y Y Y Y Y
641 DW_AT_type Y Y Y Y
642 DW_AT_segment Y DW_TAG_string_type
643 DW_AT_string_length Y
644 DW_AT_ordering Y DW_TAG_array_type
645 DW_AT_stride_size Y
646 DW_AT_const_value Y DW_TAG_enumerator
647 DW_AT_count Y DW_TAG_subrange_type
648 DW_AT_lower_bound Y
649 DW_AT_upper_bound Y
650
651 DW_TAG_pointer_type
652 | DW_TAG_reference_type
653 | | DW_TAG_packed_type
654 | | | DW_TAG_const_type
655 | | | | DW_TAG_volatile_type
656 DW_AT_address_class Y Y
657 DW_AT_sibling Y Y Y Y Y
658 DW_AT_type Y Y Y Y Y
659
660 DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
661 *)
662
663 TFpSymbolDwarfType = class(TFpSymbolDwarf)
664 protected
665 procedure Init; override;
666 procedure MemberVisibilityNeeded; override;
667 function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
668 function DoReadStride(AValueObj: TFpValueDwarf; out AStride: TFpDbgValueSize): Boolean; virtual;
669 public
670 (* GetTypedValueObject
671 AnOuterType: If the type is a "chain" (Declaration > Pointer > ActualType)
672 then Result.Owner will be set to the outer most type
673 Result.Owner: will not be refcounted. ??? (Hold via the FDataSymbol...)
674 Result: Is returned with a RefCount of 1. This ref has to be released by the caller.
675 *)
676 function GetTypedValueObject({%H-}ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; virtual;
677 class function CreateTypeSubClass(const AName: String; AnInformationEntry: TDwarfInformationEntry): TFpSymbolDwarfType;
678 function TypeCastValue(AValue: TFpValue): TFpValue; override;
679
680 (*TODO: workaround / quickfix // only partly implemented
681 When reading several elements of an array (dyn or stat), the typeinfo is always the same instance (type of array entry)
682 But once that instance has read data (like bounds / dwarf3 bounds are read from app mem), this is cached.
683 So all consecutive entries get the same info...
684 array of string
685 array of shortstring
686 array of {dyn} array
687 This works similar to "Init", but should only clear data that is not static / depends on memory reads
688
689 Bounds (and maybe all such data) should be stored on the value object)
690 *)
691 procedure ResetValueBounds; virtual;
692 function ReadStride(AValueObj: TFpValueDwarf; out AStride: TFpDbgValueSize): Boolean; inline;
693 end;
694
695 { TFpSymbolDwarfTypeBasic }
696
697 TFpSymbolDwarfTypeBasic = class(TFpSymbolDwarfType)
698 //function DoGetNestedTypeInfo: TFpSymbolDwarfType; // return nil
699 protected
700 procedure KindNeeded; override;
701 procedure TypeInfoNeeded; override;
702 public
703 function GetTypedValueObject({%H-}ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
704 function GetValueBounds(AValueObj: TFpValue; out ALowBound,
705 AHighBound: Int64): Boolean; override;
706 function GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; override;
707 function GetValueHighBound(AValueObj: TFpValue; out AHighBound: Int64): Boolean; override;
708 end;
709
710 { TFpSymbolDwarfTypeModifierBase }
711
712 TFpSymbolDwarfTypeModifierBase = class(TFpSymbolDwarfType)
713 protected
714 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
715 function GetNestedSymbolExByName(const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
716 function GetNestedSymbol(AIndex: Int64): TFpSymbol; override;
717 function GetNestedSymbolByName(const AIndex: String): TFpSymbol; override;
718 end;
719
720 { TFpSymbolDwarfTypeModifier }
721
722 TFpSymbolDwarfTypeModifier = class(TFpSymbolDwarfTypeModifierBase)
723 protected
724 procedure TypeInfoNeeded; override;
725 procedure ForwardToSymbolNeeded; override;
726 function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
727 function DoReadStride(AValueObj: TFpValueDwarf; out AStride: TFpDbgValueSize): Boolean; override;
728 function GetNextTypeInfoForDataAddress(ATargetType: TFpSymbolDwarfType): TFpSymbolDwarfType; override;
729 public
730 function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
731 end;
732
733 { TFpSymbolDwarfTypeRef }
734
735 TFpSymbolDwarfTypeRef = class(TFpSymbolDwarfTypeModifier)
736 protected
737 function GetFlags: TDbgSymbolFlags; override;
738 function GetDataAddressNext(AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation;
739 out ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean; override;
740 end;
741
742 { TFpSymbolDwarfTypeDeclaration }
743
744 TFpSymbolDwarfTypeDeclaration = class(TFpSymbolDwarfTypeModifier)
745 end;
746
747 { TFpSymbolDwarfTypeSubRange }
748
749 TFpSymbolDwarfTypeSubRange = class(TFpSymbolDwarfTypeModifierBase)
750 // TODO not a modifier, maybe have a forwarder base class
751 private
752 FLowBoundConst: Int64;
753 FLowBoundSymbol: TFpSymbolDwarfData;
754 FLowBoundState: TFpDwarfAtEntryDataReadState;
755 FHighBoundConst: Int64;
756 FHighBoundSymbol: TFpSymbolDwarfData;
757 FHighBoundState: TFpDwarfAtEntryDataReadState;
758 FCountConst: Int64;
759 FCountSymbol: TFpSymbolDwarfData;
760 FCountState: TFpDwarfAtEntryDataReadState;
761 FLowEnumIdx, FHighEnumIdx: Integer;
762 FEnumIdxValid: Boolean;
763 procedure InitEnumIdx;
764 protected
765 function DoGetNestedTypeInfo: TFpSymbolDwarfType; override;
766 procedure ForwardToSymbolNeeded; override;
767 procedure TypeInfoNeeded; override;
768
769 procedure NameNeeded; override;
770 procedure KindNeeded; override;
771 function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
772 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
773 function GetNestedSymbolCount: Integer; override;
774 function GetFlags: TDbgSymbolFlags; override;
775 procedure Init; override;
776 public
777 procedure ResetValueBounds; override;
778 destructor Destroy; override;
779
780 function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
781 function GetValueBounds(AValueObj: TFpValue; out ALowBound, AHighBound: Int64): Boolean; override;
782 function GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; override;
783 function GetValueHighBound(AValueObj: TFpValue; out AHighBound: Int64): Boolean; override;
784 property LowBoundState: TFpDwarfAtEntryDataReadState read FLowBoundState; deprecated;
785 property HighBoundState: TFpDwarfAtEntryDataReadState read FHighBoundState; deprecated;
786 property CountState: TFpDwarfAtEntryDataReadState read FCountState; deprecated;
787
788 end;
789
790 { TFpSymbolDwarfTypePointer }
791
792 TFpSymbolDwarfTypePointer = class(TFpSymbolDwarfTypeModifierBase)
793 protected
794 procedure KindNeeded; override;
795 function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
796 public
797 function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
798 end;
799
800 { TFpSymbolDwarfTypeSubroutine }
801
802 TFpSymbolDwarfTypeSubroutine = class(TFpSymbolDwarfType)
803 private
804 FProcMembers: TRefCntObjList;
805 FLastMember: TFpSymbol;
806 procedure CreateMembers;
807 protected
808 //copied from TFpSymbolDwarfDataProc
809 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
810 function GetNestedSymbolExByName(const AIndex: String;
811 out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
812 function GetNestedSymbolCount: Integer; override;
813
814 // TODO: deal with DW_TAG_pointer_type
815 function GetDataAddressNext(AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation;
816 out ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean; override;
817 procedure KindNeeded; override;
818 function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
819 public
820 destructor Destroy; override;
821 function GetTypedValueObject({%H-}ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
822 end;
823
824 { TFpSymbolDwarfDataEnumMember }
825
826 TFpSymbolDwarfDataEnumMember = class(TFpSymbolDwarfData)
827 FOrdinalValue: Int64;
828 FOrdinalValueRead, FHasOrdinalValue: Boolean;
829 procedure ReadOrdinalValue;
830 protected
831 procedure KindNeeded; override;
832 function GetHasOrdinalValue: Boolean; override;
833 function GetOrdinalValue: Int64; override;
834 procedure Init; override;
835 function GetValueObject: TFpValue; override;
836 end;
837
838
839 { TFpSymbolDwarfTypeEnum }
840
841 TFpSymbolDwarfTypeEnum = class(TFpSymbolDwarfType)
842 private
843 FMembers: TRefCntObjList;
844 procedure CreateMembers;
845 protected
846 procedure KindNeeded; override;
847 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
848 function GetNestedSymbolExByName(const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
849 function GetNestedSymbolCount: Integer; override;
850 public
851 destructor Destroy; override;
852 function GetTypedValueObject({%H-}ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
853 function GetValueBounds(AValueObj: TFpValue; out ALowBound,
854 AHighBound: Int64): Boolean; override;
855 function GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; override;
856 function GetValueHighBound(AValueObj: TFpValue; out AHighBound: Int64): Boolean; override;
857 end;
858
859
860 { TFpSymbolDwarfTypeSet }
861
862 TFpSymbolDwarfTypeSet = class(TFpSymbolDwarfType)
863 protected
864 procedure KindNeeded; override;
865 function GetNestedSymbolCount: Integer; override;
866 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
867 public
868 function GetTypedValueObject({%H-}ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
869 end;
870
871
872 { TFpSymbolDwarfDataMember }
873
874 TFpSymbolDwarfDataMember = class(TFpSymbolDwarfDataWithLocation)
875 private
876 FConstData: TByteDynArray;
877 protected
878 function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
879 function GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean; override;
880 function HasAddress: Boolean; override;
881 end;
882
883 { TFpSymbolDwarfTypeStructure }
884
885 TFpSymbolDwarfTypeStructure = class(TFpSymbolDwarfType)
886 // record or class
887 private
888 FMembers: TRefCntObjList;
889 FLastChildByName: TFpSymbolDwarf;
890 FInheritanceInfo: TDwarfInformationEntry;
891 procedure CreateMembers;
892 procedure InitInheritanceInfo; inline;
893 protected
894 function DoGetNestedTypeInfo: TFpSymbolDwarfType; override;
895 procedure KindNeeded; override;
896
897 // GetNestedSymbolEx, if AIndex > Count then parent
898 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
899 function GetNestedSymbolExByName(const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
900 function GetNestedSymbolCount: Integer; override;
901
902 function GetDataAddressNext(AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation;
903 out ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean; override;
904 public
905 destructor Destroy; override;
906 function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
907 end;
908
909 { TFpSymbolDwarfTypeArray }
910
911 TFpSymbolDwarfTypeArray = class(TFpSymbolDwarfType)
912 private
913 FMembers: TRefCntObjList;
914 procedure CreateMembers;
915 protected
916 procedure KindNeeded; override;
917 function DoReadOrdering(AValueObj: TFpValueDwarf; out ARowMajor: Boolean): Boolean;
918
919 function GetFlags: TDbgSymbolFlags; override;
920 // GetNestedSymbolEx: returns the TYPE/range of each index. NOT the data
921 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
922 function GetNestedSymbolCount: Integer; override;
923 function GetMemberAddress(AValueObj: TFpValueDwarf; const AIndex: Array of Int64): TFpDbgMemLocation;
924 public
925 destructor Destroy; override;
926 function GetTypedValueObject({%H-}ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
927 procedure ResetValueBounds; override;
928 end;
929
930 { TFpSymbolDwarfDataProc }
931
932 TFpSymbolDwarfDataProc = class(TFpSymbolDwarfData)
933 private
934 //FCU: TDwarfCompilationUnit;
935 FAddress: TDbgPtr;
936 FAddressInfo: PDwarfAddressInfo;
937 FStateMachine: TDwarfLineInfoStateMachine;
938 FFrameBaseParser: TDwarfLocationExpression;
939 FDwarf: TFpDwarfInfo;
940 function GetLineEndAddress: TDBGPtr;
941 function GetLineStartAddress: TDBGPtr;
942 function GetLineUnfixed: TDBGPtr;
943 function StateMachineValid: Boolean;
944 function ReadVirtuality(out AFlags: TDbgSymbolFlags): Boolean;
945 protected
946 function GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
947 function GetFlags: TDbgSymbolFlags; override;
948 procedure TypeInfoNeeded; override;
949
950 function GetParent: TFpSymbol; override;
951 function GetColumn: Cardinal; override;
952 function GetFile: String; override;
953 // function GetFlags: TDbgSymbolFlags; override;
954 function GetLine: Cardinal; override;
955 function GetValueObject: TFpValue; override;
956 function GetValueAddress(AValueObj: TFpValueDwarf; out
957 AnAddress: TFpDbgMemLocation): Boolean; override;
958 public
959 constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo = nil); overload;
960 destructor Destroy; override;
961 function CreateSymbolScope(ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope; override;
962 function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
963 // TODO members = locals ?
964 function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpValueDwarf;
965 // Contineous (sub-)part of the line
966 property LineStartAddress: TDBGPtr read GetLineStartAddress;
967 property LineEndAddress: TDBGPtr read GetLineEndAddress;
968 property LineUnfixed: TDBGPtr read GetLineUnfixed; // with 0 lines
969 end;
970
971 { TFpSymbolDwarfTypeProc }
972
973 TFpSymbolDwarfTypeProc = class(TFpSymbolDwarfType)
974 private
975 FAddressInfo: PDwarfAddressInfo;
976 FLastMember: TFpSymbol;
977 FProcMembers: TRefCntObjList; // Locals
978
979 procedure CreateMembers;
980 protected
981 procedure NameNeeded; override;
982 procedure KindNeeded; override;
983 function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
984
985 function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
986 function GetNestedSymbolExByName(const AIndex: String;
987 out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
988 function GetNestedSymbolCount: Integer; override;
989
990 public
991 constructor Create(const AName: String; AnInformationEntry: TDwarfInformationEntry; AInfo: PDwarfAddressInfo);
992 destructor Destroy; override;
993 end;
994
995 { TFpSymbolDwarfDataVariable }
996
997 TFpSymbolDwarfDataVariable = class(TFpSymbolDwarfDataWithLocation)
998 private
999 FConstData: TByteDynArray;
1000 protected
1001 function GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean; override;
1002 function HasAddress: Boolean; override;
1003 public
1004 end;
1005
1006 { TFpSymbolDwarfDataParameter }
1007
1008 TFpSymbolDwarfDataParameter = class(TFpSymbolDwarfDataWithLocation)
1009 protected
1010 function GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean; override;
1011 function HasAddress: Boolean; override;
1012 function GetFlags: TDbgSymbolFlags; override;
1013 public
1014 end;
1015
1016 { TFpSymbolDwarfUnit }
1017
1018 TFpSymbolDwarfUnit = class(TFpSymbolDwarf)
1019 private
1020 FLastChildByName: TFpSymbol;
1021 FDwarf: TFpDwarfInfo;
1022 protected
1023 procedure Init; override;
1024 function GetNestedSymbolExByName(const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
1025 public
1026 constructor Create(const AName: String; AnInformationEntry: TDwarfInformationEntry; ADbgInfo: TFpDwarfInfo = nil); overload;
1027 destructor Destroy; override;
1028 function CreateSymbolScope(ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope; override;
1029 function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
1030 end;
1031 {%endregion Symbol objects }
1032
1033 function dbgs(ASubRangeBoundReadState: TFpDwarfAtEntryDataReadState): String; overload;
1034
1035 implementation
1036
1037 var
1038 DBG_WARNINGS, FPDBG_DWARF_VERBOSE, FPDBG_DWARF_ERRORS, FPDBG_DWARF_WARNINGS, FPDBG_DWARF_SEARCH, FPDBG_DWARF_DATA_WARNINGS: PLazLoggerLogGroup;
1039
1040 function dbgs(ASubRangeBoundReadState: TFpDwarfAtEntryDataReadState): String;
1041 begin
1042 WriteStr(Result, ASubRangeBoundReadState);
1043 end;
1044
1045 { TFpValueDwarfBase }
1046
1047 procedure TFpValueDwarfBase.SetContext(AValue: TFpDbgLocationContext);
1048 begin
1049 if FLocContext = AValue then Exit;
1050 if FLocContext <> nil then
1051 FLocContext.ReleaseReference;
1052 FLocContext := AValue;
1053 if FLocContext <> nil then
1054 FLocContext.AddReference;
1055 end;
1056
1057 destructor TFpValueDwarfBase.Destroy;
1058 begin
1059 inherited Destroy;
1060 if FLocContext <> nil then
1061 FLocContext.ReleaseReference;
1062 end;
1063
1064 { TFpSymbolDwarfFunctionResult }
1065
GetValueAddressnull1066 function TFpSymbolDwarfFunctionResult.GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean;
1067 begin
1068 AnAddress := Address;
1069 Result := IsInitializedLoc(AnAddress);
1070 end;
1071
1072 procedure TFpSymbolDwarfFunctionResult.Init;
1073 begin
1074 inherited Init;
1075 EvaluatedFields := EvaluatedFields + [sfiAddress];
1076 end;
1077
1078 { TFpValueDwarfStructBase }
1079
GetMembernull1080 function TFpValueDwarfStructBase.GetMember(AIndex: Int64): TFpValue;
1081 begin
1082 Result := inherited GetMember(AIndex);
1083 end;
1084
GetMemberByNamenull1085 function TFpValueDwarfStructBase.GetMemberByName(const AIndex: String
1086 ): TFpValue;
1087 begin
1088 Result := inherited GetMemberByName(AIndex);
1089
1090 end;
1091
1092 { TFpValueDwarfSubroutine }
1093
IsValidTypeCastnull1094 function TFpValueDwarfSubroutine.IsValidTypeCast: Boolean;
1095 var
1096 f: TFpValueFieldFlags;
1097 SrcSize: TFpDbgValueSize;
1098 begin
1099 Result := HasTypeCastInfo;
1100 If not Result then
1101 exit;
1102
1103 // Can typecast, IF source has an Address, but NO Size
1104 f := FTypeCastSourceValue.FieldFlags;
1105 if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
1106 exit;
1107
1108 // Can typecast, IF source has ordinal
1109 if (svfOrdinal in f)then
1110 exit;
1111
1112 // Can typecast, IF source has address an size=pointer
1113 if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) then begin
1114 Result := GetSizeFor(FTypeCastSourceValue, SrcSize);
1115 if not Result then
1116 exit;
1117 if SrcSize = FTypeSymbol.CompilationUnit.AddressSize then
1118 exit;
1119 end;
1120 // Can typecast, IF source has address an size=pointer
1121 if (f * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) then
1122 exit;
1123
1124 Result := False;
1125 end;
1126
1127 { TFpDwarfDefaultSymbolClassMap }
1128
1129 class function TFpDwarfDefaultSymbolClassMap.GetExistingClassMap: PFpDwarfSymbolClassMap;
1130 begin
1131 Result := @ExistingClassMap;
1132 end;
1133
1134 class function TFpDwarfDefaultSymbolClassMap.ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean;
1135 begin
1136 Result := True;
1137 end;
1138
GetDwarfSymbolClassnull1139 function TFpDwarfDefaultSymbolClassMap.GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass;
1140 begin
1141 case ATag of
1142 // TODO:
1143 DW_TAG_constant:
1144 Result := TFpSymbolDwarfData;
1145 DW_TAG_string_type,
1146 DW_TAG_union_type, DW_TAG_ptr_to_member_type,
1147 DW_TAG_file_type,
1148 DW_TAG_thrown_type:
1149 Result := TFpSymbolDwarfType;
1150
1151 // Type types
1152 DW_TAG_packed_type,
1153 DW_TAG_const_type,
1154 DW_TAG_volatile_type: Result := TFpSymbolDwarfTypeModifier;
1155 DW_TAG_reference_type: Result := TFpSymbolDwarfTypeRef;
1156 DW_TAG_typedef: Result := TFpSymbolDwarfTypeDeclaration;
1157 DW_TAG_pointer_type: Result := TFpSymbolDwarfTypePointer;
1158
1159 DW_TAG_base_type: Result := TFpSymbolDwarfTypeBasic;
1160 DW_TAG_subrange_type: Result := TFpSymbolDwarfTypeSubRange;
1161 DW_TAG_enumeration_type: Result := TFpSymbolDwarfTypeEnum;
1162 DW_TAG_enumerator: Result := TFpSymbolDwarfDataEnumMember;
1163 DW_TAG_set_type: Result := TFpSymbolDwarfTypeSet;
1164 DW_TAG_structure_type,
1165 DW_TAG_interface_type,
1166 DW_TAG_class_type: Result := TFpSymbolDwarfTypeStructure;
1167 DW_TAG_array_type: Result := TFpSymbolDwarfTypeArray;
1168 DW_TAG_subroutine_type: Result := TFpSymbolDwarfTypeSubroutine;
1169 // Value types
1170 DW_TAG_variable: Result := TFpSymbolDwarfDataVariable;
1171 DW_TAG_formal_parameter: Result := TFpSymbolDwarfDataParameter;
1172 DW_TAG_member: Result := TFpSymbolDwarfDataMember;
1173 DW_TAG_subprogram: Result := TFpSymbolDwarfDataProc;
1174 //DW_TAG_inlined_subroutine, DW_TAG_entry_poin
1175 //
1176 DW_TAG_compile_unit: Result := TFpSymbolDwarfUnit;
1177
1178 DW_TAG_lo_user
1179 ..DW_TAG_hi_user: Result := TFpSymbolDwarfThirdPartyExtension;
1180 else
1181 Result := TFpSymbolDwarf;
1182 end;
1183 end;
1184
CreateScopeForSymbolnull1185 function TFpDwarfDefaultSymbolClassMap.CreateScopeForSymbol(
1186 ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
1187 ADwarf: TFpDwarfInfo): TFpDbgSymbolScope;
1188 begin
1189 Result := TFpDwarfInfoSymbolScope.Create(ALocationContext,ASymbol, ADwarf);
1190 end;
1191
CreateProcSymbolnull1192 function TFpDwarfDefaultSymbolClassMap.CreateProcSymbol(
1193 ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo;
1194 AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase;
1195 begin
1196 Result := TFpSymbolDwarfDataProc.Create(ACompilationUnit, AInfo, AAddress, ADbgInfo);
1197 end;
1198
CreateUnitSymbolnull1199 function TFpDwarfDefaultSymbolClassMap.CreateUnitSymbol(
1200 ACompilationUnit: TDwarfCompilationUnit; AInfoEntry: TDwarfInformationEntry;
1201 ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase;
1202 begin
1203 Result := TFpSymbolDwarfUnit.Create(ACompilationUnit.UnitName, AInfoEntry, ADbgInfo);
1204 end;
1205
1206 { TFpThreadWorkerFindSymbolInUnits }
1207
1208 procedure TFpThreadWorkerFindSymbolInUnits.DoExecute;
1209 var
1210 i: Integer;
1211 InfoEntry: TDwarfInformationEntry;
1212 IsExt: Boolean;
1213 begin
1214 FFoundInfoEntry := nil;
1215 for i := 0 to Length(FCUs) - 1 do begin
1216 if FScope.FindExportedSymbolInUnit(FCUs[i], FNameInfo, InfoEntry, IsExt) then begin
1217 FFoundInfoEntry.ReleaseReference;
1218 FFoundInfoEntry := InfoEntry;
1219 if FIsExt then
1220 break;
1221 end;
1222 end;
1223 end;
1224
1225 constructor TFpThreadWorkerFindSymbolInUnits.Create(
1226 AScope: TFpDwarfInfoSymbolScope; CUs: TDwarfCompilationUnitArray;
1227 const ANameInfo: TNameSearchInfo);
1228 begin
1229 inherited Create;
1230 FScope := AScope;
1231 FCUs := CUs;
1232 FNameInfo := ANameInfo;
1233 end;
1234
1235 destructor TFpThreadWorkerFindSymbolInUnits.Destroy;
1236 begin
1237 FFoundInfoEntry.ReleaseReference;
1238 inherited Destroy;
1239 end;
1240
1241 { TFpDwarfInfoSymbolScope }
1242
GetSymbolAtAddressnull1243 function TFpDwarfInfoSymbolScope.GetSymbolAtAddress: TFpSymbol;
1244 begin
1245 Result := FSymbol;
1246 end;
1247
GetProcedureAtAddressnull1248 function TFpDwarfInfoSymbolScope.GetProcedureAtAddress: TFpValue;
1249 begin
1250 Result := inherited GetProcedureAtAddress;
1251 ApplyContext(Result);
1252 end;
1253
GetSizeOfAddressnull1254 function TFpDwarfInfoSymbolScope.GetSizeOfAddress: Integer;
1255 begin
1256 if Symbol = nil then begin
1257 if FDwarf.CompilationUnitsCount > 0 then
1258 Result := FDwarf.CompilationUnits[0].AddressSize
1259 else
1260 case FDwarf.TargetInfo.bitness of
1261 bNone: Result := 0;
1262 b32: Result := 4;
1263 b64: Result := 8;
1264 end;
1265 end
1266 else
1267 Result := TFpSymbolDwarf(FSymbol).CompilationUnit.AddressSize;
1268 end;
1269
GetMemManagernull1270 function TFpDwarfInfoSymbolScope.GetMemManager: TFpDbgMemManager;
1271 begin
1272 Result := FDwarf.MemManager;
1273 end;
1274
1275 procedure TFpDwarfInfoSymbolScope.ApplyContext(AVal: TFpValue);
1276 begin
1277 if (AVal <> nil) and (TFpValueDwarfBase(AVal).Context = nil) then
1278 TFpValueDwarfBase(AVal).Context := Self.LocationContext;
1279 end;
1280
SymbolToValuenull1281 function TFpDwarfInfoSymbolScope.SymbolToValue(ASym: TFpSymbolDwarf): TFpValue;
1282 begin
1283 if ASym = nil then begin
1284 Result := nil;
1285 exit;
1286 end;
1287
1288 if ASym.SymbolType = stValue then begin
1289 Result := ASym.Value;
1290 end
1291 else begin
1292 Result := TFpValueDwarfTypeDefinition.Create(ASym);
1293 end;
1294 ASym.ReleaseReference;
1295 end;
1296
GetSelfParameternull1297 function TFpDwarfInfoSymbolScope.GetSelfParameter: TFpValueDwarf;
1298 begin
1299 Result := FSelfParameter;
1300 if not(Symbol is TFpSymbolDwarfDataProc) then
1301 exit;
1302 if Result <> nil then
1303 exit;
1304 Result := TFpSymbolDwarfDataProc(FSymbol).GetSelfParameter(FAddress);
1305 if (Result <> nil) then
1306 Result.Context := Self.LocationContext;
1307 FSelfParameter := Result;
1308 end;
1309
FindExportedSymbolInUnitnull1310 function TFpDwarfInfoSymbolScope.FindExportedSymbolInUnit(
1311 CU: TDwarfCompilationUnit; const ANameInfo: TNameSearchInfo; out
1312 AnInfoEntry: TDwarfInformationEntry; out AnIsExternal: Boolean): Boolean;
1313 var
1314 i, ExtVal: Integer;
1315 InfoEntry: TDwarfInformationEntry;
1316 s: String;
1317 begin
1318 Result := False;
1319
1320 AnInfoEntry := nil;
1321 AnIsExternal := False;
1322
1323 //DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier search UNIT Name=', CU.FileName]);
1324
1325 InfoEntry := TDwarfInformationEntry.Create(CU, nil);
1326 InfoEntry.ScopeIndex := CU.FirstScope.Index;
1327
1328 if not InfoEntry.AbbrevTag = DW_TAG_compile_unit then
1329 exit;
1330 // compile_unit can not have startscope
1331
1332 s := CU.UnitName;
1333 if (s <> '') and (CompareUtf8BothCase(PChar(ANameInfo.NameUpper), PChar(ANameInfo.NameLower), @s[1])) then begin
1334 Result := True;
1335 AnInfoEntry := InfoEntry;
1336 AnIsExternal := True;
1337 end
1338
1339 else
1340 if InfoEntry.GoNamedChildEx(ANameInfo) then begin
1341 if InfoEntry.IsAddressInStartScope(FAddress) then begin
1342 // only variables are marked "external", but types not / so we may need all top level
1343 Result := True;
1344 AnInfoEntry := InfoEntry;
1345 //DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier MAYBE FOUND Name=', CU.FileName]);
1346
1347 // DW_AT_visibility ?
1348
1349 if InfoEntry.ReadValue(DW_AT_external, ExtVal) then
1350 AnIsExternal := ExtVal <> 0;
1351 end;
1352 end;
1353
1354 if not Result then
1355 InfoEntry.ReleaseReference;
1356 end;
1357
FindExportedSymbolInUnitsnull1358 function TFpDwarfInfoSymbolScope.FindExportedSymbolInUnits(const AName: String;
1359 const ANameInfo: TNameSearchInfo; SkipCompUnit: TDwarfCompilationUnit; out
1360 ADbgValue: TFpValue; const OnlyUnitNameLower: String): Boolean;
1361 const
1362 PER_WORKER_CNT = 20;
1363 var
1364 i, j: Integer;
1365 CU: TDwarfCompilationUnit;
1366 CUList: TDwarfCompilationUnitArray;
1367 InfoEntry, FoundInfoEntry: TDwarfInformationEntry;
1368 IsExt: Boolean;
1369 WorkItem, PrevWorkItem: TFpThreadWorkerFindSymbolInUnits;
1370 begin
1371 Result := False;
1372
1373 ADbgValue := nil;
1374 FoundInfoEntry := nil;
1375 PrevWorkItem := nil;
1376 IsExt := False;
1377
1378 i := FDwarf.CompilationUnitsCount;
1379 while i > 0 do begin
1380 j := 0;
1381 SetLength(CUList, PER_WORKER_CNT);
1382 while (j < PER_WORKER_CNT) and (i > 0) do begin
1383 dec(i);
1384 CU := FDwarf.CompilationUnits[i];
1385
1386 if (OnlyUnitNameLower <> '') and (OnlyUnitNameLower <> LowerCase(CU.UnitName)) then
1387 continue;
1388 if (CU = SkipCompUnit) or
1389 (not CU.KnownNameHashes^[ANameInfo.NameHash and KnownNameHashesBitMask])
1390 then
1391 continue;
1392
1393 CUList[j] := CU;
1394 inc(j);
1395 end;
1396
1397 if j < PER_WORKER_CNT then begin
1398 assert(i=0, 'TFpDwarfInfoSymbolScope.FindExportedSymbolInUnits: i=0');
1399 SetLength(CUList, j);
1400 end;
1401
1402 if j > 0 then begin
1403 WorkItem := TFpThreadWorkerFindSymbolInUnits.Create(Self, CUList, ANameInfo);
1404 WorkItem.AddRef;
1405 end
1406 else
1407 WorkItem := nil;
1408
1409 if PrevWorkItem <> nil then begin
1410 if (not PrevWorkItem.IsDone) then begin
1411 if WorkItem <> nil then begin
1412 WorkItem.Execute;
1413 if (WorkItem.FFoundInfoEntry = nil) and (not PrevWorkItem.IsDone) then begin
1414 WorkItem.DecRef;
1415 continue;
1416 end;
1417 end;
1418 Dwarf.WorkQueue.WaitForItem(PrevWorkItem); // must check result from Prev first, to keep a stable search order
1419 end;
1420
1421 while PrevWorkItem <> nil do begin
1422 assert(PrevWorkItem.IsDone, 'TFpDwarfInfoSymbolScope.FindExportedSymbolInUnits: PrevWorkItem.IsDone');
1423 ReadBarrier;
1424 if PrevWorkItem.FFoundInfoEntry <> nil then begin
1425 FoundInfoEntry.ReleaseReference;
1426 FoundInfoEntry := PrevWorkItem.FFoundInfoEntry;
1427 FoundInfoEntry.AddReference;
1428 IsExt := PrevWorkItem.FIsExt;
1429 end;
1430 PrevWorkItem.DecRef;
1431 PrevWorkItem := nil;
1432 if IsExt then begin
1433 WorkItem.DecRef;
1434 break;
1435 end;
1436 if (WorkItem <> nil) and WorkItem.IsDone then begin
1437 PrevWorkItem := WorkItem;
1438 WorkItem := nil;
1439 end;
1440 end;
1441 end;
1442
1443 if WorkItem <> nil then begin
1444 if i = 0 then
1445 WorkItem.Execute
1446 else
1447 Dwarf.WorkQueue.PushItemIdleOrRun(WorkItem);
1448 PrevWorkItem := WorkItem;
1449 WorkItem := nil;
1450 end;
1451 end;
1452
1453 if PrevWorkItem <> nil then begin
1454 if not IsExt then begin // IsExt => already got a final result
1455 if not PrevWorkItem.IsDone then
1456 Dwarf.WorkQueue.WaitForItem(PrevWorkItem);
1457 if PrevWorkItem.FFoundInfoEntry <> nil then begin
1458 FoundInfoEntry.ReleaseReference;
1459 FoundInfoEntry := PrevWorkItem.FFoundInfoEntry;
1460 FoundInfoEntry.AddReference
1461 end;
1462 end;
1463 PrevWorkItem.DecRef;
1464 end;
1465
1466 if FoundInfoEntry <> nil then begin
1467 ADbgValue := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, FoundInfoEntry));
1468 FoundInfoEntry.ReleaseReference;
1469 end;
1470
1471 Result := ADbgValue <> nil;
1472 end;
1473
FindSymbolInStructurenull1474 function TFpDwarfInfoSymbolScope.FindSymbolInStructure(const AName: String;
1475 const ANameInfo: TNameSearchInfo; InfoEntry: TDwarfInformationEntry; out
1476 ADbgValue: TFpValue): Boolean;
1477 var
1478 InfoEntryInheritance: TDwarfInformationEntry;
1479 FwdInfoPtr: Pointer;
1480 FwdCompUint: TDwarfCompilationUnit;
1481 SelfParam: TFpValue;
1482 begin
1483 Result := False;
1484 ADbgValue := nil;
1485 InfoEntry.AddReference;
1486
1487 while True do begin
1488 if not InfoEntry.IsAddressInStartScope(FAddress) then
1489 break;
1490
1491 InfoEntryInheritance := InfoEntry.FindChildByTag(DW_TAG_inheritance);
1492
1493 if InfoEntry.GoNamedChildEx(ANameInfo) then begin
1494 if InfoEntry.IsAddressInStartScope(FAddress) then begin
1495 SelfParam := GetSelfParameter;
1496 if (SelfParam <> nil) then begin
1497 // TODO: only valid, as long as context is valid, because if context is freed, then self is lost too
1498 ADbgValue := SelfParam.MemberByName[AName];
1499 assert(ADbgValue <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
1500 end;
1501 if ADbgValue = nil then begin // Todo: abort the searh /SetError
1502 ADbgValue := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, InfoEntry));
1503 end;
1504 InfoEntry.ReleaseReference;
1505 InfoEntryInheritance.ReleaseReference;
1506 Result := True;
1507 exit;
1508 end;
1509 end;
1510
1511
1512 if not( (InfoEntryInheritance <> nil) and
1513 (InfoEntryInheritance.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint)) )
1514 then
1515 break;
1516 InfoEntry.ReleaseReference;
1517 InfoEntry := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
1518 InfoEntryInheritance.ReleaseReference;
1519 DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier PARENT ', dbgs(InfoEntry, FwdCompUint) ]);
1520 end;
1521
1522 InfoEntry.ReleaseReference;
1523 Result := ADbgValue <> nil;
1524 end;
1525
FindLocalSymbolnull1526 function TFpDwarfInfoSymbolScope.FindLocalSymbol(const AName: String;
1527 const ANameInfo: TNameSearchInfo; InfoEntry: TDwarfInformationEntry; out
1528 ADbgValue: TFpValue): Boolean;
1529 begin
1530 Result := False;
1531 ADbgValue := nil;
1532 if not(Symbol is TFpSymbolDwarfDataProc) then
1533 exit;
1534 if not InfoEntry.GoNamedChildEx(ANameInfo) then
1535 exit;
1536 if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
1537 ADbgValue := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, InfoEntry));
1538 if ADbgValue <> nil then
1539 TFpSymbolDwarf(ADbgValue.DbgSymbol).LocalProcInfo := TFpSymbolDwarfDataProc(FSymbol);
1540 end;
1541 Result := ADbgValue <> nil;
1542 end;
1543
1544 constructor TFpDwarfInfoSymbolScope.Create(
1545 ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
1546 ADwarf: TFpDwarfInfo);
1547 begin
1548 assert((ASymbol=nil) or (ASymbol is TFpSymbolDwarf), 'TFpDwarfInfoSymbolScope.Create: (ASymbol=nil) or (ASymbol is TFpSymbolDwarf)');
1549 inherited Create(ALocationContext);
1550 FDwarf := ADwarf;
1551 FSymbol := TFpSymbolDwarf(ASymbol);
1552 FAddress := LocationContext.Address; // for quick access
1553 if FSymbol <> nil then
1554 FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'Context to Symbol'){$ENDIF};
1555 end;
1556
1557 destructor TFpDwarfInfoSymbolScope.Destroy;
1558 begin
1559 FSelfParameter.ReleaseReference;
1560 FSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'Context to Symbol'){$ENDIF};
1561 inherited Destroy;
1562 end;
1563
FindSymbolnull1564 function TFpDwarfInfoSymbolScope.FindSymbol(const AName: String;
1565 const OnlyUnitName: String): TFpValue;
1566 var
1567 SubRoutine: TFpSymbolDwarfDataProc; // TDbgSymbol;
1568 CU: TDwarfCompilationUnit;
1569 //Scope,
1570 StartScopeIdx: Integer;
1571 InfoEntry: TDwarfInformationEntry;
1572 NameInfo: TNameSearchInfo;
1573 InfoName: PChar;
1574 tg: Cardinal;
1575 begin
1576 Result := nil;
1577 //if (FSymbol = nil) or not(FSymbol is TFpSymbolDwarfDataProc) or (AName = '') then
1578 if (AName = '') then
1579 exit;
1580
1581 NameInfo := NameInfoForSearch(AName);
1582
1583 if OnlyUnitName <> '' then begin
1584 // TODO: dwarf info for libraries
1585 FindExportedSymbolInUnits(AName, NameInfo, nil, Result, LowerCase(OnlyUnitName));
1586 exit;
1587 end;
1588
1589 if FSymbol is TFpSymbolDwarfDataProc then
1590 SubRoutine := TFpSymbolDwarfDataProc(FSymbol)
1591 else
1592 SubRoutine := nil;
1593
1594 if Symbol = nil then begin
1595 FindExportedSymbolInUnits(AName, NameInfo, nil, Result);
1596 ApplyContext(Result);
1597 if Result = nil then
1598 Result := inherited FindSymbol(AName);
1599 exit;
1600 end;
1601
1602 try
1603 CU := Symbol.CompilationUnit;
1604 InfoEntry := Symbol.InformationEntry.Clone;
1605
1606 while InfoEntry.HasValidScope do begin
1607 //debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier Searching ', dbgs(InfoEntry.FScope, CU)]);
1608 StartScopeIdx := InfoEntry.ScopeIndex;
1609
1610 tg := InfoEntry.AbbrevTag;
1611 if (tg = DW_TAG_compile_unit) and
1612 (not CU.KnownNameHashes^[NameInfo.NameHash and KnownNameHashesBitMask])
1613 then
1614 break;
1615
1616 //if InfoEntry.Abbrev = nil then
1617 // exit;
1618
1619 if not InfoEntry.IsAddressInStartScope(FAddress) // StartScope = first valid address
1620 then begin
1621 // CONTINUE: Search parent(s)
1622 //InfoEntry.ScopeIndex := StartScopeIdx;
1623 InfoEntry.GoParent;
1624 Continue;
1625 end;
1626
1627 if InfoEntry.InfoScope.Current^.NameHash = NameInfo.NameHash then
1628 if InfoEntry.ReadName(InfoName) and not InfoEntry.IsArtificial
1629 then begin
1630 if (CompareUtf8BothCase(PChar(NameInfo.NameUpper), PChar(NameInfo.NameLower), InfoName)) then begin
1631 // TODO: this is a pascal specific search order? Or not?
1632 // If this is a type with a pointer or ref, need to find the pointer or ref.
1633 InfoEntry.GoParent;
1634 if InfoEntry.HasValidScope and
1635 InfoEntry.GoNamedChildEx(NameInfo)
1636 then begin
1637 if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
1638 Result := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, InfoEntry));
1639 exit;
1640 end;
1641 end;
1642
1643 InfoEntry.ScopeIndex := StartScopeIdx;
1644 Result := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, InfoEntry));
1645 exit;
1646 end;
1647 end;
1648
1649
1650 if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
1651 if FindSymbolInStructure(AName,NameInfo, InfoEntry, Result) then begin
1652 exit; // TODO: check error
1653 end;
1654 //InfoEntry.ScopeIndex := StartScopeIdx;
1655 end
1656
1657 else
1658 if (SubRoutine <> nil) and (StartScopeIdx = SubRoutine.InformationEntry.ScopeIndex) then begin // searching in subroutine
1659 if FindLocalSymbol(AName,NameInfo, InfoEntry, Result) then begin
1660 exit; // TODO: check error
1661 end;
1662 //InfoEntry.ScopeIndex := StartScopeIdx;
1663 end
1664 // TODO: nested subroutine
1665
1666 else
1667 if InfoEntry.GoNamedChildEx(NameInfo) then begin
1668 if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
1669 Result := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, InfoEntry));
1670 exit;
1671 end;
1672 end;
1673
1674 // Search parent(s)
1675 InfoEntry.ScopeIndex := StartScopeIdx;
1676 InfoEntry.GoParent;
1677 end;
1678
1679 FindExportedSymbolInUnits(AName, NameInfo, CU, Result);
1680
1681 finally
1682 if (Result = nil) or (InfoEntry = nil)
1683 then DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier NOT found Name=', AName])
1684 else DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier(',AName,') found Scope=', TFpSymbolDwarf(Result.DbgSymbol).InformationEntry.ScopeDebugText, ' ResultSymbol=', DbgSName(Result.DbgSymbol), ' ', Result.DbgSymbol.Name, ' in ', TFpSymbolDwarf(Result.DbgSymbol).CompilationUnit.FileName]);
1685 ReleaseRefAndNil(InfoEntry);
1686
1687 assert((Result = nil) or (Result is TFpValueDwarfBase), 'TDbgDwarfInfoAddressContext.FindSymbol: (Result = nil) or (Result is TFpValueDwarfBase)');
1688 ApplyContext(Result);
1689 end;
1690 if Result = nil then
1691 Result := inherited FindSymbol(AName);
1692 end;
1693
1694 { TFpValueDwarfTypeDefinition }
1695
GetKindnull1696 function TFpValueDwarfTypeDefinition.GetKind: TDbgSymbolKind;
1697 begin
1698 Result := skType;
1699 end;
1700
GetDbgSymbolnull1701 function TFpValueDwarfTypeDefinition.GetDbgSymbol: TFpSymbol;
1702 begin
1703 Result := FSymbol;
1704 end;
1705
GetMemberCountnull1706 function TFpValueDwarfTypeDefinition.GetMemberCount: Integer;
1707 begin
1708 Result := FSymbol.NestedSymbolCount;
1709 end;
1710
GetMemberByNamenull1711 function TFpValueDwarfTypeDefinition.GetMemberByName(const AIndex: String
1712 ): TFpValue;
1713 begin
1714 Result := FSymbol.GetNestedValueByName(AIndex);
1715 if Result = nil then
1716 exit;
1717 // TFpValueDwarf(Result).SetStructureValue(Self);
1718 TFpValueDwarf(Result).Context := Context;
1719 end;
1720
GetMembernull1721 function TFpValueDwarfTypeDefinition.GetMember(AIndex: Int64): TFpValue;
1722 begin
1723 Result := FSymbol.GetNestedValue(AIndex);
1724 if Result = nil then
1725 exit;
1726 // TFpValueDwarf(Result).SetStructureValue(Self);
1727 TFpValueDwarf(Result).Context := Context;
1728 end;
1729
1730 constructor TFpValueDwarfTypeDefinition.Create(ASymbol: TFpSymbolDwarf);
1731 begin
1732 inherited Create;
1733 FSymbol := ASymbol;
1734 FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpValueDwarfTypeDefinition'){$ENDIF};
1735 end;
1736
1737 destructor TFpValueDwarfTypeDefinition.Destroy;
1738 begin
1739 inherited Destroy;
1740 FSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpValueDwarfTypeDefinition'){$ENDIF};
1741 end;
1742
GetTypeCastedValuenull1743 function TFpValueDwarfTypeDefinition.GetTypeCastedValue(ADataVal: TFpValue): TFpValue;
1744 begin
1745 Result := FSymbol.TypeCastValue(ADataVal);
1746 assert((Result = nil) or (Result is TFpValueDwarf), 'TFpValueDwarfTypeDefinition.GetTypeCastedValue: (Result = nil) or (Result is TFpValueDwarf)');
1747 if (Result <> nil) and (TFpValueDwarf(Result).Context = nil) then
1748 TFpValueDwarf(Result).Context := Context;
1749 end;
1750
1751 { TFpValueDwarf }
1752
MemManagernull1753 function TFpValueDwarf.MemManager: TFpDbgMemManager;
1754 begin
1755 assert(Context<>nil, 'TFpValueDwarf.MemManager: Context<>nil');
1756 Result := nil;
1757 if Context <> nil then
1758 Result := Context.MemManager;
1759
1760 if Result = nil then begin
1761 // Either a typecast, or a member gotten from a typecast,...
1762 assert((FTypeSymbol <> nil) and (FTypeSymbol.CompilationUnit <> nil) and (FTypeSymbol.CompilationUnit.Owner <> nil), 'TDbgDwarfSymbolValue.MemManager');
1763 Result := FTypeSymbol.CompilationUnit.Owner.MemManager;
1764 end;
1765 end;
1766
AddressSizenull1767 function TFpValueDwarf.AddressSize: Byte;
1768 begin
1769 assert((FTypeSymbol <> nil) and (FTypeSymbol.CompilationUnit <> nil), 'TDbgDwarfSymbolValue.AddressSize');
1770 Result := FTypeSymbol.CompilationUnit.AddressSize;
1771 end;
1772
1773 procedure TFpValueDwarf.SetStructureValue(AValue: TFpValueDwarf);
1774 begin
1775 if FStructureValue <> nil then
1776 Reset;
1777
1778 if FStructureValue = AValue then
1779 exit;
1780
1781 FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
1782 FStructureValue := AValue;
1783 if FStructureValue <> nil then
1784 FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
1785 end;
1786
GetSizeFornull1787 function TFpValueDwarf.GetSizeFor(AnOtherValue: TFpValue; out
1788 ASize: TFpDbgValueSize): Boolean;
1789 begin
1790 Result := AnOtherValue.GetSize(ASize);
1791 if (not Result) and IsError(AnOtherValue.LastError) then
1792 SetLastError(AnOtherValue.LastError);
1793 end;
1794
OrdOrDataAddrnull1795 function TFpValueDwarf.OrdOrDataAddr: TFpDbgMemLocation;
1796 begin
1797 if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then
1798 Result := ConstLoc(FTypeCastSourceValue.AsCardinal)
1799 else
1800 GetDwarfDataAddress(Result);
1801 end;
1802
GetDataAddressnull1803 function TFpValueDwarf.GetDataAddress: TFpDbgMemLocation;
1804 begin
1805 GetDwarfDataAddress(Result);
1806 end;
1807
GetDwarfDataAddressnull1808 function TFpValueDwarf.GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
1809 ATargetType: TFpSymbolDwarfType): Boolean;
1810 var
1811 fields: TFpValueFieldFlags;
1812 ti: TFpSymbol;
1813 begin
1814 AnAddress := FCachedDataAddress;
1815 Result := IsInitializedLoc(AnAddress);
1816 if Result then
1817 exit(IsValidLoc(AnAddress));
1818
1819 FCachedDataAddress := InvalidLoc;
1820
1821 if FDataSymbol <> nil then begin
1822 Assert(FDataSymbol is TFpSymbolDwarfData, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol');
1823 Assert(TypeInfo is TFpSymbolDwarfType, 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo');
1824 Assert(not HasTypeCastInfo, 'TDbgDwarfSymbolValue.GetDwarfDataAddress not HasTypeCastInfo');
1825
1826 ti := FDataSymbol.TypeInfo;
1827 Result := ti <> nil;
1828 if not Result then
1829 exit;
1830 Assert((ti is TFpSymbolDwarfType) and (ti.SymbolType = stType), 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo = stType');
1831
1832 AnAddress := Address;
1833 Result := IsReadableLoc(AnAddress);
1834
1835 if Result then
1836 Result := TFpSymbolDwarf(ti).GetDataAddress(Self, AnAddress, ATargetType);
1837 end
1838
1839 else
1840 begin
1841 // TODO: cache own address
1842 // try typecast
1843 AnAddress := InvalidLoc;
1844 Result := HasTypeCastInfo;
1845 if not Result then
1846 exit;
1847 fields := FTypeCastSourceValue.FieldFlags;
1848 if svfOrdinal in fields then
1849 AnAddress := ConstLoc(FTypeCastSourceValue.AsCardinal)
1850 else
1851 if svfAddress in fields then
1852 AnAddress := FTypeCastSourceValue.Address;
1853
1854 Result := IsReadableLoc(AnAddress);
1855 if Result then
1856 Result := FTypeSymbol.GetDataAddress(Self, AnAddress, ATargetType);
1857 end;
1858
1859 if not Result then
1860 AnAddress := InvalidLoc;
1861 FCachedDataAddress := AnAddress;
1862 end;
1863
GetStructureDwarfDataAddressnull1864 function TFpValueDwarf.GetStructureDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
1865 ATargetType: TFpSymbolDwarfType): Boolean;
1866 begin
1867 AnAddress := InvalidLoc;
1868 Result := StructureValue <> nil;
1869 if Result then
1870 Result := StructureValue.GetDwarfDataAddress(AnAddress, ATargetType); // ATargetType could be parent class;
1871 end;
1872
1873 procedure TFpValueDwarf.Reset;
1874 begin
1875 FCachedAddress := UnInitializedLoc;
1876 FCachedDataAddress := UnInitializedLoc;
1877 FTypeSymbol.ResetValueBounds;
1878 end;
1879
GetFieldFlagsnull1880 function TFpValueDwarf.GetFieldFlags: TFpValueFieldFlags;
1881 begin
1882 Result := inherited GetFieldFlags;
1883 if FDataSymbol <> nil then begin
1884 if FDataSymbol.HasAddress then Result := Result + [svfAddress];
1885 end
1886 else
1887 if HasTypeCastInfo then begin
1888 Result := Result + FTypeCastSourceValue.FieldFlags * [svfAddress];
1889 end;
1890 end;
1891
HasTypeCastInfonull1892 function TFpValueDwarf.HasTypeCastInfo: Boolean;
1893 begin
1894 Result := (FTypeCastSourceValue <> nil);
1895 end;
1896
IsValidTypeCastnull1897 function TFpValueDwarf.IsValidTypeCast: Boolean;
1898 begin
1899 Result := False;
1900 end;
1901
GetKindnull1902 function TFpValueDwarf.GetKind: TDbgSymbolKind;
1903 begin
1904 Result := FTypeSymbol.Kind;
1905 end;
1906
GetAddressnull1907 function TFpValueDwarf.GetAddress: TFpDbgMemLocation;
1908 begin
1909 if IsInitializedLoc(FCachedAddress) then
1910 exit(FCachedAddress);
1911
1912 if FDataSymbol <> nil then
1913 FDataSymbol.GetValueAddress(Self, Result)
1914 else
1915 if HasTypeCastInfo then
1916 Result := FTypeCastSourceValue.Address
1917 else
1918 Result := inherited GetAddress;
1919
1920 assert(IsInitializedLoc(Result), 'TFpValueDwarf.GetAddress: IsInitializedLoc(Result)');
1921 FCachedAddress := Result;
1922 end;
1923
DoGetSizenull1924 function TFpValueDwarf.DoGetSize(out ASize: TFpDbgValueSize): Boolean;
1925 begin
1926 if (TypeCastSourceValue = nil) then begin
1927 Result := DbgSymbol.ReadSize(Self, ASize);
1928 if Result then
1929 exit;
1930 end
1931 else
1932 if not IsZeroSize(FForcedSize) then begin
1933 Result := True;
1934 ASize := FForcedSize;
1935 exit;
1936 end;
1937
1938 if FTypeSymbol <> nil then begin
1939 Result := FTypeSymbol.ReadSize(Self, ASize);
1940 end
1941 else
1942 Result := inherited DoGetSize(ASize);
1943 end;
1944
OrdOrAddressnull1945 function TFpValueDwarf.OrdOrAddress: TFpDbgMemLocation;
1946 begin
1947 if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then
1948 Result := ConstLoc(FTypeCastSourceValue.AsCardinal)
1949 else
1950 Result := Address;
1951 end;
1952
GetMemberCountnull1953 function TFpValueDwarf.GetMemberCount: Integer;
1954 begin
1955 Result := FTypeSymbol.NestedSymbolCount;
1956 end;
1957
GetMemberByNamenull1958 function TFpValueDwarf.GetMemberByName(const AIndex: String): TFpValue;
1959 begin
1960 Result := FTypeSymbol.GetNestedValueByName(AIndex);
1961 if Result = nil then
1962 exit;
1963 TFpValueDwarf(Result).SetStructureValue(Self);
1964 TFpValueDwarf(Result).Context := Context;
1965 end;
1966
GetMembernull1967 function TFpValueDwarf.GetMember(AIndex: Int64): TFpValue;
1968 begin
1969 Result := FTypeSymbol.GetNestedValue(AIndex);
1970 if Result = nil then
1971 exit;
1972 TFpValueDwarf(Result).SetStructureValue(Self);
1973 TFpValueDwarf(Result).Context := Context;
1974 end;
1975
GetDbgSymbolnull1976 function TFpValueDwarf.GetDbgSymbol: TFpSymbol;
1977 begin
1978 Result := FDataSymbol;
1979 end;
1980
GetTypeInfonull1981 function TFpValueDwarf.GetTypeInfo: TFpSymbol;
1982 begin
1983 Result := FTypeSymbol;
1984 end;
1985
GetParentTypeInfonull1986 function TFpValueDwarf.GetParentTypeInfo: TFpSymbol;
1987 begin
1988 Result := FParentTypeSymbol;
1989 end;
1990
1991 constructor TFpValueDwarf.Create(ADwarfTypeSymbol: TFpSymbolDwarfType);
1992 begin
1993 FTypeSymbol := ADwarfTypeSymbol;
1994 inherited Create;
1995 end;
1996
1997 destructor TFpValueDwarf.Destroy;
1998 begin
1999 FTypeCastSourceValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
2000 FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
2001 FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
2002 inherited Destroy;
2003 end;
2004
2005 procedure TFpValueDwarf.SetDataSymbol(AValueSymbol: TFpSymbolDwarfData);
2006 begin
2007 if FDataSymbol = AValueSymbol then
2008 exit;
2009
2010 FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
2011 FDataSymbol := AValueSymbol;
2012 if FDataSymbol <> nil then
2013 FDataSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
2014 end;
2015
SetTypeCastInfonull2016 function TFpValueDwarf.SetTypeCastInfo(ASource: TFpValue): Boolean;
2017 begin
2018 Reset;
2019
2020 if FTypeCastSourceValue <> ASource then begin
2021 if FTypeCastSourceValue <> nil then
2022 FTypeCastSourceValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
2023 FTypeCastSourceValue := ASource;
2024 if FTypeCastSourceValue <> nil then
2025 FTypeCastSourceValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
2026 end;
2027
2028 Result := IsValidTypeCast;
2029 end;
2030
2031 { TFpValueDwarfSized }
2032
CanUseTypeCastAddressnull2033 function TFpValueDwarfSized.CanUseTypeCastAddress: Boolean;
2034 var
2035 TypeSize, SrcSize: TFpDbgValueSize;
2036 begin
2037 Result := True;
2038 // Can Use TypeCast-Address, if source has an Address, but NO Size
2039 if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
2040 exit
2041 else
2042 // Can Use TypeCast-Address, if source has an Address, and SAME Size as this (this = cast-target-type)
2043 if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSize] = [svfAddress, svfSize]) then begin
2044 Result := GetSize(TypeSize) and GetSizeFor(FTypeCastSourceValue, SrcSize);
2045 if not Result then
2046 exit;
2047 if (TypeSize = SrcSize) and (SrcSize > 0) then
2048 exit;
2049 end;
2050 // Can Use TypeCast-Address, if source has an Address, but SAME Size as this (this = cast-target-type)
2051 // and yet not target type = pointer ???
2052 if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) and
2053 not ( (FTypeSymbol.Kind = skPointer) //or
2054 //(FSize = AddressSize xxxxxxx)
2055 )
2056 then
2057 exit;
2058 Result := False;
2059 end;
2060
GetFieldFlagsnull2061 function TFpValueDwarfSized.GetFieldFlags: TFpValueFieldFlags;
2062 begin
2063 Result := inherited GetFieldFlags;
2064 Result := Result + [svfSize];
2065 end;
2066
2067 { TFpValueDwarfNumeric }
2068
2069 procedure TFpValueDwarfNumeric.Reset;
2070 begin
2071 inherited Reset;
2072 FEvaluated := [];
2073 end;
2074
GetFieldFlagsnull2075 function TFpValueDwarfNumeric.GetFieldFlags: TFpValueFieldFlags;
2076 begin
2077 Result := inherited GetFieldFlags;
2078 Result := Result + [svfOrdinal];
2079 end;
2080
IsValidTypeCastnull2081 function TFpValueDwarfNumeric.IsValidTypeCast: Boolean;
2082 begin
2083 Result := HasTypeCastInfo;
2084 If not Result then
2085 exit;
2086 if (svfOrdinal in FTypeCastSourceValue.FieldFlags) or CanUseTypeCastAddress then
2087 exit;
2088 Result := False;
2089 end;
2090
2091 constructor TFpValueDwarfNumeric.Create(ADwarfTypeSymbol: TFpSymbolDwarfType);
2092 begin
2093 inherited Create(ADwarfTypeSymbol);
2094 FEvaluated := [];
2095 end;
2096
2097 { TFpValueDwarfInteger }
2098
GetFieldFlagsnull2099 function TFpValueDwarfInteger.GetFieldFlags: TFpValueFieldFlags;
2100 begin
2101 Result := inherited GetFieldFlags;
2102 Result := Result + [svfInteger];
2103 end;
2104
GetAsCardinalnull2105 function TFpValueDwarfInteger.GetAsCardinal: QWord;
2106 begin
2107 Result := QWord(GetAsInteger); // include sign extension
2108 end;
2109
GetAsIntegernull2110 function TFpValueDwarfInteger.GetAsInteger: Int64;
2111 var
2112 Size: TFpDbgValueSize;
2113 begin
2114 if doneInt in FEvaluated then begin
2115 Result := FIntValue;
2116 exit;
2117 end;
2118 Include(FEvaluated, doneInt);
2119
2120 if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
2121 Result := inherited GetAsInteger
2122 else
2123 if not Context.ReadSignedInt(OrdOrDataAddr, Size, Result) then begin
2124 Result := 0; // TODO: error
2125 SetLastError(Context.LastMemError);
2126 end;
2127
2128 FIntValue := Result;
2129 end;
2130
2131 procedure TFpValueDwarfInteger.SetAsInteger(AValue: Int64);
2132 var
2133 Size: TFpDbgValueSize;
2134 begin
2135 if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then begin
2136 inherited SetAsCardinal(AValue);
2137 end
2138 else
2139 if not Context.WriteSignedInt(OrdOrDataAddr, Size, AValue) then begin
2140 SetLastError(Context.LastMemError);
2141 Exclude(FEvaluated, doneInt);
2142 end
2143 else begin
2144 FIntValue := AValue;
2145 Include(FEvaluated, doneInt);
2146 end;
2147 end;
2148
2149 procedure TFpValueDwarfInteger.SetAsCardinal(AValue: QWord);
2150 begin
2151 SetAsInteger(int64(AValue));
2152 end;
2153
2154 { TDbgDwarfCardinalSymbolValue }
2155
GetAsCardinalnull2156 function TFpValueDwarfCardinal.GetAsCardinal: QWord;
2157 var
2158 Size: TFpDbgValueSize;
2159 begin
2160 if doneUInt in FEvaluated then begin
2161 Result := FValue;
2162 exit;
2163 end;
2164 Include(FEvaluated, doneUInt);
2165
2166 if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
2167 Result := inherited GetAsCardinal
2168 else
2169 if not Context.ReadUnsignedInt(OrdOrDataAddr, Size, Result) then begin
2170 Result := 0; // TODO: error
2171 SetLastError(Context.LastMemError);
2172 end;
2173
2174 FValue := Result;
2175 end;
2176
GetAsIntegernull2177 function TFpValueDwarfCardinal.GetAsInteger: Int64;
2178 begin
2179 Result := Int64(GetAsCardinal);
2180 end;
2181
GetFieldFlagsnull2182 function TFpValueDwarfCardinal.GetFieldFlags: TFpValueFieldFlags;
2183 begin
2184 Result := inherited GetFieldFlags;
2185 Result := Result + [svfCardinal];
2186 end;
2187
2188 procedure TFpValueDwarfCardinal.SetAsCardinal(AValue: QWord);
2189 var
2190 Size: TFpDbgValueSize;
2191 begin
2192 if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then begin
2193 inherited SetAsCardinal(AValue);
2194 end
2195 else
2196 if not Context.WriteUnsignedInt(OrdOrDataAddr, Size, AValue) then begin
2197 SetLastError(Context.LastMemError);
2198 Exclude(FEvaluated, doneUInt);
2199 end
2200 else begin
2201 FValue := AValue;
2202 Include(FEvaluated, doneUInt);
2203 end;
2204 end;
2205
2206 { TFpValueDwarfFloat }
2207
GetFieldFlagsnull2208 function TFpValueDwarfFloat.GetFieldFlags: TFpValueFieldFlags;
2209 begin
2210 Result := inherited GetFieldFlags;
2211 Result := Result + [svfFloat] - [svfOrdinal];
2212 end;
2213
GetAsFloatnull2214 function TFpValueDwarfFloat.GetAsFloat: Extended;
2215 var
2216 Size: TFpDbgValueSize;
2217 begin
2218 if doneFloat in FEvaluated then begin
2219 Result := FValue;
2220 exit;
2221 end;
2222 Include(FEvaluated, doneUInt);
2223
2224 if not GetSize(Size) then
2225 Result := 0
2226 else
2227 if (Size <= 0) or (Size > SizeOf(Result)) then begin
2228 Result := 0;
2229 SetLastError(CreateError(fpErrorBadFloatSize));
2230 end
2231 else
2232 if not Context.ReadFloat(OrdOrDataAddr, Size, Result) then begin
2233 Result := 0; // TODO: error
2234 SetLastError(Context.LastMemError);
2235 end;
2236
2237 FValue := Result;
2238 end;
2239
2240 { TFpValueDwarfBoolean }
2241
GetFieldFlagsnull2242 function TFpValueDwarfBoolean.GetFieldFlags: TFpValueFieldFlags;
2243 begin
2244 Result := inherited GetFieldFlags;
2245 Result := Result + [svfBoolean];
2246 end;
2247
GetAsBoolnull2248 function TFpValueDwarfBoolean.GetAsBool: Boolean;
2249 begin
2250 Result := QWord(GetAsCardinal) <> 0;
2251 end;
2252
2253 procedure TFpValueDwarfBoolean.SetAsBool(AValue: Boolean);
2254 begin
2255 SetAsCardinal(QWord(AValue));
2256 end;
2257
2258 { TFpValueDwarfChar }
2259
GetFieldFlagsnull2260 function TFpValueDwarfChar.GetFieldFlags: TFpValueFieldFlags;
2261 var
2262 Size: TFpDbgValueSize;
2263 begin
2264 if not GetSize(Size) then
2265 Size := ZeroSize;
2266 Result := inherited GetFieldFlags;
2267 case Size.Size of
2268 1: Result := Result + [svfString];
2269 2: Result := Result + [svfWideString];
2270 end;
2271 end;
2272
GetAsStringnull2273 function TFpValueDwarfChar.GetAsString: AnsiString;
2274 var
2275 Size: TFpDbgValueSize;
2276 begin
2277 if not GetSize(Size) then
2278 Size := ZeroSize;
2279 // Can typecast, because of FSize = 1, GetAsCardinal only read one byte
2280 if Size.Size = 2 then
2281 Result := GetAsWideString // temporary workaround for WideChar
2282 else
2283 if Size <> 1 then
2284 Result := inherited GetAsString
2285 else
2286 Result := SysToUTF8(char(byte(GetAsCardinal)));
2287 end;
2288
GetAsWideStringnull2289 function TFpValueDwarfChar.GetAsWideString: WideString;
2290 var
2291 Size: TFpDbgValueSize;
2292 begin
2293 if not GetSize(Size) then
2294 Size := ZeroSize;
2295 if Size.Size > 2 then
2296 Result := inherited GetAsWideString
2297 else
2298 Result := WideChar(Word(GetAsCardinal));
2299 end;
2300
2301 procedure TFpValueDwarfChar.SetAsString(AValue: AnsiString);
2302 var
2303 Size: TFpDbgValueSize;
2304 u: UnicodeString;
2305 begin
2306 if not GetSize(Size) then
2307 Size := ZeroSize;
2308 if Size.Size > 2 then begin
2309 inherited SetAsString(AValue);
2310 end
2311 else
2312 if Size.Size = 2 then begin
2313 u := UTF8Decode(AValue);
2314 if Length(u) <> 1 then
2315 inherited SetAsString(AValue) // error
2316 else
2317 SetAsCardinal(Word(u[1]));
2318 end
2319 else begin
2320 if Length(AValue) <> 1 then
2321 inherited SetAsString(AValue) // error
2322 else
2323 SetAsCardinal(Byte(AValue[1]));
2324 end;
2325 end;
2326
2327 { TFpValueDwarfPointer }
2328
GetDerefAddressnull2329 function TFpValueDwarfPointer.GetDerefAddress: TFpDbgMemLocation;
2330 var
2331 Size: TFpDbgValueSize;
2332 Addr: TFpDbgMemLocation;
2333 begin
2334 if doneAddr in FEvaluated then begin
2335 Result := FPointedToAddr;
2336 exit;
2337 end;
2338 Include(FEvaluated, doneAddr);
2339 Result := InvalidLoc;
2340
2341 if not GetSize(Size) then
2342 Size := ZeroSize;
2343 if (Size > 0) then begin
2344 Addr := OrdOrDataAddr;
2345 if not IsNilLoc(Addr) then begin
2346 if not Context.ReadAddress(Addr, SizeVal(Context.SizeOfAddress), Result) then
2347 SetLastError(Context.LastMemError);
2348 end;
2349 end;
2350 FPointedToAddr := Result;
2351 end;
2352
GetAsCardinalnull2353 function TFpValueDwarfPointer.GetAsCardinal: QWord;
2354 var
2355 a: TFpDbgMemLocation;
2356 begin
2357 a := GetDerefAddress;
2358 if IsTargetAddr(a) then
2359 Result := LocToAddr(a)
2360 else
2361 Result := 0;
2362 end;
2363
GetFieldFlagsnull2364 function TFpValueDwarfPointer.GetFieldFlags: TFpValueFieldFlags;
2365 var
2366 t: TFpSymbol;
2367 Size: TFpDbgValueSize;
2368 begin
2369 Result := inherited GetFieldFlags;
2370 //TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
2371 Result := Result + [svfCardinal, svfOrdinal, svfSizeOfPointer, svfDataAddress] - [svfSize]; // data address
2372
2373 t := TypeInfo;
2374 if (t <> nil) then t := t.TypeInfo;
2375 if (t <> nil) and (t.Kind = skChar) and IsValidLoc(GetDerefAddress) then begin // pchar
2376 if not t.ReadSize(nil, Size) then
2377 Size := ZeroSize;
2378 case Size.Size of
2379 1: Result := Result + [svfString];
2380 2: Result := Result + [svfWideString];
2381 end;
2382 end;
2383 end;
2384
GetDataAddressnull2385 function TFpValueDwarfPointer.GetDataAddress: TFpDbgMemLocation;
2386 var
2387 Size: TFpDbgValueSize;
2388 begin
2389 if not GetSize(Size) then
2390 Size := ZeroSize;
2391 if (Size <= 0) then
2392 Result := InvalidLoc
2393 else
2394 Result := inherited;
2395 end;
2396
GetAsStringnull2397 function TFpValueDwarfPointer.GetAsString: AnsiString;
2398 var
2399 t: TFpSymbol;
2400 i: Cardinal;
2401 Size: TFpDbgValueSize;
2402 begin
2403 Result := '';
2404 t := TypeInfo;
2405 if t = nil then
2406 exit;
2407 t := t.TypeInfo;
2408 if t = nil then
2409 exit;
2410
2411 // Only test for hardcoded size. TODO: dwarf 3 could have variable size, but for char that is not expected
2412 if not t.ReadSize(nil, Size) then
2413 exit;
2414
2415 if Size.Size = 2 then
2416 Result := GetAsWideString
2417 else
2418 if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then begin // pchar
2419 i := MemManager.MemLimits.MaxNullStringSearchLen;
2420 if i = 0 then
2421 i := 32*1024;
2422 if i > MemManager.MemLimits.MaxMemReadSize then
2423 i := MemManager.MemLimits.MaxMemReadSize;
2424 if not MemManager.SetLength(Result, i) then begin
2425 Result := '';
2426 SetLastError(MemManager.LastError);
2427 exit;
2428 end;
2429
2430 if not Context.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], [mmfPartialRead]) then begin
2431 Result := '';
2432 SetLastError(Context.LastMemError);
2433 exit;
2434 end;
2435
2436 i := Context.PartialReadResultLenght;
2437 SetLength(Result,i);
2438 i := pos(#0, Result);
2439 if i > 0 then
2440 SetLength(Result,i-1);
2441 end
2442 else
2443 Result := inherited GetAsString;
2444 end;
2445
GetAsWideStringnull2446 function TFpValueDwarfPointer.GetAsWideString: WideString;
2447 var
2448 t: TFpSymbol;
2449 i: Cardinal;
2450 begin
2451 t := TypeInfo;
2452 if (t <> nil) then t := t.TypeInfo;
2453 // skWideChar ???
2454 if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then begin // pchar
2455 i := MemManager.MemLimits.MaxNullStringSearchLen * 2;
2456 if i = 0 then
2457 i := 32*1024 * 2;
2458 if i > MemManager.MemLimits.MaxMemReadSize then
2459 i := MemManager.MemLimits.MaxMemReadSize;
2460 if not MemManager.SetLength(Result, i div 2) then begin
2461 Result := '';
2462 SetLastError(MemManager.LastError);
2463 exit;
2464 end;
2465
2466 if not Context.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], [mmfPartialRead]) then begin
2467 Result := '';
2468 SetLastError(Context.LastMemError);
2469 exit;
2470 end;
2471
2472 i := Context.PartialReadResultLenght;
2473 SetLength(Result, i div 2);
2474 i := pos(#0, Result);
2475 if i > 0 then
2476 SetLength(Result, i-1);
2477 end
2478 else
2479 Result := inherited GetAsWideString;
2480 end;
2481
GetMembernull2482 function TFpValueDwarfPointer.GetMember(AIndex: Int64): TFpValue;
2483 var
2484 ti: TFpSymbol;
2485 addr: TFpDbgMemLocation;
2486 Tmp: TFpValueDwarfConstAddress;
2487 Size: TFpDbgValueSize;
2488 begin
2489 //TODO: ?? if no TypeInfo.TypeInfo;, then return TFpValueDwarfConstAddress.Create(addr); (for mem dump)
2490 Result := nil;
2491 if (TypeInfo = nil) then begin // TODO dedicanted error code
2492 SetLastError(CreateError(fpErrAnyError, ['Can not dereference an untyped pointer']));
2493 exit;
2494 end;
2495
2496 // TODO re-use last member
2497
2498 ti := TypeInfo.TypeInfo;
2499 {$PUSH}{$R-}{$Q-} // TODO: check overflow
2500 if (ti <> nil) and (AIndex <> 0) then begin
2501 // Only test for hardcoded size. TODO: dwarf 3 could have variable size, but for char that is not expected
2502 // TODO: Size of member[0] ?
2503 if not ti.ReadSize(nil, Size) then begin
2504 SetLastError(CreateError(fpErrAnyError, ['Can index element of unknown size']));
2505 exit;
2506 end;
2507 AIndex := AIndex * SizeToFullBytes(Size);
2508 end;
2509 addr := GetDerefAddress;
2510 if not IsTargetAddr(addr) then begin
2511 SetLastError(CreateError(fpErrAnyError, ['Internal dereference error']));
2512 exit;
2513 end;
2514 addr.Address := addr.Address + AIndex;
2515 {$POP}
2516
2517 Tmp := TFpValueDwarfConstAddress.Create(addr);
2518 if ti <> nil then begin
2519 Result := ti.TypeCastValue(Tmp);
2520 Tmp.ReleaseReference;
2521 TFpValueDwarf(Result).SetStructureValue(Self);
2522 TFpValueDwarf(Result).Context := Context;
2523 end
2524 else begin
2525 Result := Tmp;
2526 end;
2527 end;
2528
2529 procedure TFpValueDwarfPointer.SetAsCardinal(AValue: QWord);
2530 begin
2531 if not Context.WriteSignedInt(OrdOrDataAddr, SizeVal(Context.SizeOfAddress), AValue) then begin
2532 SetLastError(Context.LastMemError);
2533 Exclude(FEvaluated, doneAddr);
2534 end
2535 else begin
2536 FPointedToAddr := TargetLoc(TDBGPtr(AValue));
2537 Include(FEvaluated, doneAddr);
2538 end;
2539 end;
2540
2541 { TFpValueDwarfEnum }
2542
2543 procedure TFpValueDwarfEnum.InitMemberIndex;
2544 var
2545 v: QWord;
2546 i: Integer;
2547 begin
2548 // TODO: if TypeInfo is a subrange, check against the bounds, then bypass it, and scan all members (avoid subrange scanning members)
2549 if FMemberValueDone then exit;
2550 // FTypeSymbol (if not nil) must be same as FTypeSymbol. It may have wrappers like declaration.
2551 v := GetAsCardinal;
2552 i := FTypeSymbol.NestedSymbolCount - 1;
2553 while i >= 0 do begin
2554 if FTypeSymbol.NestedSymbol[i].OrdinalValue = v then break;
2555 dec(i);
2556 end;
2557 FMemberIndex := i;
2558 FMemberValueDone := True;
2559 end;
2560
2561 procedure TFpValueDwarfEnum.Reset;
2562 begin
2563 inherited Reset;
2564 FMemberValueDone := False;
2565 end;
2566
GetFieldFlagsnull2567 function TFpValueDwarfEnum.GetFieldFlags: TFpValueFieldFlags;
2568 begin
2569 Result := inherited GetFieldFlags;
2570 Result := Result + [svfOrdinal, svfMembers, svfIdentifier];
2571 end;
2572
GetAsCardinalnull2573 function TFpValueDwarfEnum.GetAsCardinal: QWord;
2574 var
2575 Size: TFpDbgValueSize;
2576 begin
2577 if doneUInt in FEvaluated then begin
2578 Result := FValue;
2579 exit;
2580 end;
2581 Include(FEvaluated, doneUInt);
2582
2583 if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
2584 Result := inherited GetAsCardinal
2585 else
2586 if not Context.ReadEnum(OrdOrDataAddr, Size, Result) then begin
2587 SetLastError(Context.LastMemError);
2588 Result := 0; // TODO: error
2589 end;
2590
2591 FValue := Result;
2592 end;
2593
2594 procedure TFpValueDwarfEnum.SetAsCardinal(AValue: QWord);
2595 var
2596 Size: TFpDbgValueSize;
2597 begin
2598 if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then begin
2599 inherited SetAsCardinal(AValue);
2600 end
2601 else
2602 if not Context.WriteEnum(OrdOrDataAddr, Size, AValue) then begin
2603 SetLastError(Context.LastMemError);
2604 Exclude(FEvaluated, doneUInt);
2605 end
2606 else begin
2607 FValue := AValue;
2608 Include(FEvaluated, doneUInt);
2609 end;
2610 end;
2611
GetAsStringnull2612 function TFpValueDwarfEnum.GetAsString: AnsiString;
2613 begin
2614 InitMemberIndex;
2615 if FMemberIndex >= 0 then
2616 Result := FTypeSymbol.NestedSymbol[FMemberIndex].Name
2617 else
2618 Result := '';
2619 end;
2620
GetMemberCountnull2621 function TFpValueDwarfEnum.GetMemberCount: Integer;
2622 begin
2623 InitMemberIndex;
2624 if FMemberIndex < 0 then
2625 Result := 0
2626 else
2627 Result := 1;
2628 end;
2629
GetMembernull2630 function TFpValueDwarfEnum.GetMember(AIndex: Int64): TFpValue;
2631 begin
2632 InitMemberIndex;
2633 if (FMemberIndex >= 0) and (AIndex = 0) then begin
2634 Result := FTypeSymbol.GetNestedValue(FMemberIndex);
2635 assert(Result is TFpValueDwarfBase, 'Result is TFpValueDwarfBase');
2636 TFpValueDwarfBase(Result).Context := Context;
2637 end
2638 else
2639 Result := nil;
2640 end;
2641
2642 procedure TFpValueDwarfEnum.SetAsString(AValue: AnsiString);
2643 var
2644 EnumSymbol: TFpSymbol;
2645 begin
2646 EnumSymbol := TypeInfo.NestedSymbolByName[AValue];
2647 if Assigned(EnumSymbol) then begin
2648 SetAsCardinal(EnumSymbol.OrdinalValue);
2649 end
2650 else
2651 SetLastError(CreateError(fpErrAnyError, ['Not a valid enum-value']));
2652 end;
2653
2654 { TFpValueDwarfEnumMember }
2655
GetFieldFlagsnull2656 function TFpValueDwarfEnumMember.GetFieldFlags: TFpValueFieldFlags;
2657 begin
2658 Result := inherited GetFieldFlags;
2659 Result := Result + [svfOrdinal, svfIdentifier];
2660 end;
2661
GetAsCardinalnull2662 function TFpValueDwarfEnumMember.GetAsCardinal: QWord;
2663 begin
2664 Result := FOwnerVal.OrdinalValue;
2665 end;
2666
GetAsStringnull2667 function TFpValueDwarfEnumMember.GetAsString: AnsiString;
2668 begin
2669 Result := FOwnerVal.Name;
2670 end;
2671
IsValidTypeCastnull2672 function TFpValueDwarfEnumMember.IsValidTypeCast: Boolean;
2673 begin
2674 assert(False, 'TDbgDwarfEnumMemberSymbolValue.IsValidTypeCast can not be returned for typecast');
2675 Result := False;
2676 end;
2677
GetKindnull2678 function TFpValueDwarfEnumMember.GetKind: TDbgSymbolKind;
2679 begin
2680 Result := skEnumValue;
2681 end;
2682
2683 constructor TFpValueDwarfEnumMember.Create(AOwner: TFpSymbolDwarfData);
2684 begin
2685 FOwnerVal := AOwner;
2686 inherited Create(nil);
2687 end;
2688
2689 { TFpValueDwarfConstNumber }
2690
2691 procedure TFpValueDwarfConstNumber.Update(AValue: QWord; ASigned: Boolean);
2692 begin
2693 Signed := ASigned;
2694 Value := AValue;
2695 end;
2696
2697 { TFpValueDwarfSet }
2698
2699 procedure TFpValueDwarfSet.InitMap;
2700 const
2701 BitCount: array[0..15] of byte = (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
2702 var
2703 i, i2, v, MemIdx, Bit, Cnt: Integer;
2704
2705 t: TFpSymbol;
2706 hb, lb: Int64;
2707 DAddr: TFpDbgMemLocation;
2708 Size: TFpDbgValueSize;
2709 begin
2710 if not GetSize(Size) then
2711 Size := ZeroSize;
2712 if (length(FMem) > 0) or (Size <= 0) then
2713 exit;
2714 t := TypeInfo;
2715 if t = nil then exit;
2716 t := t.TypeInfo;
2717 if t = nil then exit;
2718
2719 GetDwarfDataAddress(DAddr);
2720 if not Context.ReadSet(DAddr, Size, FMem) then begin
2721 SetLastError(Context.LastMemError);
2722 exit; // TODO: error
2723 end;
2724
2725 Cnt := 0;
2726 for i := 0 to Size.Size - 1 do
2727 Cnt := Cnt + (BitCount[FMem[i] and 15]) + (BitCount[(FMem[i] div 16) and 15]);
2728 FMemberCount := Cnt;
2729
2730 if (Cnt = 0) then exit;
2731 SetLength(FMemberMap, Cnt);
2732
2733 if (t.Kind = skEnum) then begin
2734 i2 := 0;
2735 for i := 0 to t.NestedSymbolCount - 1 do
2736 begin
2737 v := t.NestedSymbol[i].OrdinalValue;
2738 MemIdx := v shr 3;
2739 Bit := 1 shl (v and 7);
2740 if (FMem[MemIdx] and Bit) <> 0 then begin
2741 assert(i2 < Cnt, 'TDbgDwarfSetSymbolValue.InitMap too many members');
2742 if i2 = Cnt then break;
2743 FMemberMap[i2] := i;
2744 inc(i2);
2745 end;
2746 end;
2747
2748 if i2 < Cnt then begin
2749 FMemberCount := i2;
2750 debugln(FPDBG_DWARF_DATA_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
2751 end;
2752 end
2753 else begin
2754 i2 := 0;
2755 MemIdx := 0;
2756 Bit := 1;
2757 t.GetValueBounds(nil, lb, hb);
2758 for i := lb to hb do
2759 begin
2760 if (FMem[MemIdx] and Bit) <> 0 then begin
2761 assert(i2 < Cnt, 'TDbgDwarfSetSymbolValue.InitMap too many members');
2762 if i2 = Cnt then break;
2763 FMemberMap[i2] := i - lb; // offset from low-bound
2764 inc(i2);
2765 end;
2766 if Bit = 128 then begin
2767 Bit := 1;
2768 inc(MemIdx);
2769 end
2770 else
2771 Bit := Bit shl 1;
2772 end;
2773
2774 if i2 < Cnt then begin
2775 FMemberCount := i2;
2776 debugln(FPDBG_DWARF_DATA_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
2777 end;
2778 end;
2779
2780 end;
2781
2782 procedure TFpValueDwarfSet.Reset;
2783 begin
2784 inherited Reset;
2785 SetLength(FMem, 0);
2786 end;
2787
GetFieldFlagsnull2788 function TFpValueDwarfSet.GetFieldFlags: TFpValueFieldFlags;
2789 var
2790 Size: TFpDbgValueSize;
2791 begin
2792 Result := inherited GetFieldFlags;
2793 Result := Result + [svfMembers];
2794 if not GetSize(Size) then
2795 exit;
2796 if Size <= 8 then
2797 Result := Result + [svfOrdinal];
2798 end;
2799
GetMemberCountnull2800 function TFpValueDwarfSet.GetMemberCount: Integer;
2801 begin
2802 InitMap;
2803 Result := FMemberCount;
2804 end;
2805
GetMembernull2806 function TFpValueDwarfSet.GetMember(AIndex: Int64): TFpValue;
2807 var
2808 lb: Int64;
2809 t: TFpSymbolDwarfType;
2810 begin
2811 Result := nil;
2812 InitMap;
2813 t := TypeInfo;
2814 if t = nil then exit;
2815 t := t.TypeInfo;
2816 if t = nil then exit;
2817 assert(t is TFpSymbolDwarfType, 'TDbgDwarfSetSymbolValue.GetMember t');
2818
2819 if t.Kind = skEnum then begin
2820 Result := t.GetNestedValue(FMemberMap[AIndex]);
2821 assert(Result is TFpValueDwarfBase, 'Result is TFpValueDwarfBase');
2822 TFpValueDwarfBase(Result).Context := Context;
2823 end
2824 else begin
2825 // TODO: value object for the subrange
2826 // TODO: cache the result
2827 if not t.GetValueLowBound(nil, lb) then
2828 lb := 0;
2829 if (FNumValue = nil) or (FNumValue.RefCount > 1) then begin // refcount 1 by FTypedNumValue
2830 FNumValue := TFpValueDwarfConstNumber.Create(FMemberMap[AIndex] + lb, t.Kind = skInteger);
2831 end
2832 else
2833 begin
2834 FNumValue.Update(FMemberMap[AIndex] + lb, t.Kind = skInteger);
2835 FNumValue.AddReference;
2836 end;
2837
2838 if (FTypedNumValue = nil) or (FTypedNumValue.RefCount > 1) then begin
2839 FTypedNumValue.ReleaseReference;
2840 FTypedNumValue := t.TypeCastValue(FNumValue);
2841 assert((FTypedNumValue is TFpValueDwarf), 'is TFpValueDwarf');
2842 TFpValueDwarf(FTypedNumValue).Context := Context;
2843 end
2844 else
2845 TFpValueDwarf(FTypedNumValue).SetTypeCastInfo(FNumValue); // update
2846
2847 FNumValue.ReleaseReference;
2848 Assert((FTypedNumValue <> nil) and (TFpValueDwarf(FTypedNumValue).IsValidTypeCast), 'TDbgDwarfSetSymbolValue.GetMember FTypedNumValue');
2849 Assert((FNumValue <> nil) and (FNumValue.RefCount > 0), 'TDbgDwarfSetSymbolValue.GetMember FNumValue');
2850 Result := FTypedNumValue;
2851 Result.AddReference;
2852 end;
2853 end;
2854
GetAsCardinalnull2855 function TFpValueDwarfSet.GetAsCardinal: QWord;
2856 var
2857 Size: TFpDbgValueSize;
2858 begin
2859 Result := 0;
2860 if (not GetSize(Size)) or (Size < 0) or (Size > SizeOf(QWord)) then
2861 exit;
2862 InitMap;
2863 if (Size <= SizeOf(Result)) and (length(FMem) > 0) then
2864 move(FMem[0], Result, Min(SizeOf(Result), SizeToFullBytes(Size)));
2865 end;
2866
IsValidTypeCastnull2867 function TFpValueDwarfSet.IsValidTypeCast: Boolean;
2868 var
2869 f: TFpValueFieldFlags;
2870 TypeSize, SrcSize: TFpDbgValueSize;
2871 begin
2872 Result := HasTypeCastInfo;
2873 If not Result then
2874 exit;
2875
2876 assert(FTypeSymbol.Kind = skSet, 'TFpValueDwarfSet.IsValidTypeCast: FTypeSymbol.Kind = skSet');
2877
2878 if (FTypeCastSourceValue.TypeInfo = FTypeSymbol)
2879 then
2880 exit; // pointer deref
2881
2882 // Is valid if source has Address, but NO Size
2883 f := FTypeCastSourceValue.FieldFlags;
2884 if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
2885 exit;
2886
2887 // Is valid if source has Address, but and same Size
2888 if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) then begin
2889 Result := GetSize(TypeSize) and GetSizeFor(FTypeCastSourceValue, SrcSize);
2890 if not Result then
2891 exit;
2892 if (TypeSize = SrcSize) then
2893 exit;
2894 end;
2895
2896 Result := False;
2897 end;
2898
2899 procedure TFpValueDwarfSet.SetAsString(AValue: AnsiString);
2900 type
2901 TCharSet = set of char;
2902 function CheckInChar(var p: PChar; c: TCharSet): Boolean;
2903 begin
2904 Result := p^ in c;
2905 if Result then
2906 inc(p)
2907 else
2908 SetLastError(CreateError(fpErrFailedWriteMem));
2909 end;
2910 procedure SkipSpaces(var p: Pchar);
2911 begin
2912 while p^ in [' ', #9] do inc(p);
2913 end;
2914 function CopySubString(PEnd, PStart: PChar): String;
2915 begin
2916 SetLength(Result, PEnd - PStart);
2917 move(PStart^, Result[1], PEnd - PStart);
2918 end;
2919 var
2920 Size: TFpDbgValueSize;
2921 WriteMem: array of Byte;
2922 p, p2: PChar;
2923 s: String;
2924 idx: Integer;
2925 t: TFpSymbolDwarfType;
2926 nest: TFpSymbol;
2927 v, lb, hb, MemIdx, Bit: Int64;
2928 DAddr: TFpDbgMemLocation;
2929 begin
2930 if not GetSize(Size) then
2931 Size := ZeroSize;
2932 if (Size <= 0) then begin
2933 SetLastError(CreateError(fpErrFailedWriteMem));
2934 exit;
2935 end;
2936 InitMap;
2937 t := TypeInfo;
2938 if t = nil then exit;
2939 t := t.TypeInfo;
2940 if t = nil then exit;
2941 assert(t is TFpSymbolDwarfType, 'TDbgDwarfSetSymbolValue.GetMember t');
2942
2943 SetLength(WriteMem, SizeToFullBytes(Size));
2944
2945 p := Pchar(AValue);
2946 SkipSpaces(p);
2947 if not CheckInChar(p, ['[']) then
2948 exit;
2949
2950 SkipSpaces(p);
2951 if p^ <> ']' then begin // not an empty set
2952
2953 if t.Kind = skEnum then begin
2954 while p^ in ['a'..'z', 'A'..'Z', '_'] do begin
2955 p2 := p;
2956 inc(p);
2957 while p^ in ['a'..'z', 'A'..'Z', '_', '0'..'9'] do
2958 inc(p);
2959 s := LowerCase(CopySubString(p, p2));
2960
2961 idx := t.GetNestedSymbolCount - 1;
2962 while idx >= 0 do begin
2963 nest := t.GetNestedSymbol(idx);
2964 if (nest <> nil) and (LowerCase(nest.Name) = s) then
2965 break;
2966 dec(idx);
2967 end;
2968 if (idx >= 0) then begin
2969 v := nest.OrdinalValue;
2970 if (v >= 0) and (v < Length(WriteMem) * 8) then begin
2971 MemIdx := v shr 3;
2972 Bit := 1 shl (v and 7);
2973 WriteMem[MemIdx] := WriteMem[MemIdx] or Bit;
2974 end
2975 else
2976 idx := -1;
2977 end;
2978 if idx < 0 then begin
2979 SetLastError(CreateError(fpErrFailedWriteMem));
2980 exit;
2981 end;
2982
2983 SkipSpaces(p);
2984 if p^ = ']' then
2985 break;
2986 if not CheckInChar(p, [',']) then
2987 exit;
2988 SkipSpaces(p);
2989 end;
2990 SkipSpaces(p);
2991 end
2992 else begin // set of 1..9
2993 if not t.GetValueBounds(nil, lb, hb) then begin
2994 SetLastError(CreateError(fpErrFailedWriteMem));
2995 exit;
2996 end;
2997
2998 while p^ in ['0'..'9', '$', '%', '&'] do begin
2999 p2 := p;
3000 inc(p);
3001 case p[-1] of
3002 '$': while p^ in ['a'..'f', 'A'..'F', '0'..'9'] do inc(p);
3003 '&': while p^ in ['0'..'7'] do inc(p);
3004 '%': while p^ in ['0'..'1'] do inc(p);
3005 else while p^ in ['0'..'9'] do inc(p);
3006 end;
3007 if not TryStrToInt(CopySubString(p, p2), idx) then begin
3008 SetLastError(CreateError(fpErrFailedWriteMem));
3009 exit;
3010 end;
3011 idx := idx - lb;
3012
3013 if (idx >= 0) and (idx < Length(WriteMem) * 8) then begin
3014 MemIdx := idx shr 3;
3015 Bit := 1 shl (idx and 7);
3016 WriteMem[MemIdx] := WriteMem[MemIdx] or Bit;
3017 end
3018 else begin
3019 SetLastError(CreateError(fpErrFailedWriteMem));
3020 exit;
3021 end;
3022
3023 SkipSpaces(p);
3024 if p^ = ']' then
3025 break;
3026 if not CheckInChar(p, [',']) then
3027 exit;
3028 SkipSpaces(p);
3029 end;
3030 SkipSpaces(p);
3031 end;
3032
3033 end;
3034 if not CheckInChar(p, [']']) then
3035 exit;
3036 SkipSpaces(p);
3037 if not CheckInChar(p, [#0]) then
3038 exit;
3039
3040 // we got the value
3041 FMem := nil;
3042
3043 // todo writeset
3044 GetDwarfDataAddress(DAddr);
3045 if not Context.WriteSet(DAddr, Size, WriteMem) then begin
3046 SetLastError(Context.LastMemError);
3047 exit; // TODO: error
3048 end;
3049
3050 end;
3051
3052 destructor TFpValueDwarfSet.Destroy;
3053 begin
3054 FTypedNumValue.ReleaseReference;
3055 inherited Destroy;
3056 end;
3057
3058 { TFpValueDwarfStruct }
3059
3060 procedure TFpValueDwarfStruct.Reset;
3061 begin
3062 inherited Reset;
3063 FDataAddressDone := False;
3064 end;
3065
GetFieldFlagsnull3066 function TFpValueDwarfStruct.GetFieldFlags: TFpValueFieldFlags;
3067 begin
3068 Result := inherited GetFieldFlags;
3069 Result := Result + [svfMembers];
3070
3071 //TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
3072 if Kind in [skClass] then begin
3073 Result := Result + [svfOrdinal, svfDataAddress, svfDataSize]; // svfDataSize
3074 if ((FDataSymbol <> nil) and FDataSymbol.HasAddress) or
3075 (HasTypeCastInfo and (Kind = skClass))
3076 then
3077 Result := Result + [svfSizeOfPointer];
3078 end
3079 else begin
3080 Result := Result + [svfSize];
3081 end;
3082 end;
3083
GetAsCardinalnull3084 function TFpValueDwarfStruct.GetAsCardinal: QWord;
3085 var
3086 Addr: TFpDbgMemLocation;
3087 begin
3088 if not GetDwarfDataAddress(Addr) then
3089 Result := 0
3090 else
3091 Result := QWord(LocToAddrOrNil(Addr));
3092 end;
3093
3094 procedure TFpValueDwarfStruct.SetAsCardinal(AValue: QWord);
3095 var
3096 Addr: TFpDbgMemLocation;
3097 begin
3098 Addr := Address;
3099 if not IsValidLoc(Addr) then
3100 SetLastError(CreateError(fpErrFailedWriteMem))
3101 else begin
3102 if not Context.WriteUnsignedInt(Addr, SizeVal(Context.SizeOfAddress), AValue) then
3103 SetLastError(Context.LastMemError);
3104 end;
3105 end;
3106
GetDataSizenull3107 function TFpValueDwarfStruct.GetDataSize: TFpDbgValueSize;
3108 var
3109 ti: TFpSymbolDwarf;
3110 begin
3111 Result := ZeroSize;
3112 ti := nil;
3113 if HasTypeCastInfo then begin
3114 Assert((FTypeSymbol = nil) or (FTypeSymbol is TFpSymbolDwarf));
3115 ti := FTypeSymbol;
3116 end
3117 else begin
3118 Assert((FDataSymbol = nil) or (FDataSymbol.TypeInfo is TFpSymbolDwarf));
3119 if (FDataSymbol <> nil) then
3120 ti := TFpSymbolDwarf(FDataSymbol.TypeInfo);
3121 end;
3122
3123 if (ti <> nil) and (ti.Kind = skClass) then begin
3124 if not ti.DoReadDataSize(Self, Result) then
3125 Result := ZeroSize;
3126 end
3127 else
3128 if not GetSize(Result) then
3129 Result := ZeroSize;
3130 end;
3131
IsValidTypeCastnull3132 function TFpValueDwarfStruct.IsValidTypeCast: Boolean;
3133 var
3134 f: TFpValueFieldFlags;
3135 SrcSize, TypeSize: TFpDbgValueSize;
3136 begin
3137 if not HasTypeCastInfo then begin
3138 Result := inherited IsValidTypeCast;
3139 end
3140 else begin
3141 Result := HasTypeCastInfo;
3142 if not Result then
3143 exit;
3144
3145 if FTypeSymbol.Kind in [skClass, skInstance] then begin
3146 f := FTypeCastSourceValue.FieldFlags;
3147 // skClass: Valid if Source has Ordinal
3148 Result := (svfOrdinal in f); // ordinal is prefered in GetDataAddress
3149 if Result then
3150 exit;
3151 // skClass: Valid if Source has Address, and (No Size) OR (same Size)
3152 if not (svfAddress in f) then
3153 exit;
3154 Result := not(svfSize in f); // either svfSizeOfPointer or a void type, e.g. pointer(1)^
3155 if Result then
3156 exit;
3157 if not GetSizeFor(FTypeCastSourceValue, SrcSize) then
3158 exit;
3159 Result := SrcSize = AddressSize;
3160 end
3161 else begin
3162 f := FTypeCastSourceValue.FieldFlags;
3163 // skRecord: ONLY Valid if Source has Address
3164 if (f * [{svfOrdinal, }svfAddress] = [svfAddress]) then begin
3165 // skRecord: AND either ... if Source has same Size
3166 if (f * [svfSize, svfSizeOfPointer]) = [svfSize] then begin
3167 Result := GetSize(TypeSize) and GetSizeFor(FTypeCastSourceValue, SrcSize);
3168 Result := Result and (TypeSize = SrcSize)
3169 end
3170 else
3171 // skRecord: AND either ... if Source has same Size (pointer size)
3172 if (f * [svfSize, svfSizeOfPointer]) = [svfSizeOfPointer] then begin
3173 Result := GetSize(TypeSize);
3174 Result := Result and (TypeSize = AddressSize);
3175 end
3176 // skRecord: AND either ... if Source has NO Size
3177 else
3178 Result := (f * [svfSize, svfSizeOfPointer]) = []; // source is a void type, e.g. pointer(1)^
3179 end
3180 else
3181 Result := False;
3182 end;
3183 end;
3184 end;
3185
3186 { TFpValueDwarfConstAddress }
3187
3188 procedure TFpValueDwarfConstAddress.Update(AnAddress: TFpDbgMemLocation);
3189 begin
3190 Address := AnAddress;
3191 end;
3192
3193 { TFpValueDwarfArray }
3194
3195 procedure TFpValueDwarfArray.Reset;
3196 begin
3197 FEvalFlags := [];
3198 FStrides := nil;
3199 inherited Reset;
3200 end;
3201
GetFieldFlagsnull3202 function TFpValueDwarfArray.GetFieldFlags: TFpValueFieldFlags;
3203 begin
3204 Result := inherited GetFieldFlags;
3205 Result := Result + [svfMembers];
3206 if (TypeInfo <> nil) and (sfDynArray in TypeInfo.Flags) then
3207 Result := Result + [svfOrdinal, svfDataAddress];
3208 end;
3209
GetKindnull3210 function TFpValueDwarfArray.GetKind: TDbgSymbolKind;
3211 begin
3212 Result := skArray;
3213 end;
3214
GetAsCardinalnull3215 function TFpValueDwarfArray.GetAsCardinal: QWord;
3216 begin
3217 // TODO cache
3218 if not Context.ReadUnsignedInt(OrdOrAddress, SizeVal(AddressSize), Result) then begin
3219 SetLastError(Context.LastMemError);
3220 Result := 0;
3221 end;
3222 end;
3223
GetMembernull3224 function TFpValueDwarfArray.GetMember(AIndex: Int64): TFpValue;
3225 begin
3226 Result := GetMemberEx([AIndex]);
3227 end;
3228
GetMemberExnull3229 function TFpValueDwarfArray.GetMemberEx(const AIndex: array of Int64
3230 ): TFpValue;
3231 var
3232 Addr: TFpDbgMemLocation;
3233 i: Integer;
3234 Stride: TFpDbgValueSize;
3235 begin
3236 Result := nil;
3237 assert((FArraySymbol is TFpSymbolDwarfTypeArray) and (FArraySymbol.Kind = skArray));
3238
3239 Addr := TFpSymbolDwarfTypeArray(FArraySymbol).GetMemberAddress(Self, AIndex);
3240 if not IsReadableLoc(Addr) then exit;
3241
3242 // FAddrObj.RefCount: hold by self
3243 i := 1;
3244 // FAddrObj.RefCount: hold by FLastMember (ignore only, if FLastMember is not hold by others)
3245 if (FLastMember <> nil) and (FLastMember.RefCount = 1) then
3246 i := 2;
3247 if (FAddrObj = nil) or (FAddrObj.RefCount > i) then begin
3248 FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
3249 FAddrObj := TFpValueDwarfConstAddress.Create(Addr);
3250 {$IFDEF WITH_REFCOUNT_DEBUG}FAddrObj.DbgRenameReference(@FAddrObj, 'TDbgDwarfArraySymbolValue');{$ENDIF}
3251 end
3252 else begin
3253 FAddrObj.Update(Addr);
3254 end;
3255
3256 if (FLastMember = nil) or (FLastMember.RefCount > 1) then begin
3257 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpValueDwarfArray.FLastMember'){$ENDIF};
3258 FLastMember := TFpValueDwarf(FArraySymbol.TypeInfo.TypeCastValue(FAddrObj));
3259 {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpValueDwarfArray.FLastMember'){$ENDIF};
3260 FLastMember.Context := Context;
3261 if GetStride(Stride) then
3262 TFpValueDwarf(FLastMember).FForcedSize := Stride;
3263 end
3264 else begin
3265 TFpValueDwarf(FLastMember).SetTypeCastInfo(FAddrObj);
3266 end;
3267
3268 Result := FLastMember;
3269 Result.AddReference;
3270 end;
3271
GetMemberCountnull3272 function TFpValueDwarfArray.GetMemberCount: Integer;
3273 begin
3274 Result := 0;
3275 if not (efBoundsDone in FEvalFlags) then
3276 DoGetBounds;
3277 if (efBoundsUnavail in FEvalFlags) then
3278 Exit;
3279 if Abs(FBounds[0][1]-FBounds[0][0]) >= MaxLongint then
3280 Exit(0); // TODO: error
3281 Result := FBounds[0][1]-FBounds[0][0] + 1;
3282 if Result < 0 then
3283 Exit(0); // TODO: error
3284 end;
3285
GetMemberCountExnull3286 function TFpValueDwarfArray.GetMemberCountEx(const AIndex: array of Int64
3287 ): Integer;
3288 var
3289 i: SizeInt;
3290 begin
3291 Result := 0;
3292 if not (efBoundsDone in FEvalFlags) then
3293 DoGetBounds;
3294 if (efBoundsUnavail in FEvalFlags) then
3295 Exit;
3296 i := Length(AIndex);
3297 if i > High(FBounds) then
3298 Exit;
3299 if Abs(FBounds[i][1]-FBounds[i][0]) >= MaxLongint then
3300 Exit(0); // TODO: error
3301 Result := FBounds[i][1]-FBounds[i][0] + 1;
3302 if Result < 0 then
3303 Exit(0); // TODO: error
3304 end;
3305
GetIndexTypenull3306 function TFpValueDwarfArray.GetIndexType(AIndex: Integer): TFpSymbol;
3307 begin
3308 Result := TypeInfo.NestedSymbol[AIndex];
3309 end;
3310
GetIndexTypeCountnull3311 function TFpValueDwarfArray.GetIndexTypeCount: Integer;
3312 begin
3313 Result := TypeInfo.NestedSymbolCount;
3314 end;
3315
IsValidTypeCastnull3316 function TFpValueDwarfArray.IsValidTypeCast: Boolean;
3317 var
3318 f: TFpValueFieldFlags;
3319 SrcSize, TypeSize: TFpDbgValueSize;
3320 begin
3321 Result := HasTypeCastInfo;
3322 If not Result then
3323 exit;
3324
3325 assert(FTypeSymbol.Kind = skArray, 'TFpValueDwarfArray.IsValidTypeCast: FTypeSymbol.Kind = skArray');
3326 //TODO: shortcut, if FTypeSymbol = FTypeCastSourceValue.TypeInfo ?
3327
3328 f := FTypeCastSourceValue.FieldFlags;
3329 if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
3330 exit;
3331
3332 if sfDynArray in FTypeSymbol.Flags then begin
3333 // dyn array
3334 if (svfOrdinal in f)then
3335 exit;
3336 if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) then begin
3337 Result := GetSizeFor(FTypeCastSourceValue, SrcSize);
3338 if not Result then
3339 exit;
3340 if (SrcSize = FTypeSymbol.CompilationUnit.AddressSize) then
3341 exit;
3342 end;
3343 if (f * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) then
3344 exit;
3345 end
3346 else begin
3347 // stat array
3348 if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) then begin
3349 Result := GetSize(TypeSize) and GetSizeFor(FTypeCastSourceValue, SrcSize);
3350 if not Result then
3351 exit;
3352 if (SrcSize = TypeSize) then
3353 exit;
3354 end;
3355 end;
3356 Result := False;
3357 end;
3358
DoGetOrderingnull3359 function TFpValueDwarfArray.DoGetOrdering(out ARowMajor: Boolean): Boolean;
3360 var
3361 ti: TFpSymbolDwarfType;
3362 begin
3363 ti := TypeInfo;
3364 while ti is TFpSymbolDwarfTypeModifierBase do
3365 ti := ti.NestedTypeInfo;
3366 Result := TFpSymbolDwarfTypeArray(ti).DoReadOrdering(Self, ARowMajor);
3367 end;
3368
DoGetStridenull3369 function TFpValueDwarfArray.DoGetStride(out AStride: TFpDbgValueSize): Boolean;
3370 begin
3371 Result := TFpSymbolDwarfType(TypeInfo).DoReadStride(Self, AStride);
3372 end;
3373
DoGetMemberSizenull3374 function TFpValueDwarfArray.DoGetMemberSize(out ASize: TFpDbgValueSize
3375 ): Boolean;
3376 begin
3377 ASize := ZeroSize;
3378 Result := GetStride(ASize);
3379 if (not Result) and (not IsError(LastError)) then begin
3380 Result := TypeInfo.TypeInfo <> nil;
3381 if Result then
3382 TypeInfo.TypeInfo.ReadSize(Self, ASize);
3383 end;
3384 end;
3385
DoGetMainStridenull3386 function TFpValueDwarfArray.DoGetMainStride(out AStride: TFpDbgValueSize
3387 ): Boolean;
3388 var
3389 ExtraStride: TFpDbgValueSize;
3390 begin
3391 Result := GetMemberSize(AStride);
3392 if Result and (not IsError(LastError)) then begin
3393 assert(TypeInfo.NestedSymbolCount > 0, 'TFpValueDwarfArray.DoGetMainStride: TypeInfo.NestedSymbolCount > 0');
3394 Result := TFpSymbolDwarfType(TypeInfo.NestedSymbol[0]).DoReadStride(Self, ExtraStride);
3395 if Result then
3396 AStride := AStride + ExtraStride
3397 else
3398 Result := not IsError(LastError);
3399 end;
3400 end;
3401
DoGetDimStridenull3402 function TFpValueDwarfArray.DoGetDimStride(AnIndex: integer; out
3403 AStride: TFpDbgValueSize): Boolean;
3404 var
3405 ExtraStride: TFpDbgValueSize;
3406 begin
3407 Result := GetMemberSize(AStride);
3408 if Result and (not IsError(LastError)) then begin
3409 assert(TypeInfo.NestedSymbolCount > AnIndex, 'TFpValueDwarfArray.DoGetDimStride(): TypeInfo.NestedSymbolCount > 0');
3410 Result := TFpSymbolDwarfType(TypeInfo.NestedSymbol[AnIndex]).DoReadStride(Self, ExtraStride);
3411 if Result then
3412 AStride := AStride + ExtraStride
3413 else
3414 Result := not IsError(LastError);
3415 end;
3416 end;
3417
3418 constructor TFpValueDwarfArray.Create(ADwarfTypeSymbol: TFpSymbolDwarfType;
3419 AnArraySymbol: TFpSymbolDwarfTypeArray);
3420 begin
3421 FArraySymbol := AnArraySymbol;
3422 inherited Create(ADwarfTypeSymbol);
3423 end;
3424
3425 destructor TFpValueDwarfArray.Destroy;
3426 begin
3427 FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
3428 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpValueDwarfArray.FLastMember'){$ENDIF};
3429 inherited Destroy;
3430 end;
3431
GetOrderingnull3432 function TFpValueDwarfArray.GetOrdering(out ARowMajor: Boolean): Boolean;
3433 begin
3434 Result := not (efRowMajorUnavail in FEvalFlags);
3435 if not Result then // If there was an error, then LastError should still be set
3436 exit;
3437
3438 if not (efRowMajorDone in FEvalFlags) then begin
3439 Result := DoGetOrdering(FRowMajor);
3440 if Result then
3441 Include(FEvalFlags, efRowMajorDone)
3442 else
3443 Include(FEvalFlags, efRowMajorUnavail);
3444 end;
3445
3446 ARowMajor := FRowMajor;
3447 end;
3448
GetStridenull3449 function TFpValueDwarfArray.GetStride(out AStride: TFpDbgValueSize): Boolean;
3450 begin
3451 AStride := ZeroSize;
3452 Result := not (efStrideUnavail in FEvalFlags);
3453 if not Result then // If there was an error, then LastError should still be set
3454 exit;
3455
3456 if not (efStrideDone in FEvalFlags) then begin
3457 Result := DoGetStride(FStride);
3458 if Result then
3459 Include(FEvalFlags, efStrideDone)
3460 else
3461 Include(FEvalFlags, efStrideUnavail);
3462 end;
3463
3464 AStride := FStride;
3465 end;
3466
GetMemberSizenull3467 function TFpValueDwarfArray.GetMemberSize(out ASize: TFpDbgValueSize): Boolean;
3468 begin
3469 Result := not (efMemberSizeUnavail in FEvalFlags);
3470 if not Result then // If there was an error, then LastError should still be set
3471 exit;
3472
3473 if not (efMemberSizeDone in FEvalFlags) then begin
3474 Result := DoGetMemberSize(FMemberSize);
3475 if Result then
3476 Include(FEvalFlags, efMemberSizeDone)
3477 else
3478 Include(FEvalFlags, efMemberSizeUnavail);
3479 end;
3480
3481 ASize := FMemberSize;
3482 end;
3483
GetMainStridenull3484 function TFpValueDwarfArray.GetMainStride(out AStride: TFpDbgValueSize
3485 ): Boolean;
3486 begin
3487 AStride := ZeroSize;
3488 Result := not (efMainStrideUnavail in FEvalFlags);
3489 if not Result then // If there was an error, then LastError should still be set
3490 exit;
3491
3492 if not (efMainStrideDone in FEvalFlags) then begin
3493 Result := DoGetMainStride(FMainStride);
3494 if Result then
3495 Include(FEvalFlags, efMainStrideDone)
3496 else
3497 Include(FEvalFlags, efMainStrideUnavail);
3498 end;
3499
3500 AStride := FMainStride;
3501 end;
3502
GetDimStridenull3503 function TFpValueDwarfArray.GetDimStride(AnIndex: integer; out
3504 AStride: TFpDbgValueSize): Boolean;
3505 begin
3506 AStride := ZeroSize;
3507 Result := AnIndex < MemberCount;
3508 if not Result then
3509 exit;
3510 if AnIndex < Length(FStrides) then
3511 SetLength(FStrides, MemberCount);
3512
3513 Result := not FStrides[AnIndex].Unavail;
3514 if not Result then
3515 exit;
3516 if not FStrides[AnIndex].Done then begin
3517 Result := DoGetDimStride(AnIndex, FStrides[AnIndex].Stride);
3518 FStrides[AnIndex].Done := Result;
3519 FStrides[AnIndex].Unavail := not Result;
3520 end;
3521 AStride := FStrides[AnIndex].Stride;
3522 end;
3523
GetOrdHighBoundnull3524 function TFpValueDwarfArray.GetOrdHighBound: Int64;
3525 begin
3526 if not (efBoundsDone in FEvalFlags) then
3527 DoGetBounds;
3528 if Length(FBounds) > 0 then
3529 Result := FBounds[0][1]
3530 else
3531 Result := Inherited GetOrdLowBound;
3532 end;
3533
GetOrdLowBoundnull3534 function TFpValueDwarfArray.GetOrdLowBound: Int64;
3535 begin
3536 if not (efBoundsDone in FEvalFlags) then
3537 DoGetBounds;
3538 if Length(FBounds) > 0 then
3539 Result := FBounds[0][0]
3540 else
3541 Result := Inherited GetOrdLowBound;
3542 end;
3543
3544 procedure TFpValueDwarfArray.DoGetBounds;
3545 var
3546 t: TFpSymbol;
3547 c: Integer;
3548 i: Integer;
3549 begin
3550 if not (efBoundsDone in FEvalFlags) then begin
3551 Include(FEvalFlags, efBoundsDone);
3552 t := TypeInfo;
3553 c := t.NestedSymbolCount;
3554 if c < 1 then begin
3555 Include(FEvalFlags, efBoundsUnavail);
3556 exit;
3557 end;
3558 SetLength(FBounds, c);
3559 for i := 0 to c -1 do begin
3560 t := t.NestedSymbol[i];
3561 if not t.GetValueBounds(self, FBounds[i][0], FBounds[i][1]) then
3562 Include(FEvalFlags, efBoundsUnavail)
3563 end;
3564 end;
3565 end;
3566
GetHasBoundsnull3567 function TFpValueDwarfArray.GetHasBounds: Boolean;
3568 begin
3569 if not (efBoundsDone in FEvalFlags) then
3570 DoGetBounds;
3571 Result := not (efBoundsUnavail in FEvalFlags)
3572 and (FBounds[0][1]>0); // Empty array has no bounds
3573 end;
3574
3575 { TDbgDwarfIdentifier }
3576
GetNestedTypeInfonull3577 function TFpSymbolDwarf.GetNestedTypeInfo: TFpSymbolDwarfType;
3578 begin
3579 // TODO DW_AT_start_scope;
3580 Result := FNestedTypeInfo;
3581 if (Result <> nil) or (didtTypeRead in FDwarfReadFlags) then
3582 exit;
3583
3584 include(FDwarfReadFlags, didtTypeRead);
3585 FNestedTypeInfo := DoGetNestedTypeInfo;
3586 {$IFDEF WITH_REFCOUNT_DEBUG}if FNestedTypeInfo <> nil then FNestedTypeInfo.DbgRenameReference(@FNestedTypeInfo, ClassName+'.FNestedTypeInfo'){$ENDIF};
3587
3588 Result := FNestedTypeInfo;
3589 end;
3590
GetTypeInfonull3591 function TFpSymbolDwarf.GetTypeInfo: TFpSymbolDwarfType;
3592 begin
3593 assert((inherited TypeInfo = nil) or (inherited TypeInfo is TFpSymbolDwarfType), 'TFpSymbolDwarf.GetTypeInfo: (inherited TypeInfo = nil) or (inherited TypeInfo is TFpSymbolDwarfType)');
3594 Result := TFpSymbolDwarfType(inherited TypeInfo);
3595 end;
3596
3597 procedure TFpSymbolDwarf.SetLocalProcInfo(AValue: TFpSymbolDwarf);
3598 begin
3599 if FLocalProcInfo = AValue then exit;
3600
3601 FLocalProcInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
3602
3603 FLocalProcInfo := AValue;
3604
3605 if (FLocalProcInfo <> nil) then
3606 FLocalProcInfo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
3607 end;
3608
DoGetNestedTypeInfonull3609 function TFpSymbolDwarf.DoGetNestedTypeInfo: TFpSymbolDwarfType;
3610 var
3611 FwdInfoPtr: Pointer;
3612 FwdCompUint: TDwarfCompilationUnit;
3613 InfoEntry: TDwarfInformationEntry;
3614 begin // Do not access anything that may need forwardSymbol
3615 if InformationEntry.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint) then begin
3616 InfoEntry := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
3617 Result := TFpSymbolDwarfType.CreateTypeSubClass('', InfoEntry);
3618 ReleaseRefAndNil(InfoEntry);
3619 end
3620 else
3621 Result := nil;
3622 end;
3623
ReadMemberVisibilitynull3624 function TFpSymbolDwarf.ReadMemberVisibility(out
3625 AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
3626 var
3627 Val: Integer;
3628 begin
3629 Result := InformationEntry.ReadValue(DW_AT_external, Val);
3630 if Result and (Val <> 0) then begin
3631 AMemberVisibility := svPublic;
3632 exit;
3633 end;
3634
3635 Result := InformationEntry.ReadValue(DW_AT_accessibility, Val);
3636 if not Result then exit;
3637 case Val of
3638 DW_ACCESS_private: AMemberVisibility := svPrivate;
3639 DW_ACCESS_protected: AMemberVisibility := svProtected;
3640 DW_ACCESS_public: AMemberVisibility := svPublic;
3641 else AMemberVisibility := svPrivate;
3642 end;
3643 end;
3644
IsArtificialnull3645 function TFpSymbolDwarf.IsArtificial: Boolean;
3646 begin
3647 if not(didtArtificialRead in FDwarfReadFlags) then begin
3648 if InformationEntry.IsArtificial then
3649 Include(FDwarfReadFlags, didtIsArtifical);
3650 Include(FDwarfReadFlags, didtArtificialRead);
3651 end;
3652 Result := didtIsArtifical in FDwarfReadFlags;
3653 end;
3654
3655 procedure TFpSymbolDwarf.NameNeeded;
3656 var
3657 AName: String;
3658 begin
3659 if InformationEntry.ReadName(AName) then
3660 SetName(AName)
3661 else
3662 inherited NameNeeded;
3663 end;
3664
3665 procedure TFpSymbolDwarf.TypeInfoNeeded;
3666 begin
3667 SetTypeInfo(NestedTypeInfo);
3668 end;
3669
DoForwardReadSizenull3670 function TFpSymbolDwarf.DoForwardReadSize(const AValueObj: TFpValue; out
3671 ASize: TFpDbgValueSize): Boolean;
3672 begin
3673 Result := inherited DoReadSize(AValueObj, ASize);
3674 end;
3675
DoReadDataSizenull3676 function TFpSymbolDwarf.DoReadDataSize(const AValueObj: TFpValue; out
3677 ADataSize: TFpDbgValueSize): Boolean;
3678 var
3679 t: TFpSymbolDwarfType;
3680 begin
3681 t := NestedTypeInfo;
3682 if t <> nil then
3683 Result := t.DoReadDataSize(AValueObj, ADataSize)
3684 else
3685 begin
3686 Result := False;
3687 ADataSize := ZeroSize;
3688 end;
3689 end;
3690
InitLocationParsernull3691 function TFpSymbolDwarf.InitLocationParser(const ALocationParser: TDwarfLocationExpression;
3692 AnInitLocParserData: PInitLocParserData): Boolean;
3693 var
3694 ObjDataAddr: TFpDbgMemLocation;
3695 begin
3696 if (AnInitLocParserData <> nil) then begin
3697 ObjDataAddr := AnInitLocParserData^.ObjectDataAddress;
3698 if IsValidLoc(ObjDataAddr) then begin
3699 if ObjDataAddr.MType = mlfConstant then begin
3700 DebugLn(DBG_WARNINGS, 'Changing mlfConstant to mlfConstantDeref'); // TODO: Should be done by caller
3701 ObjDataAddr.MType := mlfConstantDeref;
3702 end;
3703
3704 debugln(FPDBG_DWARF_VERBOSE, ['TFpSymbolDwarf.InitLocationParser CurrentObjectAddress=', dbgs(ObjDataAddr), ' Push=',AnInitLocParserData^.ObjectDataAddrPush]);
3705 ALocationParser.CurrentObjectAddress := ObjDataAddr;
3706 if AnInitLocParserData^.ObjectDataAddrPush then
3707 ALocationParser.Push(ObjDataAddr);
3708 end
3709 else
3710 ALocationParser.CurrentObjectAddress := InvalidLoc
3711 end
3712 else
3713 ALocationParser.CurrentObjectAddress := InvalidLoc;
3714
3715 Result := True;
3716 end;
3717
ComputeDataMemberAddressnull3718 function TFpSymbolDwarf.ComputeDataMemberAddress(
3719 const AnInformationEntry: TDwarfInformationEntry; AValueObj: TFpValueDwarf;
3720 var AnAddress: TFpDbgMemLocation): Boolean;
3721 var
3722 AttrData, AttrDataBitSize, AttrDataBitOffset: TDwarfAttribData;
3723 Form: Cardinal;
3724 ConstOffs: Int64;
3725 InitLocParserData: TInitLocParserData;
3726 ByteSize: TFpDbgValueSize;
3727 BitOffset, BitSize: Int64;
3728 begin
3729 Result := True;
3730 if AnInformationEntry.GetAttribData(DW_AT_data_member_location, AttrData) then begin
3731 Form := AnInformationEntry.AttribForm[AttrData.Idx];
3732 Result := False;
3733
3734 if Form in [DW_FORM_data1, DW_FORM_data2, DW_FORM_sdata, DW_FORM_udata] then begin
3735 if AnInformationEntry.ReadValue(AttrData, ConstOffs) then begin
3736 {$PUSH}{$R-}{$Q-} // TODO: check overflow
3737 AnAddress.Address := AnAddress.Address + ConstOffs;
3738 {$POP}
3739 Result := True;
3740 end
3741 else
3742 SetLastError(AValueObj, CreateError(fpErrAnyError));
3743 end
3744
3745 // TODO: loclistptr: DW_FORM_data4, DW_FORM_data8,
3746 else
3747
3748 if Form in [DW_FORM_block, DW_FORM_block1, DW_FORM_block2, DW_FORM_block4] then begin
3749 InitLocParserData.ObjectDataAddress := AnAddress;
3750 InitLocParserData.ObjectDataAddrPush := True;
3751 Result := LocationFromAttrData(AttrData, AValueObj, AnAddress, @InitLocParserData);
3752 end
3753
3754 else begin
3755 SetLastError(AValueObj, CreateError(fpErrAnyError));
3756 end;
3757
3758 // Bit Offset
3759 if Result and AnInformationEntry.GetAttribData(DW_AT_bit_offset, AttrDataBitOffset) then begin
3760 // Make sure we have ALL the data needed
3761 Result := InformationEntry.GetAttribData(DW_AT_bit_size, AttrDataBitSize);
3762 if Result then
3763 if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin
3764 ByteSize := ZeroSize;
3765 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ByteSize.Size);
3766 end
3767 else
3768 Result := (TypeInfo <> nil) and TypeInfo.ReadSize(AValueObj, ByteSize);
3769
3770 if Result then
3771 Result := ConstRefOrExprFromAttrData(AttrDataBitOffset, AValueObj as TFpValueDwarf, BitOffset) and
3772 ConstRefOrExprFromAttrData(AttrDataBitSize, AValueObj as TFpValueDwarf, BitSize);
3773
3774 if Result then
3775 AnAddress := AddBitOffset(AnAddress + ByteSize, -(BitOffset + BitSize));
3776 end;
3777
3778 if not Result then
3779 SetLastError(AValueObj, CreateError(fpErrAnyError));
3780 exit;
3781 end;
3782
3783 // Dwarf 4
3784 if AnInformationEntry.GetAttribData(DW_AT_data_bit_offset, AttrData) then begin
3785 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, BitOffset);
3786 if Result then
3787 AnAddress := AddBitOffset(AnAddress, BitOffset);
3788
3789 if not Result then
3790 SetLastError(AValueObj, CreateError(fpErrAnyError));
3791 end;
3792
3793 end;
3794
ConstRefOrExprFromAttrDatanull3795 function TFpSymbolDwarf.ConstRefOrExprFromAttrData(
3796 const AnAttribData: TDwarfAttribData; AValueObj: TFpValueDwarf; out
3797 AValue: Int64; AReadState: PFpDwarfAtEntryDataReadState;
3798 ADataSymbol: PFpSymbolDwarfData): Boolean;
3799 var
3800 Form: Cardinal;
3801 FwdInfoPtr: Pointer;
3802 FwdCompUint: TDwarfCompilationUnit;
3803 NewInfo: TDwarfInformationEntry;
3804 RefSymbol: TFpSymbolDwarfData;
3805 InitLocParserData: TInitLocParserData;
3806 t: TFpDbgMemLocation;
3807 ValObj: TFpValue;
3808 begin
3809 Form := InformationEntry.AttribForm[AnAttribData.Idx];
3810 Result := False;
3811
3812 if Form in [DW_FORM_data1, DW_FORM_data2, DW_FORM_data4, DW_FORM_data8,
3813 DW_FORM_sdata, DW_FORM_udata]
3814 then begin
3815 Result := InformationEntry.ReadValue(AnAttribData, AValue);
3816 if Result then begin
3817 if AReadState <> nil then
3818 AReadState^ := rfConst;
3819 end
3820 else begin
3821 if AReadState <> nil then
3822 AReadState^ := rfError;
3823 SetLastError(AValueObj, CreateError(fpErrAnyError));
3824 end;
3825 end
3826
3827 else
3828 if Form in [DW_FORM_ref1, DW_FORM_ref2, DW_FORM_ref4, DW_FORM_ref8,
3829 DW_FORM_ref_addr, DW_FORM_ref_udata]
3830 then begin
3831 if AValueObj = nil then
3832 exit(False); // keep state rfNotRead;
3833
3834 if AReadState <> nil then
3835 AReadState^ := rfValue;
3836
3837 Result := InformationEntry.ReadReference(AnAttribData, FwdInfoPtr, FwdCompUint);
3838 if Result then begin
3839 NewInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
3840 RefSymbol := TFpSymbolDwarfData.CreateValueSubClass('', NewInfo);
3841 NewInfo.ReleaseReference;
3842 Result := RefSymbol <> nil;
3843 if Result then begin
3844 ValObj := RefSymbol.Value;
3845 Result := ValObj <> nil;
3846 if Result then begin
3847 assert(ValObj is TFpValueDwarfBase, 'Result is TFpValueDwarfBase');
3848 TFpValueDwarfBase(ValObj).Context := AValueObj.Context;
3849 AValue := ValObj.AsInteger;
3850 if IsError(ValObj.LastError) then begin
3851 Result := False;
3852 if AReadState <> nil then
3853 AReadState^ := rfError;
3854 SetLastError(AValueObj, ValObj.LastError);
3855 end;
3856 ValObj.ReleaseReference;
3857
3858 if ADataSymbol <> nil then
3859 ADataSymbol^ := RefSymbol
3860 else
3861 RefSymbol.ReleaseReference;
3862 end
3863 else
3864 RefSymbol.ReleaseReference;
3865 end;
3866 end;
3867 if (not Result) and (not HasError(AValueObj)) then begin
3868 if AReadState <> nil then
3869 AReadState^ := rfError;
3870 SetLastError(AValueObj, CreateError(fpErrAnyError));
3871 end;
3872 end
3873
3874 else
3875 if Form in [DW_FORM_block, DW_FORM_block1, DW_FORM_block2, DW_FORM_block4]
3876 then begin
3877 // TODO: until there always will be an AValueObj
3878 if AValueObj = nil then begin
3879 if AReadState <> nil then
3880 AReadState^ := rfNotRead;
3881 exit(False);
3882 end;
3883
3884 if AReadState <> nil then
3885 AReadState^ := rfExpression;
3886
3887 // TODO: (or not todo?) AValueObj may be the pointer (internal ptr to object),
3888 // but since that is the nearest actual variable => what would the LocExpr expect?
3889 // Maybe we need "AddressFor(type) // see TFpSymbolDwarfFreePascalTypePointer.DoReadDataSize
3890 InitLocParserData.ObjectDataAddress := AValueObj.Address;
3891 if not IsValidLoc(InitLocParserData.ObjectDataAddress) then
3892 InitLocParserData.ObjectDataAddress := AValueObj.OrdOrAddress;
3893 InitLocParserData.ObjectDataAddrPush := False;
3894 Result := LocationFromAttrData(AnAttribData, AValueObj, t, @InitLocParserData);
3895 if Result then begin
3896 AValue := Int64(t.Address);
3897 end
3898 else begin
3899 if AReadState <> nil then
3900 AReadState^ := rfError;
3901 SetLastError(AValueObj, CreateError(fpErrLocationParser));
3902 end;
3903 end
3904
3905 else begin
3906 if AReadState <> nil then
3907 AReadState^ := rfError;
3908 SetLastError(AValueObj, CreateError(fpErrAnyError));
3909 end;
3910
3911 if (not Result) and (AReadState <> nil) then
3912 AReadState^ := rfError;
3913 end;
3914
LocationFromAttrDatanull3915 function TFpSymbolDwarf.LocationFromAttrData(
3916 const AnAttribData: TDwarfAttribData; AValueObj: TFpValueDwarf;
3917 var AnAddress: TFpDbgMemLocation; AnInitLocParserData: PInitLocParserData;
3918 AnAdjustAddress: Boolean): Boolean;
3919 var
3920 Val: TByteDynArray;
3921 LocationParser: TDwarfLocationExpression;
3922 begin
3923 //debugln(['TDbgDwarfIdentifier.LocationFromAttrData', ClassName, ' ',Name, ' ', DwarfAttributeToString(ATag)]);
3924
3925 Result := False;
3926 AnAddress := InvalidLoc;
3927
3928 //TODO: avoid copying data
3929 // DW_AT_data_member_location in members [ block or const]
3930 // DW_AT_location [block or reference] todo: const
3931 if not InformationEntry.ReadValue(AnAttribData, Val) then begin
3932 DebugLn([FPDBG_DWARF_VERBOSE, 'LocationFromAttrData: failed to read DW_AT_location']);
3933 SetLastError(AValueObj, CreateError(fpErrAnyError));
3934 exit;
3935 end;
3936
3937 if Length(Val) = 0 then begin
3938 DebugLn(FPDBG_DWARF_VERBOSE, 'LocationFromAttrData: Warning DW_AT_location empty');
3939 SetLastError(AValueObj, CreateError(fpErrAnyError));
3940 //exit;
3941 end;
3942
3943 LocationParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit,
3944 AValueObj.Context);
3945 InitLocationParser(LocationParser, AnInitLocParserData);
3946 LocationParser.Evaluate;
3947
3948 if IsError(LocationParser.LastError) then
3949 SetLastError(AValueObj, LocationParser.LastError);
3950
3951 AnAddress := LocationParser.ResultData;
3952 Result := IsValidLoc(AnAddress);
3953 if IsTargetAddr(AnAddress) and AnAdjustAddress then
3954 AnAddress.Address :=CompilationUnit.MapAddressToNewValue(AnAddress.Address);
3955 debugln(FPDBG_DWARF_VERBOSE and (not Result), ['TDbgDwarfIdentifier.LocationFromAttrDataFAILED']); // TODO
3956
3957 LocationParser.Free;
3958 end;
3959
LocationFromTagnull3960 function TFpSymbolDwarf.LocationFromTag(ATag: Cardinal;
3961 AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation;
3962 AnInitLocParserData: PInitLocParserData; ASucessOnMissingTag: Boolean
3963 ): Boolean;
3964 var
3965 AttrData: TDwarfAttribData;
3966 begin
3967 //debugln(['TDbgDwarfIdentifier.LocationFromTag', ClassName, ' ',Name, ' ', DwarfAttributeToString(ATag)]);
3968
3969 Result := False;
3970 //TODO: avoid copying data
3971 // DW_AT_data_member_location in members [ block or const]
3972 // DW_AT_location [block or reference] todo: const
3973 if not InformationEntry.GetAttribData(ATag, AttrData) then begin
3974 (* if ASucessOnMissingTag = true AND tag does not exist
3975 then AnAddress will NOT be modified
3976 this can be used for DW_AT_data_member_location, if it does not exist members are on input location
3977 TODO: review - better use temp var in caller
3978 *)
3979 Result := ASucessOnMissingTag;
3980 if not Result then
3981 AnAddress := InvalidLoc;
3982 if not Result then
3983 DebugLn([FPDBG_DWARF_VERBOSE, 'LocationFromTag: failed to read DW_AT_..._location / ASucessOnMissingTag=', dbgs(ASucessOnMissingTag)]);
3984 exit;
3985 end;
3986
3987 Result := LocationFromAttrData(AttrData, AValueObj, AnAddress, AnInitLocParserData, ATag = DW_AT_location);
3988 end;
3989
ConstantFromTagnull3990 function TFpSymbolDwarf.ConstantFromTag(ATag: Cardinal; out
3991 AConstData: TByteDynArray; var AnAddress: TFpDbgMemLocation;
3992 AnInformationEntry: TDwarfInformationEntry; ASucessOnMissingTag: Boolean
3993 ): Boolean;
3994 var
3995 v: QWord;
3996 AttrData: TDwarfAttribData;
3997 begin
3998 AConstData := nil;
3999 if InformationEntry.GetAttribData(DW_AT_const_value, AttrData) then
4000 case InformationEntry.AttribForm[AttrData.Idx] of
4001 DW_FORM_string, DW_FORM_strp,
4002 DW_FORM_block, DW_FORM_block1, DW_FORM_block2, DW_FORM_block4: begin
4003 Result := InformationEntry.ReadValue(AttrData, AConstData, True);
4004 if Result then
4005 if Length(AConstData) > 0 then
4006 AnAddress := SelfLoc(@AConstData[0])
4007 else
4008 AnAddress := InvalidLoc; // TODO: ???
4009 end;
4010 DW_FORM_data1, DW_FORM_data2, DW_FORM_data4, DW_FORM_data8, DW_FORM_sdata, DW_FORM_udata: begin
4011 Result := InformationEntry.ReadValue(AttrData, v);
4012 if Result then
4013 AnAddress := ConstLoc(v);
4014 end;
4015 else
4016 Result := False; // ASucessOnMissingTag ?
4017 end
4018 else
4019 Result := ASucessOnMissingTag;
4020 end;
4021
GetDataAddressnull4022 function TFpSymbolDwarf.GetDataAddress(AValueObj: TFpValueDwarf;
4023 var AnAddress: TFpDbgMemLocation; ATargetType: TFpSymbolDwarfType): Boolean;
4024 var
4025 ti: TFpSymbolDwarfType;
4026 AttrData: TDwarfAttribData;
4027 t: Int64;
4028 dummy: Boolean;
4029 begin
4030 Assert(self is TFpSymbolDwarfType);
4031 Result := False;
4032 if InformationEntry.GetAttribData(DW_AT_allocated, AttrData) then begin
4033 if not ConstRefOrExprFromAttrData(AttrData, AValueObj, t) then
4034 exit;
4035 if t = 0 then begin
4036 AnAddress := NilLoc;
4037 exit(True);
4038 end;
4039 end;
4040
4041 if InformationEntry.GetAttribData(DW_AT_associated, AttrData) then begin
4042 if not ConstRefOrExprFromAttrData(AttrData, AValueObj, t) then
4043 exit;
4044 if t = 0 then begin
4045 AnAddress := NilLoc;
4046 exit(True);
4047 end;
4048 end;
4049
4050 Result := GetDataAddressNext(AValueObj, AnAddress, dummy, ATargetType);
4051 if not Result then
4052 exit;
4053
4054 ti := GetNextTypeInfoForDataAddress(ATargetType);
4055 if ti = nil then
4056 exit;
4057
4058 Result := ti.GetDataAddress(AValueObj, AnAddress, ATargetType);
4059 end;
4060
GetNextTypeInfoForDataAddressnull4061 function TFpSymbolDwarf.GetNextTypeInfoForDataAddress(
4062 ATargetType: TFpSymbolDwarfType): TFpSymbolDwarfType;
4063 begin
4064 if (ATargetType = nil) or (ATargetType = self) then
4065 Result := nil
4066 else
4067 Result := NestedTypeInfo;
4068 end;
4069
GetDataAddressNextnull4070 function TFpSymbolDwarf.GetDataAddressNext(AValueObj: TFpValueDwarf;
4071 var AnAddress: TFpDbgMemLocation; out ADoneWork: Boolean;
4072 ATargetType: TFpSymbolDwarfType): Boolean;
4073 var
4074 AttrData: TDwarfAttribData;
4075 InitLocParserData: TInitLocParserData;
4076 begin
4077 Result := True;
4078 ADoneWork := False;
4079
4080 if InformationEntry.GetAttribData(DW_AT_data_location, AttrData) then begin
4081 ADoneWork := True;
4082 InitLocParserData.ObjectDataAddress := AnAddress;
4083 InitLocParserData.ObjectDataAddrPush := False;
4084 Result := LocationFromAttrData(AttrData, AValueObj, AnAddress, @InitLocParserData);
4085 end;
4086 end;
4087
HasAddressnull4088 function TFpSymbolDwarf.HasAddress: Boolean;
4089 begin
4090 Result := False;
4091 end;
4092
GetNestedValuenull4093 function TFpSymbolDwarf.GetNestedValue(AIndex: Int64): TFpValueDwarf;
4094 var
4095 OuterSym: TFpSymbolDwarfType;
4096 sym: TFpSymbol;
4097 begin
4098 sym := GetNestedSymbolEx(AIndex, OuterSym);
4099 if sym <> nil then begin
4100 assert(sym is TFpSymbolDwarfData, 'TFpSymbolDwarf.GetNestedValue: sym is TFpSymbolDwarfData');
4101 Result := TFpValueDwarf(sym.Value);
4102 if Result <> nil then
4103 Result.FParentTypeSymbol := OuterSym;
4104 end
4105 else
4106 Result := nil;
4107 end;
4108
GetNestedValueByNamenull4109 function TFpSymbolDwarf.GetNestedValueByName(const AIndex: String
4110 ): TFpValueDwarf;
4111 var
4112 OuterSym: TFpSymbolDwarfType;
4113 sym: TFpSymbol;
4114 begin
4115 sym := GetNestedSymbolExByName(AIndex, OuterSym);
4116 // Ignore third-party extensions that are not supported
4117 if (sym <> nil) and not (sym is TFpSymbolDwarfThirdPartyExtension) then begin
4118 assert(sym is TFpSymbolDwarfData, 'TFpSymbolDwarf.GetNestedValueByName: sym is TFpSymbolDwarfData');
4119 Result := TFpValueDwarf(sym.Value);
4120 if Result <> nil then
4121 Result.FParentTypeSymbol := OuterSym;
4122 end
4123 else
4124 Result := nil;
4125 end;
4126
GetNestedSymbolExnull4127 function TFpSymbolDwarf.GetNestedSymbolEx(AIndex: Int64; out
4128 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4129 begin
4130 assert(False, 'TFpSymbolDwarf.GetNestedSymbolEx: False not a structuer');
4131 Result := nil;
4132 AnParentTypeSymbol := nil;
4133 end;
4134
GetNestedSymbolExByNamenull4135 function TFpSymbolDwarf.GetNestedSymbolExByName(const AIndex: String; out
4136 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4137 begin
4138 assert(False, 'TFpSymbolDwarf.GetNestedSymbolExByName: False not a structuer');
4139 Result := nil;
4140 AnParentTypeSymbol := nil;
4141 end;
4142
GetNestedSymbolnull4143 function TFpSymbolDwarf.GetNestedSymbol(AIndex: Int64): TFpSymbol;
4144 var
4145 dummy: TFpSymbolDwarfType;
4146 begin
4147 Result := GetNestedSymbolEx(AIndex, dummy);
4148 end;
4149
GetNestedSymbolByNamenull4150 function TFpSymbolDwarf.GetNestedSymbolByName(const AIndex: String): TFpSymbol;
4151 var
4152 dummy: TFpSymbolDwarfType;
4153 begin
4154 Result := GetNestedSymbolExByName(AIndex, dummy);
4155 end;
4156
4157 procedure TFpSymbolDwarf.Init;
4158 begin
4159 //
4160 end;
4161
4162 class function TFpSymbolDwarf.CreateSubClass(const AName: String;
4163 AnInformationEntry: TDwarfInformationEntry): TFpSymbolDwarf;
4164 var
4165 c: TDbgDwarfSymbolBaseClass;
4166 begin
4167 c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag);
4168 Result := TFpSymbolDwarf(c.Create(AName, AnInformationEntry));
4169 end;
4170
4171 destructor TFpSymbolDwarf.Destroy;
4172 begin
4173 inherited Destroy;
4174 FNestedTypeInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FNestedTypeInfo, ClassName+'.FNestedTypeInfo'){$ENDIF};
4175 FLocalProcInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
4176 end;
4177
StartScopenull4178 function TFpSymbolDwarf.StartScope: TDbgPtr;
4179 begin
4180 if not InformationEntry.ReadStartScope(Result) then
4181 Result := 0;
4182 end;
4183
4184 { TFpSymbolDwarfData }
4185
GetValueAddressnull4186 function TFpSymbolDwarfData.GetValueAddress(AValueObj: TFpValueDwarf; out
4187 AnAddress: TFpDbgMemLocation): Boolean;
4188 begin
4189 Result := False;
4190 end;
4191
4192 procedure TFpSymbolDwarfData.KindNeeded;
4193 var
4194 t: TFpSymbol;
4195 begin
4196 t := TypeInfo;
4197 if t = nil then
4198 inherited KindNeeded
4199 else
4200 SetKind(t.Kind);
4201 end;
4202
4203 procedure TFpSymbolDwarfData.MemberVisibilityNeeded;
4204 var
4205 Val: TDbgSymbolMemberVisibility;
4206 begin
4207 if ReadMemberVisibility(Val) then
4208 SetMemberVisibility(Val)
4209 else
4210 if TypeInfo <> nil then
4211 SetMemberVisibility(TypeInfo.MemberVisibility)
4212 else
4213 inherited MemberVisibilityNeeded;
4214 end;
4215
GetNestedSymbolExnull4216 function TFpSymbolDwarfData.GetNestedSymbolEx(AIndex: Int64; out
4217 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4218 begin
4219 AnParentTypeSymbol := TypeInfo;
4220 if AnParentTypeSymbol = nil then begin
4221 Result := inherited GetNestedSymbolEx(AIndex, AnParentTypeSymbol);
4222 exit;
4223 end;
4224
4225 // while holding result, until refcount added, do not call any function
4226 Result := AnParentTypeSymbol.GetNestedSymbolEx(AIndex, AnParentTypeSymbol);
4227 assert((Result = nil) or (Result is TFpSymbolDwarfData), 'TFpSymbolDwarfData.GetMember is Value');
4228 end;
4229
GetNestedSymbolExByNamenull4230 function TFpSymbolDwarfData.GetNestedSymbolExByName(const AIndex: String; out
4231 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4232 begin
4233 AnParentTypeSymbol := TypeInfo;
4234 if AnParentTypeSymbol = nil then begin
4235 Result := inherited GetNestedSymbolExByName(AIndex, AnParentTypeSymbol);
4236 exit;
4237 end;
4238
4239 // while holding result, until refcount added, do not call any function
4240 Result := AnParentTypeSymbol.GetNestedSymbolExByName(AIndex, AnParentTypeSymbol);
4241 assert((Result = nil) or (Result is TFpSymbolDwarfData), 'TFpSymbolDwarfData.GetMember is Value');
4242 end;
4243
GetNestedSymbolCountnull4244 function TFpSymbolDwarfData.GetNestedSymbolCount: Integer;
4245 var
4246 ti: TFpSymbol;
4247 begin
4248 ti := TypeInfo;
4249 if ti <> nil then
4250 Result := ti.NestedSymbolCount
4251 else
4252 Result := inherited GetNestedSymbolCount;
4253 end;
4254
4255 procedure TFpSymbolDwarfData.Init;
4256 begin
4257 inherited Init;
4258 SetSymbolType(stValue);
4259 end;
4260
4261 class function TFpSymbolDwarfData.CreateValueSubClass(const AName: String;
4262 AnInformationEntry: TDwarfInformationEntry): TFpSymbolDwarfData;
4263 var
4264 c: TDbgDwarfSymbolBaseClass;
4265 begin
4266 c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag);
4267
4268 if c.InheritsFrom(TFpSymbolDwarfData) then
4269 Result := TFpSymbolDwarfDataClass(c).Create(AName, AnInformationEntry)
4270 else
4271 Result := nil;
4272 end;
4273
4274 { TFpSymbolDwarfDataWithLocation }
4275
InitLocationParsernull4276 function TFpSymbolDwarfDataWithLocation.InitLocationParser(const ALocationParser: TDwarfLocationExpression;
4277 AnInitLocParserData: PInitLocParserData): Boolean;
4278 begin
4279 Result := inherited InitLocationParser(ALocationParser, AnInitLocParserData);
4280 ALocationParser.OnFrameBaseNeeded := @FrameBaseNeeded;
4281 end;
4282
4283 procedure TFpSymbolDwarfDataWithLocation.FrameBaseNeeded(ASender: TObject);
4284 var
4285 p: TFpSymbolDwarf;
4286 fb: TDBGPtr;
4287 begin
4288 debugln(FPDBG_DWARF_SEARCH, ['TFpSymbolDwarfDataVariable.FrameBaseNeeded ']);
4289 p := LocalProcInfo;
4290 // TODO: what if parent is declaration?
4291 if p is TFpSymbolDwarfDataProc then begin
4292 fb := TFpSymbolDwarfDataProc(p).GetFrameBase(ASender as TDwarfLocationExpression);
4293 (ASender as TDwarfLocationExpression).FrameBase := fb;
4294 if fb = 0 then begin
4295 debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataWithLocation.FrameBaseNeeded result is 0']);
4296 end;
4297 exit;
4298 end;
4299
4300 {$warning TODO}
4301 //else
4302 //if ParentTypeInfo <> nil then
4303 // ParentTypeInfo.fr;
4304 // TODO: check owner
4305 debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataWithLocation.FrameBaseNeeded no parent type info']);
4306 (ASender as TDwarfLocationExpression).FrameBase := 0;
4307 end;
4308
GetValueObjectnull4309 function TFpSymbolDwarfDataWithLocation.GetValueObject: TFpValue;
4310 var
4311 ti: TFpSymbol;
4312 begin
4313 Result := nil;
4314 ti := TypeInfo;
4315 if (ti = nil) or not (ti.SymbolType = stType) then exit;
4316
4317 Result := TFpSymbolDwarfType(ti).GetTypedValueObject(False);
4318 if Result <> nil then
4319 TFpValueDwarf(Result).SetDataSymbol(self);
4320 end;
4321
4322 { TFpSymbolDwarfType }
4323
4324 procedure TFpSymbolDwarfType.Init;
4325 begin
4326 inherited Init;
4327 SetSymbolType(stType);
4328 end;
4329
4330 procedure TFpSymbolDwarfType.MemberVisibilityNeeded;
4331 var
4332 Val: TDbgSymbolMemberVisibility;
4333 begin
4334 if ReadMemberVisibility(Val) then
4335 SetMemberVisibility(Val)
4336 else
4337 inherited MemberVisibilityNeeded;
4338 end;
4339
DoReadSizenull4340 function TFpSymbolDwarfType.DoReadSize(const AValueObj: TFpValue; out
4341 ASize: TFpDbgValueSize): Boolean;
4342 var
4343 AttrData: TDwarfAttribData;
4344 Bits: Int64;
4345 begin
4346 ASize := ZeroSize;
4347 Result := False;
4348
4349 if InformationEntry.GetAttribData(DW_AT_bit_size, AttrData) then begin
4350 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, Bits);
4351 if not Result then
4352 exit;
4353 ASize := SizeFromBits(Bits);
4354 exit;
4355 end;
4356
4357 if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin
4358 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ASize.Size);
4359 if not Result then
4360 exit;
4361 end;
4362
4363 // If it does not have a size => No error
4364 end;
4365
DoReadStridenull4366 function TFpSymbolDwarfType.DoReadStride(AValueObj: TFpValueDwarf; out
4367 AStride: TFpDbgValueSize): Boolean;
4368 var
4369 BitStride: Int64;
4370 AttrData: TDwarfAttribData;
4371 begin
4372 AStride := ZeroSize;
4373 Result := False;
4374 if InformationEntry.GetAttribData(DW_AT_bit_stride, AttrData) then begin
4375 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, BitStride);
4376 AStride := SizeFromBits(BitStride);
4377 exit;
4378 end;
4379
4380 if InformationEntry.GetAttribData(DW_AT_byte_stride, AttrData) then begin
4381 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, AStride.Size);
4382 exit;
4383 end;
4384 end;
4385
GetTypedValueObjectnull4386 function TFpSymbolDwarfType.GetTypedValueObject(ATypeCast: Boolean;
4387 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
4388 begin
4389 if AnOuterType = nil then
4390 AnOuterType := Self;
4391 Result := TFpValueDwarfUnknown.Create(AnOuterType);
4392 end;
4393
4394 procedure TFpSymbolDwarfType.ResetValueBounds;
4395 var
4396 ti: TFpSymbolDwarfType;
4397 begin
4398 ti := NestedTypeInfo;
4399 if (ti <> nil) then
4400 ti.ResetValueBounds;
4401 end;
4402
ReadStridenull4403 function TFpSymbolDwarfType.ReadStride(AValueObj: TFpValueDwarf; out
4404 AStride: TFpDbgValueSize): Boolean;
4405 begin
4406 Result := DoReadStride(AValueObj, AStride);
4407 end;
4408
4409 class function TFpSymbolDwarfType.CreateTypeSubClass(const AName: String;
4410 AnInformationEntry: TDwarfInformationEntry): TFpSymbolDwarfType;
4411 var
4412 c: TDbgDwarfSymbolBaseClass;
4413 begin
4414 c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag);
4415
4416 if c.InheritsFrom(TFpSymbolDwarfType) then
4417 Result := TFpSymbolDwarfTypeClass(c).Create(AName, AnInformationEntry)
4418 else
4419 Result := nil;
4420 end;
4421
TypeCastValuenull4422 function TFpSymbolDwarfType.TypeCastValue(AValue: TFpValue): TFpValue;
4423 begin
4424 Result := GetTypedValueObject(True);
4425 If Result = nil then
4426 exit;
4427 assert(Result is TFpValueDwarf);
4428 if not TFpValueDwarf(Result).SetTypeCastInfo(AValue) then
4429 ReleaseRefAndNil(Result);
4430 end;
4431
4432 { TDbgDwarfBaseTypeIdentifier }
4433
4434 procedure TFpSymbolDwarfTypeBasic.KindNeeded;
4435 var
4436 Encoding: Integer;
4437 begin
4438 if not InformationEntry.ReadValue(DW_AT_encoding, Encoding) then begin
4439 DebugLn(FPDBG_DWARF_WARNINGS, ['TFpSymbolDwarfTypeBasic.KindNeeded: Failed reading encoding for ', DwarfTagToString(InformationEntry.AbbrevTag)]);
4440 inherited KindNeeded;
4441 exit;
4442 end;
4443
4444 case Encoding of
4445 DW_ATE_address : SetKind(skPointer);
4446 DW_ATE_boolean: SetKind(skBoolean);
4447 //DW_ATE_complex_float:
4448 DW_ATE_float: SetKind(skFloat);
4449 DW_ATE_signed: SetKind(skInteger);
4450 DW_ATE_signed_char: SetKind(skChar);
4451 DW_ATE_unsigned: SetKind(skCardinal);
4452 DW_ATE_unsigned_char: SetKind(skChar);
4453 DW_ATE_numeric_string:SetKind(skChar); // temporary for widestring
4454 else
4455 begin
4456 DebugLn(FPDBG_DWARF_WARNINGS, ['TFpSymbolDwarfTypeBasic.KindNeeded: Unknown encoding ', DwarfBaseTypeEncodingToString(Encoding), ' for ', DwarfTagToString(InformationEntry.AbbrevTag)]);
4457 inherited KindNeeded;
4458 end;
4459 end;
4460 end;
4461
4462 procedure TFpSymbolDwarfTypeBasic.TypeInfoNeeded;
4463 begin
4464 SetTypeInfo(nil);
4465 end;
4466
GetTypedValueObjectnull4467 function TFpSymbolDwarfTypeBasic.GetTypedValueObject(ATypeCast: Boolean;
4468 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
4469 begin
4470 if AnOuterType = nil then
4471 AnOuterType := Self;
4472 case Kind of
4473 skPointer: Result := TFpValueDwarfPointer.Create(AnOuterType);
4474 skInteger: Result := TFpValueDwarfInteger.Create(AnOuterType);
4475 skCardinal: Result := TFpValueDwarfCardinal.Create(AnOuterType);
4476 skBoolean: Result := TFpValueDwarfBoolean.Create(AnOuterType);
4477 skChar: Result := TFpValueDwarfChar.Create(AnOuterType);
4478 skFloat: Result := TFpValueDwarfFloat.Create(AnOuterType);
4479 end;
4480 end;
4481
GetValueBoundsnull4482 function TFpSymbolDwarfTypeBasic.GetValueBounds(AValueObj: TFpValue; out
4483 ALowBound, AHighBound: Int64): Boolean;
4484 begin
4485 Result := GetValueLowBound(AValueObj, ALowBound); // TODO: ond GetValueHighBound() // but all callers must check result;
4486 if not GetValueHighBound(AValueObj, AHighBound) then
4487 Result := False;
4488 end;
4489
GetValueLowBoundnull4490 function TFpSymbolDwarfTypeBasic.GetValueLowBound(AValueObj: TFpValue; out
4491 ALowBound: Int64): Boolean;
4492 var
4493 Size: TFpDbgValueSize;
4494 begin
4495 Result := AValueObj.GetSize(Size);
4496 if not Result then
4497 exit;
4498 case Kind of
4499 skInteger: ALowBound := -(int64( high(int64) shr (64 - Min(Size.Size, 8) * 8)))-1;
4500 skCardinal: ALowBound := 0;
4501 else
4502 Result := False;
4503 end;
4504 end;
4505
GetValueHighBoundnull4506 function TFpSymbolDwarfTypeBasic.GetValueHighBound(AValueObj: TFpValue; out
4507 AHighBound: Int64): Boolean;
4508 var
4509 Size: TFpDbgValueSize;
4510 begin
4511 Result := AValueObj.GetSize(Size);
4512 if not Result then
4513 exit;
4514 case Kind of
4515 skInteger: AHighBound := int64( high(int64) shr (64 - Min(Size.Size, 8) * 8));
4516 skCardinal: AHighBound := int64( high(qword) shr (64 - Min(Size.Size, 8) * 8));
4517 else
4518 Result := False;
4519 end;
4520 end;
4521
4522 { TFpSymbolDwarfTypeModifierBase }
4523
GetNestedSymbolExnull4524 function TFpSymbolDwarfTypeModifierBase.GetNestedSymbolEx(AIndex: Int64; out
4525 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4526 var
4527 p: TFpSymbol;
4528 begin
4529 p := GetForwardToSymbol;
4530 if p <> nil then
4531 Result := TFpSymbolDwarfType(p).GetNestedSymbolEx(AIndex, AnParentTypeSymbol)
4532 else
4533 Result := nil; // Result := inherited GetMember(AIndex);
4534 end;
4535
GetNestedSymbolExByNamenull4536 function TFpSymbolDwarfTypeModifierBase.GetNestedSymbolExByName(
4537 const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4538 var
4539 p: TFpSymbol;
4540 begin
4541 p := GetForwardToSymbol;
4542 if p <> nil then
4543 Result := TFpSymbolDwarfType(p).GetNestedSymbolExByName(AIndex, AnParentTypeSymbol)
4544 else
4545 Result := nil; // Result := inherited GetMember(AIndex);
4546 end;
4547
GetNestedSymbolnull4548 function TFpSymbolDwarfTypeModifierBase.GetNestedSymbol(AIndex: Int64): TFpSymbol;
4549 var
4550 p: TFpSymbol;
4551 begin
4552 p := GetForwardToSymbol;
4553 if p <> nil then
4554 Result := p.NestedSymbol[AIndex]
4555 else
4556 Result := nil; // Result := inherited GetMember(AIndex);
4557 end;
4558
GetNestedSymbolByNamenull4559 function TFpSymbolDwarfTypeModifierBase.GetNestedSymbolByName(
4560 const AIndex: String): TFpSymbol;
4561 var
4562 p: TFpSymbol;
4563 begin
4564 p := GetForwardToSymbol;
4565 if p <> nil then
4566 Result := p.NestedSymbolByName[AIndex]
4567 else
4568 Result := nil; // Result := inherited GetMemberByName(AIndex);
4569 end;
4570
4571 { TFpSymbolDwarfTypeModifier }
4572
4573 procedure TFpSymbolDwarfTypeModifier.TypeInfoNeeded;
4574 var
4575 p: TFpSymbolDwarfType;
4576 begin
4577 p := NestedTypeInfo;
4578 if p <> nil then
4579 SetTypeInfo(p.TypeInfo)
4580 else
4581 SetTypeInfo(nil);
4582 end;
4583
4584 procedure TFpSymbolDwarfTypeModifier.ForwardToSymbolNeeded;
4585 begin
4586 SetForwardToSymbol(NestedTypeInfo);
4587 end;
4588
DoReadSizenull4589 function TFpSymbolDwarfTypeModifier.DoReadSize(const AValueObj: TFpValue; out
4590 ASize: TFpDbgValueSize): Boolean;
4591 begin
4592 Result := inherited DoForwardReadSize(AValueObj, ASize);
4593 end;
4594
DoReadStridenull4595 function TFpSymbolDwarfTypeModifier.DoReadStride(AValueObj: TFpValueDwarf; out
4596 AStride: TFpDbgValueSize): Boolean;
4597 var
4598 p: TFpSymbol;
4599 begin
4600 p := GetForwardToSymbol;
4601 if p <> nil then
4602 Result := TFpSymbolDwarfType(p).DoReadStride(AValueObj, AStride)
4603 else
4604 Result := inherited DoReadStride(AValueObj, AStride);
4605 end;
4606
GetNextTypeInfoForDataAddressnull4607 function TFpSymbolDwarfTypeModifier.GetNextTypeInfoForDataAddress(
4608 ATargetType: TFpSymbolDwarfType): TFpSymbolDwarfType;
4609 begin
4610 if (ATargetType = self) then
4611 Result := nil
4612 else
4613 Result := NestedTypeInfo;
4614 end;
4615
GetTypedValueObjectnull4616 function TFpSymbolDwarfTypeModifier.GetTypedValueObject(ATypeCast: Boolean;
4617 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
4618 var
4619 ti: TFpSymbolDwarfType;
4620 begin
4621 if AnOuterType = nil then
4622 AnOuterType := Self;
4623 ti := NestedTypeInfo;
4624 if ti <> nil then
4625 Result := ti.GetTypedValueObject(ATypeCast, AnOuterType)
4626 else
4627 Result := inherited;
4628 end;
4629
4630 { TFpSymbolDwarfTypeRef }
4631
GetFlagsnull4632 function TFpSymbolDwarfTypeRef.GetFlags: TDbgSymbolFlags;
4633 begin
4634 Result := (inherited GetFlags) + [sfInternalRef];
4635 end;
4636
GetDataAddressNextnull4637 function TFpSymbolDwarfTypeRef.GetDataAddressNext(AValueObj: TFpValueDwarf;
4638 var AnAddress: TFpDbgMemLocation; out ADoneWork: Boolean;
4639 ATargetType: TFpSymbolDwarfType): Boolean;
4640 begin
4641 Result := inherited GetDataAddressNext(AValueObj, AnAddress, ADoneWork, ATargetType);
4642 if (not Result) or ADoneWork then
4643 exit;
4644
4645 Result := AValueObj.MemManager <> nil;
4646 if not Result then begin
4647 SetLastError(AValueObj, CreateError(fpErrAnyError));
4648 exit;
4649 end;
4650 AnAddress := AValueObj.Context.ReadAddress(AnAddress, SizeVal(CompilationUnit.AddressSize));
4651 Result := IsValidLoc(AnAddress);
4652
4653 if (not Result) and
4654 IsError(AValueObj.Context.LastMemError)
4655 then
4656 SetLastError(AValueObj, AValueObj.Context.LastMemError);
4657 // Todo: other error
4658 end;
4659
4660 { TFpSymbolDwarfTypeSubRange }
4661
4662 procedure TFpSymbolDwarfTypeSubRange.InitEnumIdx;
4663 var
4664 t: TFpSymbolDwarfType;
4665 i: Integer;
4666 h, l: Int64;
4667 begin
4668 if FEnumIdxValid then
4669 exit;
4670 FEnumIdxValid := True;
4671
4672 t := NestedTypeInfo;
4673 i := t.NestedSymbolCount - 1;
4674 GetValueBounds(nil, l, h);
4675
4676 while (i >= 0) and (t.NestedSymbol[i].OrdinalValue > h) do
4677 dec(i);
4678 FHighEnumIdx := i;
4679
4680 while (i >= 0) and (t.NestedSymbol[i].OrdinalValue >= l) do
4681 dec(i);
4682 FLowEnumIdx := i + 1;
4683 end;
4684
DoGetNestedTypeInfonull4685 function TFpSymbolDwarfTypeSubRange.DoGetNestedTypeInfo: TFpSymbolDwarfType;
4686 begin
4687 Result := inherited DoGetNestedTypeInfo;
4688 if Result <> nil then
4689 exit;
4690
4691 if FLowBoundState = rfValue then
4692 Result := FLowBoundSymbol.TypeInfo as TFpSymbolDwarfType
4693 else
4694 if FHighBoundState = rfValue then
4695 Result := FHighBoundSymbol.TypeInfo as TFpSymbolDwarfType
4696 else
4697 if FCountState = rfValue then
4698 Result := FCountSymbol.TypeInfo as TFpSymbolDwarfType;
4699 end;
4700
4701 procedure TFpSymbolDwarfTypeSubRange.ForwardToSymbolNeeded;
4702 begin
4703 SetForwardToSymbol(NestedTypeInfo);
4704 end;
4705
4706 procedure TFpSymbolDwarfTypeSubRange.TypeInfoNeeded;
4707 var
4708 p: TFpSymbolDwarfType;
4709 begin
4710 p := NestedTypeInfo;
4711 if p <> nil then
4712 SetTypeInfo(p.TypeInfo)
4713 else
4714 SetTypeInfo(nil);
4715 end;
4716
4717 procedure TFpSymbolDwarfTypeSubRange.NameNeeded;
4718 var
4719 AName: String;
4720 begin
4721 if InformationEntry.ReadName(AName) then
4722 SetName(AName)
4723 else
4724 SetName('');
4725 end;
4726
4727 procedure TFpSymbolDwarfTypeSubRange.KindNeeded;
4728 var
4729 t: TFpSymbol;
4730 begin
4731 // TODO: limit to ordinal types
4732 t := NestedTypeInfo;
4733 if t = nil then begin
4734 SetKind(skInteger);
4735 end
4736 else
4737 SetKind(t.Kind);
4738 end;
4739
DoReadSizenull4740 function TFpSymbolDwarfTypeSubRange.DoReadSize(const AValueObj: TFpValue; out
4741 ASize: TFpDbgValueSize): Boolean;
4742 var
4743 t: TFpSymbolDwarfType;
4744 begin
4745 Result := inherited DoReadSize(AValueObj, ASize);
4746 if Result or HasError(AValueObj) then
4747 exit;
4748
4749 t := NestedTypeInfo;
4750 if t = nil then begin
4751 Result := False;
4752 exit;
4753 end;
4754
4755 Result := t.ReadSize(AValueObj, ASize);
4756 end;
4757
GetNestedSymbolExnull4758 function TFpSymbolDwarfTypeSubRange.GetNestedSymbolEx(AIndex: Int64; out
4759 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4760 begin
4761 if Kind = skEnum then begin
4762 if not FEnumIdxValid then
4763 InitEnumIdx;
4764 Result := TFpSymbolDwarfType(NestedTypeInfo).GetNestedSymbolEx(AIndex - FLowEnumIdx, AnParentTypeSymbol);
4765 end
4766 else
4767 Result := inherited GetNestedSymbolEx(AIndex, AnParentTypeSymbol);
4768 end;
4769
GetNestedSymbolCountnull4770 function TFpSymbolDwarfTypeSubRange.GetNestedSymbolCount: Integer;
4771 begin
4772 if Kind = skEnum then begin
4773 if not FEnumIdxValid then
4774 InitEnumIdx;
4775 Result := FHighEnumIdx - FLowEnumIdx + 1;
4776 end
4777 else
4778 Result := inherited GetNestedSymbolCount;
4779 end;
4780
GetFlagsnull4781 function TFpSymbolDwarfTypeSubRange.GetFlags: TDbgSymbolFlags;
4782 begin
4783 Result := (inherited GetFlags) + [sfSubRange];
4784 end;
4785
4786 procedure TFpSymbolDwarfTypeSubRange.ResetValueBounds;
4787 begin
4788 inherited ResetValueBounds;
4789 FLowBoundState := rfNotRead;
4790 FHighBoundState := rfNotRead;
4791 FCountState := rfNotRead;
4792 end;
4793
4794 destructor TFpSymbolDwarfTypeSubRange.Destroy;
4795 begin
4796 FLowBoundSymbol.ReleaseReference;
4797 FHighBoundSymbol.ReleaseReference;
4798 FCountSymbol.ReleaseReference;
4799 inherited Destroy;
4800 end;
4801
GetTypedValueObjectnull4802 function TFpSymbolDwarfTypeSubRange.GetTypedValueObject(ATypeCast: Boolean;
4803 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
4804 var
4805 ti: TFpSymbolDwarfType;
4806 begin
4807 if AnOuterType = nil then
4808 AnOuterType := Self;
4809 ti := NestedTypeInfo;
4810 if ti <> nil then
4811 Result := ti.GetTypedValueObject(ATypeCast, AnOuterType)
4812 else
4813 Result := inherited;
4814 end;
4815
GetValueBoundsnull4816 function TFpSymbolDwarfTypeSubRange.GetValueBounds(AValueObj: TFpValue; out
4817 ALowBound, AHighBound: Int64): Boolean;
4818 begin
4819 Result := GetValueLowBound(AValueObj, ALowBound); // TODO: ond GetValueHighBound() // but all callers must check result;
4820 if not GetValueHighBound(AValueObj, AHighBound) then
4821 Result := False;
4822 end;
4823
GetValueLowBoundnull4824 function TFpSymbolDwarfTypeSubRange.GetValueLowBound(AValueObj: TFpValue;
4825 out ALowBound: Int64): Boolean;
4826 var
4827 AttrData: TDwarfAttribData;
4828 t: Int64;
4829 begin
4830 assert((AValueObj = nil) or (AValueObj is TFpValueDwarf), 'TFpSymbolDwarfTypeSubRange.GetValueLowBound: AValueObj is TFpValueDwarf(');
4831 if FLowBoundState = rfNotRead then begin
4832 if InformationEntry.GetAttribData(DW_AT_lower_bound, AttrData) then
4833 ConstRefOrExprFromAttrData(AttrData, TFpValueDwarf(AValueObj), t, @FLowBoundState, @FLowBoundSymbol)
4834 else
4835 FLowBoundState := rfNotFound;
4836 FLowBoundConst := t;
4837 end;
4838
4839 Result := FLowBoundState in [rfConst, rfValue, rfExpression];
4840 ALowBound := FLowBoundConst;
4841 end;
4842
GetValueHighBoundnull4843 function TFpSymbolDwarfTypeSubRange.GetValueHighBound(AValueObj: TFpValue;
4844 out AHighBound: Int64): Boolean;
4845 var
4846 AttrData: TDwarfAttribData;
4847 t: int64;
4848 begin
4849 assert((AValueObj = nil) or (AValueObj is TFpValueDwarf), 'TFpSymbolDwarfTypeSubRange.GetValueHighBound: AValueObj is TFpValueDwarf(');
4850 if FHighBoundState = rfNotRead then begin
4851 if InformationEntry.GetAttribData(DW_AT_upper_bound, AttrData) then
4852 ConstRefOrExprFromAttrData(AttrData, TFpValueDwarf(AValueObj), t, @FHighBoundState, @FHighBoundSymbol)
4853 else
4854 FHighBoundState := rfNotFound;
4855 FHighBoundConst := t;
4856 end;
4857
4858 Result := FHighBoundState in [rfConst, rfValue, rfExpression];
4859 AHighBound := FHighBoundConst;
4860
4861 if FHighBoundState = rfNotFound then begin
4862 Result := GetValueLowBound(AValueObj, AHighBound);
4863 if Result then begin
4864 if FCountState = rfNotRead then begin
4865 if InformationEntry.GetAttribData(DW_AT_upper_bound, AttrData) then
4866 ConstRefOrExprFromAttrData(AttrData, TFpValueDwarf(AValueObj), t, @FCountState, @FCountSymbol)
4867 else
4868 FCountState := rfNotFound;
4869 FCountConst := t;
4870 end;
4871
4872 Result := FCountState in [rfConst, rfValue, rfExpression];
4873 {$PUSH}{$R-}{$Q-}
4874 AHighBound := AHighBound + FCountConst;
4875 {$POP}
4876 end;
4877 end;
4878 end;
4879
4880 procedure TFpSymbolDwarfTypeSubRange.Init;
4881 begin
4882 FLowBoundState := rfNotRead;
4883 FHighBoundState := rfNotRead;
4884 FCountState := rfNotRead;
4885 inherited Init;
4886 end;
4887
4888 { TFpSymbolDwarfTypePointer }
4889
4890 procedure TFpSymbolDwarfTypePointer.KindNeeded;
4891 begin
4892 SetKind(skPointer);
4893 end;
4894
DoReadSizenull4895 function TFpSymbolDwarfTypePointer.DoReadSize(const AValueObj: TFpValue; out
4896 ASize: TFpDbgValueSize): Boolean;
4897 begin
4898 ASize := ZeroSize;
4899 ASize.Size := CompilationUnit.AddressSize;
4900 Result := True;
4901 end;
4902
GetTypedValueObjectnull4903 function TFpSymbolDwarfTypePointer.GetTypedValueObject(ATypeCast: Boolean;
4904 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
4905 begin
4906 if AnOuterType = nil then
4907 AnOuterType := Self;
4908 Result := TFpValueDwarfPointer.Create(AnOuterType);
4909 end;
4910
4911 { TFpSymbolDwarfTypeSubroutine }
4912
4913 procedure TFpSymbolDwarfTypeSubroutine.CreateMembers;
4914 var
4915 Info: TDwarfInformationEntry;
4916 Info2: TDwarfInformationEntry;
4917 begin
4918 if FProcMembers <> nil then
4919 exit;
4920 FProcMembers := TRefCntObjList.Create;
4921 Info := InformationEntry.Clone;
4922 Info.GoChild;
4923
4924 while Info.HasValidScope do begin
4925 if ((Info.AbbrevTag = DW_TAG_formal_parameter) or (Info.AbbrevTag = DW_TAG_variable)) //and
4926 //not(Info.IsArtificial)
4927 then begin
4928 Info2 := Info.Clone;
4929 FProcMembers.Add(Info2);
4930 Info2.ReleaseReference;
4931 end;
4932 Info.GoNext;
4933 end;
4934
4935 Info.ReleaseReference;
4936 end;
4937
GetNestedSymbolExnull4938 function TFpSymbolDwarfTypeSubroutine.GetNestedSymbolEx(AIndex: Int64; out
4939 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4940 begin
4941 CreateMembers;
4942 AnParentTypeSymbol := Self;
4943 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember'){$ENDIF};
4944 FLastMember := TFpSymbolDwarf.CreateSubClass('', TDwarfInformationEntry(FProcMembers[AIndex]));
4945 {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember');{$ENDIF}
4946 Result := FLastMember;
4947 end;
4948
GetNestedSymbolExByNamenull4949 function TFpSymbolDwarfTypeSubroutine.GetNestedSymbolExByName(const AIndex: String;
4950 out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
4951 var
4952 Info: TDwarfInformationEntry;
4953 s: String;
4954 i: Integer;
4955 begin
4956 CreateMembers;
4957 AnParentTypeSymbol := Self;
4958 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember'){$ENDIF};
4959 FLastMember := nil;
4960 for i := 0 to FProcMembers.Count - 1 do begin
4961 Info := TDwarfInformationEntry(FProcMembers[i]);
4962 if Info.ReadName(s) and (CompareText(s, AIndex) = 0) then begin
4963 FLastMember := TFpSymbolDwarf.CreateSubClass('', Info);
4964 {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember');{$ENDIF}
4965 break;
4966 end;
4967 end;
4968 Result := FLastMember;
4969 end;
4970
GetNestedSymbolCountnull4971 function TFpSymbolDwarfTypeSubroutine.GetNestedSymbolCount: Integer;
4972 begin
4973 CreateMembers;
4974 Result := FProcMembers.Count;
4975 end;
4976
GetTypedValueObjectnull4977 function TFpSymbolDwarfTypeSubroutine.GetTypedValueObject(ATypeCast: Boolean;
4978 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
4979 begin
4980 if AnOuterType = nil then
4981 AnOuterType := Self;
4982 Result := TFpValueDwarfSubroutine.Create(AnOuterType);
4983 end;
4984
GetDataAddressNextnull4985 function TFpSymbolDwarfTypeSubroutine.GetDataAddressNext(
4986 AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation; out
4987 ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean;
4988 begin
4989 Result := inherited GetDataAddressNext(AValueObj, AnAddress, ADoneWork, ATargetType);
4990 if (not Result) or ADoneWork then
4991 exit;
4992
4993 Result := AValueObj.MemManager <> nil;
4994 if not Result then begin
4995 SetLastError(AValueObj, CreateError(fpErrAnyError));
4996 exit;
4997 end;
4998 AnAddress := AValueObj.Context.ReadAddress(AnAddress, SizeVal(CompilationUnit.AddressSize));
4999 Result := IsValidLoc(AnAddress);
5000
5001 if not Result then
5002 if IsError(AValueObj.Context.LastMemError) then
5003 SetLastError(AValueObj, AValueObj.Context.LastMemError);
5004 // Todo: other error
5005 end;
5006
5007 procedure TFpSymbolDwarfTypeSubroutine.KindNeeded;
5008 begin
5009 if TypeInfo <> nil then
5010 SetKind(skFunctionRef)
5011 else
5012 SetKind(skProcedureRef);
5013 end;
5014
DoReadSizenull5015 function TFpSymbolDwarfTypeSubroutine.DoReadSize(const AValueObj: TFpValue; out
5016 ASize: TFpDbgValueSize): Boolean;
5017 begin
5018 ASize := ZeroSize;
5019 ASize.Size := CompilationUnit.AddressSize;
5020 Result := True;
5021 end;
5022
5023 destructor TFpSymbolDwarfTypeSubroutine.Destroy;
5024 begin
5025 FreeAndNil(FProcMembers);
5026 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember'){$ENDIF};
5027 inherited Destroy;
5028 end;
5029
5030 { TDbgDwarfIdentifierEnumElement }
5031
5032 procedure TFpSymbolDwarfDataEnumMember.ReadOrdinalValue;
5033 begin
5034 if FOrdinalValueRead then exit;
5035 FOrdinalValueRead := True;
5036 FHasOrdinalValue := InformationEntry.ReadValue(DW_AT_const_value, FOrdinalValue);
5037 end;
5038
5039 procedure TFpSymbolDwarfDataEnumMember.KindNeeded;
5040 begin
5041 SetKind(skEnumValue);
5042 end;
5043
GetHasOrdinalValuenull5044 function TFpSymbolDwarfDataEnumMember.GetHasOrdinalValue: Boolean;
5045 begin
5046 ReadOrdinalValue;
5047 Result := FHasOrdinalValue;
5048 end;
5049
GetOrdinalValuenull5050 function TFpSymbolDwarfDataEnumMember.GetOrdinalValue: Int64;
5051 begin
5052 ReadOrdinalValue;
5053 Result := FOrdinalValue;
5054 end;
5055
5056 procedure TFpSymbolDwarfDataEnumMember.Init;
5057 begin
5058 FOrdinalValueRead := False;
5059 inherited Init;
5060 end;
5061
GetValueObjectnull5062 function TFpSymbolDwarfDataEnumMember.GetValueObject: TFpValue;
5063 begin
5064 Result := TFpValueDwarfEnumMember.Create(Self);
5065 TFpValueDwarf(Result).SetDataSymbol(self);
5066 end;
5067
5068 { TFpSymbolDwarfTypeEnum }
5069
5070 procedure TFpSymbolDwarfTypeEnum.CreateMembers;
5071 var
5072 Info, Info2: TDwarfInformationEntry;
5073 sym: TFpSymbolDwarf;
5074 begin
5075 if FMembers <> nil then
5076 exit;
5077 FMembers := TRefCntObjList.Create;
5078 Info := InformationEntry.FirstChild;
5079 if Info = nil then exit;
5080
5081 while Info.HasValidScope do begin
5082 if (Info.AbbrevTag = DW_TAG_enumerator) then begin
5083 Info2 := Info.Clone;
5084 sym := TFpSymbolDwarf.CreateSubClass('', Info2);
5085 FMembers.Add(sym);
5086 sym.ReleaseReference;
5087 Info2.ReleaseReference;
5088 end;
5089 Info.GoNext;
5090 end;
5091
5092 Info.ReleaseReference;
5093 end;
5094
GetTypedValueObjectnull5095 function TFpSymbolDwarfTypeEnum.GetTypedValueObject(ATypeCast: Boolean;
5096 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
5097 begin
5098 if AnOuterType = nil then
5099 AnOuterType := Self;
5100 Result := TFpValueDwarfEnum.Create(AnOuterType);
5101 end;
5102
5103 procedure TFpSymbolDwarfTypeEnum.KindNeeded;
5104 begin
5105 SetKind(skEnum);
5106 end;
5107
GetNestedSymbolExnull5108 function TFpSymbolDwarfTypeEnum.GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
5109 begin
5110 CreateMembers;
5111 AnParentTypeSymbol := Self;
5112 Result := TFpSymbol(FMembers[AIndex]);
5113 end;
5114
GetNestedSymbolExByNamenull5115 function TFpSymbolDwarfTypeEnum.GetNestedSymbolExByName(const AIndex: String;
5116 out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
5117 var
5118 i: Integer;
5119 s, s1, s2: String;
5120 begin
5121 if AIndex = '' then begin
5122 Result := nil;
5123 Exit;
5124 end;
5125 s1 := UTF8UpperCase(AIndex);
5126 s2 := UTF8LowerCase(AIndex);
5127 CreateMembers;
5128 AnParentTypeSymbol := Self;
5129 i := FMembers.Count - 1;
5130 while i >= 0 do begin
5131 Result := TFpSymbol(FMembers[i]);
5132 s := Result.Name;
5133 if (s <> '') and CompareUtf8BothCase(@s1[1], @s2[1], @s[1]) then
5134 exit;
5135 dec(i);
5136 end;
5137 Result := nil;
5138 end;
5139
GetNestedSymbolCountnull5140 function TFpSymbolDwarfTypeEnum.GetNestedSymbolCount: Integer;
5141 begin
5142 CreateMembers;
5143 Result := FMembers.Count;
5144 end;
5145
5146 destructor TFpSymbolDwarfTypeEnum.Destroy;
5147 begin
5148 if FMembers <> nil then
5149 FreeAndNil(FMembers);
5150 inherited Destroy;
5151 end;
5152
GetValueBoundsnull5153 function TFpSymbolDwarfTypeEnum.GetValueBounds(AValueObj: TFpValue; out
5154 ALowBound, AHighBound: Int64): Boolean;
5155 begin
5156 Result := GetValueLowBound(AValueObj, ALowBound); // TODO: ond GetValueHighBound() // but all callers must check result;
5157 if not GetValueHighBound(AValueObj, AHighBound) then
5158 Result := False;
5159 end;
5160
GetValueLowBoundnull5161 function TFpSymbolDwarfTypeEnum.GetValueLowBound(AValueObj: TFpValue; out
5162 ALowBound: Int64): Boolean;
5163 var
5164 c: Integer;
5165 begin
5166 Result := True;
5167 c := NestedSymbolCount;
5168 if c > 0 then
5169 ALowBound := NestedSymbol[0].OrdinalValue
5170 else
5171 ALowBound := 0;
5172 end;
5173
GetValueHighBoundnull5174 function TFpSymbolDwarfTypeEnum.GetValueHighBound(AValueObj: TFpValue; out
5175 AHighBound: Int64): Boolean;
5176 var
5177 c: Integer;
5178 begin
5179 Result := True;
5180 c := NestedSymbolCount;
5181 if c > 0 then
5182 AHighBound := NestedSymbol[c-1].OrdinalValue
5183 else
5184 AHighBound := -1;
5185 end;
5186
5187 { TFpSymbolDwarfTypeSet }
5188
5189 procedure TFpSymbolDwarfTypeSet.KindNeeded;
5190 begin
5191 SetKind(skSet);
5192 end;
5193
GetTypedValueObjectnull5194 function TFpSymbolDwarfTypeSet.GetTypedValueObject(ATypeCast: Boolean;
5195 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
5196 begin
5197 if AnOuterType = nil then
5198 AnOuterType := Self;
5199 Result := TFpValueDwarfSet.Create(AnOuterType);
5200 end;
5201
GetNestedSymbolCountnull5202 function TFpSymbolDwarfTypeSet.GetNestedSymbolCount: Integer;
5203 begin
5204 if TypeInfo.Kind = skEnum then
5205 Result := TypeInfo.NestedSymbolCount
5206 else
5207 Result := inherited GetNestedSymbolCount;
5208 end;
5209
GetNestedSymbolExnull5210 function TFpSymbolDwarfTypeSet.GetNestedSymbolEx(AIndex: Int64; out
5211 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
5212 begin
5213 if TypeInfo.Kind = skEnum then begin
5214 Result := TypeInfo.GetNestedSymbolEx(AIndex, AnParentTypeSymbol);
5215 end
5216 else
5217 Result := inherited GetNestedSymbolEx(AIndex, AnParentTypeSymbol);
5218 end;
5219
5220 { TFpSymbolDwarfDataMember }
5221
DoReadSizenull5222 function TFpSymbolDwarfDataMember.DoReadSize(const AValueObj: TFpValue; out
5223 ASize: TFpDbgValueSize): Boolean;
5224 // COPY OF TFpSymbolDwarfType.DoReadSize
5225 var
5226 AttrData: TDwarfAttribData;
5227 Bits: Int64;
5228 begin
5229 ASize := ZeroSize;
5230 Result := False;
5231
5232 if InformationEntry.GetAttribData(DW_AT_bit_size, AttrData) then begin
5233 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, Bits);
5234 if not Result then
5235 exit;
5236 ASize := SizeFromBits(Bits);
5237 exit;
5238 end;
5239
5240 if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin
5241 Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ASize.Size);
5242 if not Result then
5243 exit;
5244 end;
5245
5246 // If it does not have a size => No error
5247 end;
5248
GetValueAddressnull5249 function TFpSymbolDwarfDataMember.GetValueAddress(AValueObj: TFpValueDwarf; out
5250 AnAddress: TFpDbgMemLocation): Boolean;
5251 begin
5252 if AValueObj = nil then debugln([FPDBG_DWARF_VERBOSE, 'TFpSymbolDwarfDataMember.InitLocationParser: NO VAl Obj !!!!!!!!!!!!!!!'])
5253 else if AValueObj.StructureValue = nil then debugln(FPDBG_DWARF_VERBOSE, ['TFpSymbolDwarfDataMember.InitLocationParser: NO STRUCT Obj !!!!!!!!!!!!!!!']);
5254
5255 if InformationEntry.HasAttrib(DW_AT_const_value) then begin
5256 // fpc specific => constant members
5257 Result := ConstantFromTag(DW_AT_const_value, FConstData, AnAddress);
5258 exit;
5259 // There should not be a DW_AT_data_member_location
5260 end;
5261
5262 AnAddress := InvalidLoc;
5263 if (AValueObj = nil) or (AValueObj.StructureValue = nil) or (AValueObj.FParentTypeSymbol = nil)
5264 then begin
5265 debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataMember.InitLocationParser ']);
5266 Result := False;
5267 if not HasError(AValueObj) then
5268 SetLastError(AValueObj, CreateError(fpErrLocationParserInit)); // TODO: error message?
5269 exit;
5270 end;
5271 if not AValueObj.GetStructureDwarfDataAddress(AnAddress, AValueObj.FParentTypeSymbol) then begin
5272 debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataMember.InitLocationParser Error: ',ErrorCode(AValueObj.LastError)]);
5273 Result := False;
5274 if not HasError(AValueObj) then
5275 SetLastError(AValueObj, CreateError(fpErrLocationParserInit)); // TODO: error message?
5276 exit;
5277 end;
5278 //TODO: AValueObj.StructureValue.LastError
5279
5280 Result := ComputeDataMemberAddress(InformationEntry, AValueObj, AnAddress);
5281 if not Result then
5282 exit;
5283 end;
5284
HasAddressnull5285 function TFpSymbolDwarfDataMember.HasAddress: Boolean;
5286 begin
5287 // DW_AT_data_member_location defaults to zero => i.e. at the start of the containing structure
5288 Result := not (InformationEntry.HasAttrib(DW_AT_const_value));
5289 //(InformationEntry.HasAttrib(DW_AT_data_member_location));
5290 end;
5291
5292 { TFpSymbolDwarfTypeStructure }
5293
GetNestedSymbolExByNamenull5294 function TFpSymbolDwarfTypeStructure.GetNestedSymbolExByName(
5295 const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
5296 var
5297 Ident: TDwarfInformationEntry;
5298 ti: TFpSymbolDwarfType;
5299 begin
5300 // Todo, maybe create all children?
5301 if FLastChildByName <> nil then begin
5302 FLastChildByName.ReleaseReference;
5303 FLastChildByName := nil;
5304 end;
5305 Result := nil;
5306
5307 Ident := InformationEntry.FindNamedChild(AIndex);
5308 if Ident <> nil then begin
5309 AnParentTypeSymbol := Self;
5310 FLastChildByName := TFpSymbolDwarf.CreateSubClass('', Ident);
5311 //assert is member ?
5312 ReleaseRefAndNil(Ident);
5313 Result := FLastChildByName;
5314
5315 exit;
5316 end;
5317
5318 ti := TypeInfo; // Parent
5319 if ti <> nil then
5320 Result := ti.GetNestedSymbolExByName(AIndex, AnParentTypeSymbol);
5321 end;
5322
GetNestedSymbolCountnull5323 function TFpSymbolDwarfTypeStructure.GetNestedSymbolCount: Integer;
5324 var
5325 ti: TFpSymbol;
5326 begin
5327 CreateMembers;
5328 Result := FMembers.Count;
5329
5330 ti := TypeInfo;
5331 if ti <> nil then
5332 Result := Result + ti.NestedSymbolCount;
5333 end;
5334
GetDataAddressNextnull5335 function TFpSymbolDwarfTypeStructure.GetDataAddressNext(
5336 AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation; out
5337 ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean;
5338 begin
5339 Result := inherited GetDataAddressNext(AValueObj, AnAddress, ADoneWork, ATargetType);
5340
5341 // TODO: This should be done via GetNextTypeInfoForDataAddress, which should return the parent class
5342
5343 (* We have the DataAddress for this class => stop here, unless ATargetType
5344 indicates that we want a parent-class DataAddress
5345 Adding the InheritanceInfo's DW_AT_data_member_location would normally
5346 have to be done by the parent class. But then we would need to make it
5347 available there.
5348 // TODO: Could not determine from the Dwarf Spec, if the parent class
5349 should skip its DW_AT_data_location, if it was reached via
5350 DW_AT_data_member_location
5351 The spec says "handled the same as for members" => might indicate it should
5352 *)
5353
5354 if (ATargetType = nil) or (ATargetType = self) then
5355 exit;
5356
5357 Result := IsReadableMem(AnAddress);
5358 if not Result then
5359 exit;
5360 InitInheritanceInfo;
5361
5362 Result := FInheritanceInfo = nil;
5363 if Result then
5364 exit;
5365
5366 Result := ComputeDataMemberAddress(FInheritanceInfo, AValueObj, AnAddress);
5367 if not Result then
5368 exit;
5369 end;
5370
TFpSymbolDwarfTypeStructure.GetNestedSymbolExnull5371 function TFpSymbolDwarfTypeStructure.GetNestedSymbolEx(AIndex: Int64; out
5372 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
5373 var
5374 i: Int64;
5375 ti: TFpSymbolDwarfType;
5376 begin
5377 CreateMembers;
5378
5379 i := AIndex;
5380 ti := TypeInfo;
5381 if ti <> nil then
5382 i := i - ti.NestedSymbolCount;
5383
5384 if i < 0 then
5385 Result := ti.GetNestedSymbolEX(AIndex, AnParentTypeSymbol)
5386 else begin
5387 AnParentTypeSymbol := Self;
5388 Result := TFpSymbol(FMembers[i]);
5389 end;
5390 end;
5391
5392 destructor TFpSymbolDwarfTypeStructure.Destroy;
5393 begin
5394 ReleaseRefAndNil(FInheritanceInfo);
5395 FreeAndNil(FMembers);
5396 FLastChildByName.ReleaseReference;
5397 inherited Destroy;
5398 end;
5399
5400 procedure TFpSymbolDwarfTypeStructure.CreateMembers;
5401 var
5402 Info: TDwarfInformationEntry;
5403 Info2: TDwarfInformationEntry;
5404 sym: TFpSymbolDwarf;
5405 begin
5406 if FMembers <> nil then
5407 exit;
5408 FMembers := TRefCntObjList.Create;
5409 Info := InformationEntry.Clone;
5410 Info.GoChild;
5411
5412 while Info.HasValidScope do begin
5413 if (Info.AbbrevTag = DW_TAG_member) or (Info.AbbrevTag = DW_TAG_subprogram) then begin
5414 Info2 := Info.Clone;
5415 sym := TFpSymbolDwarf.CreateSubClass('', Info2);
5416 FMembers.Add(sym);
5417 sym.ReleaseReference;
5418 Info2.ReleaseReference;
5419 end;
5420 Info.GoNext;
5421 end;
5422
5423 Info.ReleaseReference;
5424 end;
5425
5426 procedure TFpSymbolDwarfTypeStructure.InitInheritanceInfo;
5427 begin
5428 if FInheritanceInfo = nil then
5429 FInheritanceInfo := InformationEntry.FindChildByTag(DW_TAG_inheritance);
5430 end;
5431
TFpSymbolDwarfTypeStructure.DoGetNestedTypeInfonull5432 function TFpSymbolDwarfTypeStructure.DoGetNestedTypeInfo: TFpSymbolDwarfType;
5433 var
5434 FwdInfoPtr: Pointer;
5435 FwdCompUint: TDwarfCompilationUnit;
5436 ParentInfo: TDwarfInformationEntry;
5437 begin
5438 Result:= nil;
5439 InitInheritanceInfo;
5440 if (FInheritanceInfo <> nil) and
5441 FInheritanceInfo.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint)
5442 then begin
5443 ParentInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
5444 //DebugLn(FPDBG_DWARF_SEARCH, ['Inherited from ', dbgs(ParentInfo.FInformationEntry, FwdCompUint) ]);
5445 Result := TFpSymbolDwarfType.CreateTypeSubClass('', ParentInfo);
5446 ParentInfo.ReleaseReference;
5447 end;
5448 end;
5449
5450 procedure TFpSymbolDwarfTypeStructure.KindNeeded;
5451 begin
5452 if (InformationEntry.AbbrevTag = DW_TAG_class_type) then
5453 SetKind(skClass)
5454 else
5455 if (InformationEntry.AbbrevTag = DW_TAG_interface_type) then
5456 SetKind(skInterface)
5457 else
5458 SetKind(skRecord);
5459 end;
5460
TFpSymbolDwarfTypeStructure.GetTypedValueObjectnull5461 function TFpSymbolDwarfTypeStructure.GetTypedValueObject(ATypeCast: Boolean;
5462 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
5463 begin
5464 if AnOuterType = nil then
5465 AnOuterType := Self;
5466 Result := TFpValueDwarfStruct.Create(AnOuterType);
5467 end;
5468
5469 { TFpSymbolDwarfTypeArray }
5470
5471 procedure TFpSymbolDwarfTypeArray.CreateMembers;
5472 var
5473 Info, Info2: TDwarfInformationEntry;
5474 t: Cardinal;
5475 sym: TFpSymbolDwarf;
5476 begin
5477 if FMembers <> nil then
5478 exit;
5479 FMembers := TRefCntObjList.Create;
5480
5481 Info := InformationEntry.FirstChild;
5482 if Info = nil then exit;
5483
5484 while Info.HasValidScope do begin
5485 t := Info.AbbrevTag;
5486 if (t = DW_TAG_enumeration_type) or (t = DW_TAG_subrange_type) then begin
5487 Info2 := Info.Clone;
5488 sym := TFpSymbolDwarf.CreateSubClass('', Info2);
5489 FMembers.Add(sym);
5490 sym.ReleaseReference;
5491 Info2.ReleaseReference;
5492 end;
5493 Info.GoNext;
5494 end;
5495
5496 Info.ReleaseReference;
5497 end;
5498
5499 procedure TFpSymbolDwarfTypeArray.KindNeeded;
5500 begin
5501 SetKind(skArray); // Todo: static/dynamic?
5502 end;
5503
DoReadOrderingnull5504 function TFpSymbolDwarfTypeArray.DoReadOrdering(AValueObj: TFpValueDwarf; out
5505 ARowMajor: Boolean): Boolean;
5506 var
5507 AVal: Integer;
5508 AttrData: TDwarfAttribData;
5509 begin
5510 Result := True;
5511 ARowMajor := True; // default (at least in pas)
5512
5513 if InformationEntry.GetAttribData(DW_AT_ordering, AttrData) then begin
5514 Result := InformationEntry.ReadValue(AttrData, AVal);
5515 if Result then
5516 ARowMajor := AVal = DW_ORD_row_major
5517 else
5518 SetLastError(AValueObj, CreateError(fpErrAnyError));
5519 end;
5520 end;
5521
TFpSymbolDwarfTypeArray.GetTypedValueObjectnull5522 function TFpSymbolDwarfTypeArray.GetTypedValueObject(ATypeCast: Boolean;
5523 AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
5524 begin
5525 if AnOuterType = nil then
5526 AnOuterType := Self;
5527 Result := TFpValueDwarfArray.Create(AnOuterType, Self);
5528 end;
5529
GetFlagsnull5530 function TFpSymbolDwarfTypeArray.GetFlags: TDbgSymbolFlags;
IsDynSubRangenull5531 function IsDynSubRange(m: TFpSymbolDwarf): Boolean;
5532 begin
5533 Result := sfSubRange in m.Flags;
5534 if not Result then exit;
5535 while (m <> nil) and not(m is TFpSymbolDwarfTypeSubRange) do
5536 m := m.NestedTypeInfo;
5537 Result := m <> nil;
5538 if not Result then exit; // TODO: should not happen, handle error
5539 Result := (TFpSymbolDwarfTypeSubRange(m).FHighBoundState = rfValue) // dynamic high bound // TODO:? Could be rfConst for locationExpr
5540 or (TFpSymbolDwarfTypeSubRange(m).FHighBoundState = rfNotRead); // dynamic high bound (yet to be read)
5541 end;
5542 var
5543 m: TFpSymbol;
5544 lb, hb: Int64;
5545 begin
5546 Result := inherited GetFlags;
5547 if (NestedSymbolCount = 1) then begin // TODO: move to freepascal specific
5548 m := NestedSymbol[0];
5549 if (not m.GetValueBounds(nil, lb, hb)) or // e.g. Subrange with missing upper bound
5550 (hb < lb) or
5551 (IsDynSubRange(TFpSymbolDwarf(m)))
5552 then
5553 Result := Result + [sfDynArray]
5554 else
5555 Result := Result + [sfStatArray];
5556 end
5557 else
5558 Result := Result + [sfStatArray];
5559 end;
5560
GetNestedSymbolExnull5561 function TFpSymbolDwarfTypeArray.GetNestedSymbolEx(AIndex: Int64; out
5562 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
5563 begin
5564 CreateMembers;
5565 AnParentTypeSymbol := Self;
5566 Result := TFpSymbol(FMembers[AIndex]);
5567 end;
5568
TFpSymbolDwarfTypeArray.GetNestedSymbolCountnull5569 function TFpSymbolDwarfTypeArray.GetNestedSymbolCount: Integer;
5570 begin
5571 CreateMembers;
5572 Result := FMembers.Count;
5573 end;
5574
GetMemberAddressnull5575 function TFpSymbolDwarfTypeArray.GetMemberAddress(AValueObj: TFpValueDwarf;
5576 const AIndex: array of Int64): TFpDbgMemLocation;
5577 var
5578 Idx, Factor: Int64;
5579 LowBound, HighBound: int64;
5580 i: Integer;
5581 m: TFpSymbolDwarf;
5582 RowMajor: Boolean;
5583 Offs, StrideInBits: TFpDbgValueSize;
5584 begin
5585 assert((AValueObj is TFpValueDwarfArray), 'TFpSymbolDwarfTypeArray.GetMemberAddress AValueObj');
5586 // ReadOrdering;
5587 // ReadStride(AValueObj); // TODO Stride per member (member = dimension/index)
5588 Result := InvalidLoc;
5589
5590 if not TFpValueDwarfArray(AValueObj).GetMainStride(StrideInBits) then
5591 exit;
5592 if (StrideInBits <= 0) then
5593 exit;
5594
5595 CreateMembers;
5596 if Length(AIndex) > FMembers.Count then
5597 exit;
5598
5599 if AValueObj is TFpValueDwarfArray then begin
5600 if not TFpValueDwarfArray(AValueObj).GetDwarfDataAddress(Result) then begin
5601 Result := InvalidLoc;
5602 Exit;
5603 end;
5604 end
5605 else
5606 exit; // TODO error
5607 if IsTargetNil(Result) then begin
5608 Result := InvalidLoc;
5609 SetLastError(AValueObj, CreateError(fpErrAddressIsNil));
5610 Exit;
5611 end;
5612 assert(IsReadableMem(Result), 'DwarfArray MemberAddress');
5613 if not IsReadableMem(Result) then begin
5614 Result := InvalidLoc;
5615 SetLastError(AValueObj, CreateError(fpErrAnyError));
5616 Exit;
5617 end;
5618
5619 Offs := ZeroSize;
5620 Factor := 1;
5621
5622
5623 if not TFpValueDwarfArray(AValueObj).GetOrdering(RowMajor) then
5624 exit;
5625 {$PUSH}{$R-}{$Q-} // TODO: check range of index
5626 if RowMajor then begin
5627 for i := Length(AIndex) - 1 downto 0 do begin
5628 Idx := AIndex[i];
5629 m := TFpSymbolDwarf(FMembers[i]);
5630 if i > 0 then begin
5631 if not m.GetValueBounds(AValueObj, LowBound, HighBound) then begin
5632 Result := InvalidLoc;
5633 exit;
5634 end;
5635 Idx := Idx - LowBound;
5636 Offs := Offs + StrideInBits * Idx * Factor;
5637 Factor := Factor * (HighBound - LowBound + 1); // TODO range check
5638 end
5639 else begin
5640 if m.GetValueLowBound(AValueObj, LowBound) then
5641 Idx := Idx - LowBound;
5642 Offs := Offs + StrideInBits * Idx * Factor;
5643 end;
5644 end;
5645 end
5646 else begin
5647 for i := 0 to Length(AIndex) - 1 do begin
5648 Idx := AIndex[i];
5649 m := TFpSymbolDwarf(FMembers[i]);
5650 if i > 0 then begin
5651 if not m.GetValueBounds(AValueObj, LowBound, HighBound) then begin
5652 Result := InvalidLoc;
5653 exit;
5654 end;
5655 Idx := Idx - LowBound;
5656 Offs := Offs + StrideInBits * Idx * Factor;
5657 Factor := Factor * (HighBound - LowBound + 1); // TODO range check
5658 end
5659 else begin
5660 if m.GetValueLowBound(AValueObj, LowBound) then
5661 Idx := Idx - LowBound;
5662 Offs := Offs + StrideInBits * Idx * Factor;
5663 end;
5664 end;
5665 end;
5666
5667 Result := Result + Offs;
5668 {$POP}
5669 end;
5670
5671 destructor TFpSymbolDwarfTypeArray.Destroy;
5672 begin
5673 FreeAndNil(FMembers);
5674 inherited Destroy;
5675 end;
5676
5677 procedure TFpSymbolDwarfTypeArray.ResetValueBounds;
5678 var
5679 i: Integer;
5680 begin
5681 inherited ResetValueBounds;
5682 if FMembers <> nil then
5683 for i := 0 to FMembers.Count - 1 do
5684 if TObject(FMembers[i]) is TFpSymbolDwarfType then
5685 TFpSymbolDwarfType(FMembers[i]).ResetValueBounds;
5686 end;
5687
5688 { TDbgDwarfSymbol }
5689
5690 constructor TFpSymbolDwarfDataProc.Create(
5691 ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo;
5692 AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo);
5693 var
5694 InfoEntry: TDwarfInformationEntry;
5695 begin
5696 FAddress := AAddress;
5697 FAddressInfo := AInfo;
5698 FDwarf := ADbgInfo;
5699
5700 InfoEntry := TDwarfInformationEntry.Create(ACompilationUnit, nil);
5701 InfoEntry.ScopeIndex := AInfo^.ScopeIndex;
5702
5703 inherited Create(
5704 String(FAddressInfo^.Name),
5705 InfoEntry
5706 );
5707
5708 SetAddress(TargetLoc(FAddressInfo^.StartPC));
5709
5710 InfoEntry.ReleaseReference;
5711 //BuildLineInfo(
5712
5713 // AFile: String = ''; ALine: Integer = -1; AFlags: TDbgSymbolFlags = []; const AReference: TDbgSymbol = nil);
5714 end;
5715
5716 destructor TFpSymbolDwarfDataProc.Destroy;
5717 begin
5718 FreeAndNil(FStateMachine);
5719 inherited Destroy;
5720 end;
5721
TFpSymbolDwarfDataProc.CreateSymbolScopenull5722 function TFpSymbolDwarfDataProc.CreateSymbolScope(
5723 ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope;
5724 begin
5725 Result := nil;
5726 if FDwarf <> nil then
5727 Result := CompilationUnit.DwarfSymbolClassMap.CreateScopeForSymbol
5728 (ALocationContext, Self, FDwarf);
5729 end;
5730
TFpSymbolDwarfDataProc.CreateSymbolScopenull5731 function TFpSymbolDwarfDataProc.CreateSymbolScope(
5732 ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo
5733 ): TFpDbgSymbolScope;
5734 begin
5735 Result := CompilationUnit.DwarfSymbolClassMap.CreateScopeForSymbol
5736 (ALocationContext, Self, ADwarfInfo);
5737 end;
5738
GetColumnnull5739 function TFpSymbolDwarfDataProc.GetColumn: Cardinal;
5740 begin
5741 if StateMachineValid
5742 then Result := FStateMachine.Column
5743 else Result := inherited GetColumn;
5744 end;
5745
GetFilenull5746 function TFpSymbolDwarfDataProc.GetFile: String;
5747 begin
5748 if StateMachineValid
5749 then Result := FStateMachine.FileName
5750 else Result := inherited GetFile;
5751 end;
5752
GetLinenull5753 function TFpSymbolDwarfDataProc.GetLine: Cardinal;
5754 var
5755 sm: TDwarfLineInfoStateMachine;
5756 begin
5757 if StateMachineValid
5758 then begin
5759 Result := FStateMachine.Line;
5760 if Result = 0 then begin // TODO: fpc specific.
5761 sm := FStateMachine.Clone;
5762 sm.NextLine;
5763 Result := sm.Line;
5764 sm.Free;
5765 end;
5766 end
5767 else Result := inherited GetLine;
5768 end;
5769
GetLineEndAddressnull5770 function TFpSymbolDwarfDataProc.GetLineEndAddress: TDBGPtr;
5771 var
5772 sm: TDwarfLineInfoStateMachine;
5773 begin
5774 if StateMachineValid
5775 then begin
5776 sm := FStateMachine.Clone;
5777 if sm.NextLine then
5778 Result := sm.Address
5779 else
5780 Result := 0;
5781 sm.Free;
5782 end
5783 else Result := 0;
5784 end;
5785
TFpSymbolDwarfDataProc.GetLineStartAddressnull5786 function TFpSymbolDwarfDataProc.GetLineStartAddress: TDBGPtr;
5787 begin
5788 if StateMachineValid
5789 then
5790 Result := FStateMachine.Address
5791 else
5792 Result := 0;
5793 end;
5794
TFpSymbolDwarfDataProc.GetLineUnfixednull5795 function TFpSymbolDwarfDataProc.GetLineUnfixed: TDBGPtr;
5796 begin
5797 if StateMachineValid
5798 then
5799 Result := FStateMachine.Line
5800 else
5801 Result := inherited GetLine;
5802 end;
5803
GetValueObjectnull5804 function TFpSymbolDwarfDataProc.GetValueObject: TFpValue;
5805 begin
5806 assert(TypeInfo is TFpSymbolDwarfType, 'TFpSymbolDwarfDataProc.GetValueObject: TypeInfo is TFpSymbolDwarfType');
5807 Result := TFpValueDwarfSubroutine.Create(TFpSymbolDwarfType(TypeInfo)); // TODO: GetTypedValueObject;
5808 TFpValueDwarf(Result).SetDataSymbol(self);
5809 end;
5810
GetValueAddressnull5811 function TFpSymbolDwarfDataProc.GetValueAddress(AValueObj: TFpValueDwarf; out
5812 AnAddress: TFpDbgMemLocation): Boolean;
5813 var
5814 AttrData: TDwarfAttribData;
5815 Addr: TDBGPtr;
5816 begin
5817 AnAddress := InvalidLoc;
5818 if InformationEntry.GetAttribData(DW_AT_low_pc, AttrData) then
5819 if InformationEntry.ReadAddressValue(AttrData, Addr) then
5820 AnAddress := TargetLoc(Addr);
5821 //DW_AT_ranges
5822 Result := IsValidLoc(AnAddress);
5823 end;
5824
StateMachineValidnull5825 function TFpSymbolDwarfDataProc.StateMachineValid: Boolean;
5826 var
5827 SM1, SM2: TDwarfLineInfoStateMachine;
5828 SM2val: Boolean;
5829 begin
5830 Result := FStateMachine <> nil;
5831 if Result then Exit;
5832
5833 if FAddressInfo^.StateMachine = nil
5834 then begin
5835 CompilationUnit.BuildLineInfo(FAddressInfo, False);
5836 if FAddressInfo^.StateMachine = nil then Exit;
5837 end;
5838
5839 // we cannot restore a statemachine to its current state
5840 // so we shouldn't modify FAddressInfo^.StateMachine
5841 // so use clones to navigate
5842 if FAddress < FAddressInfo^.StateMachine.Address
5843 then
5844 Exit; // The address we want to find is before the start of this symbol ??
5845
5846 SM1 := FAddressInfo^.StateMachine.Clone;
5847 SM2 := FAddressInfo^.StateMachine.Clone;
5848
5849 repeat
5850 SM2val := SM2.NextLine;
5851 if (not SM1.EndSequence) and
5852 ( (FAddress = SM1.Address) or
5853 ( (FAddress > SM1.Address) and
5854 SM2val and (FAddress < SM2.Address)
5855 )
5856 )
5857 then begin
5858 // found
5859 FStateMachine := SM1;
5860 SM2.Free;
5861 Result := True;
5862 Exit;
5863 end;
5864 until not SM1.NextLine;
5865
5866 //if all went well we shouldn't come here
5867 SM1.Free;
5868 SM2.Free;
5869 end;
5870
ReadVirtualitynull5871 function TFpSymbolDwarfDataProc.ReadVirtuality(out AFlags: TDbgSymbolFlags): Boolean;
5872 var
5873 Val: Integer;
5874 begin
5875 AFlags := [];
5876 Result := InformationEntry.ReadValue(DW_AT_virtuality, Val);
5877 if not Result then exit;
5878 case Val of
5879 DW_VIRTUALITY_none: ;
5880 DW_VIRTUALITY_virtual: AFlags := [sfVirtual];
5881 DW_VIRTUALITY_pure_virtual: AFlags := [sfVirtual];
5882 end;
5883 end;
5884
TFpSymbolDwarfDataProc.GetFrameBasenull5885 function TFpSymbolDwarfDataProc.GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
5886 var
5887 Val: TByteDynArray;
5888 rd: TFpDbgMemLocation;
5889 begin
5890 Result := 0;
5891 if FFrameBaseParser = nil then begin
5892 //TODO: avoid copying data
5893 if not InformationEntry.ReadValue(DW_AT_frame_base, Val) then begin
5894 // error
5895 debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase failed to read DW_AT_frame_base']);
5896 exit;
5897 end;
5898 if Length(Val) = 0 then begin
5899 // error
5900 debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase failed to read DW_AT_location']);
5901 exit;
5902 end;
5903
5904 FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit,
5905 ASender.Context);
5906 FFrameBaseParser.Evaluate;
5907 end;
5908
5909 rd := FFrameBaseParser.ResultData;
5910 if IsValidLoc(rd) then
5911 Result := rd.Address;
5912
5913 if IsError(FFrameBaseParser.LastError) then begin
5914 ASender.SetLastError(FFrameBaseParser.LastError);
5915 debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(ASender.LastError)]);
5916 end
5917 else
5918 if Result = 0 then begin
5919 debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase location parser failed. result is 0']);
5920 end;
5921
5922 end;
5923
GetFlagsnull5924 function TFpSymbolDwarfDataProc.GetFlags: TDbgSymbolFlags;
5925 var
5926 flg: TDbgSymbolFlags;
5927 begin
5928 Result := inherited GetFlags;
5929 if ReadVirtuality(flg) then
5930 Result := Result + flg;
5931 end;
5932
5933 procedure TFpSymbolDwarfDataProc.TypeInfoNeeded;
5934 var
5935 t: TFpSymbolDwarfTypeProc;
5936 begin
5937 t := TFpSymbolDwarfTypeProc.Create('', InformationEntry, FAddressInfo);
5938 SetTypeInfo(t); // TODO: avoid adding a reference, already got one....
5939 t.ReleaseReference;
5940 end;
5941
GetParentnull5942 function TFpSymbolDwarfDataProc.GetParent: TFpSymbol;
5943 var
5944 InfoEntry: TDwarfInformationEntry;
5945 tg: Cardinal;
5946 c: TDbgDwarfSymbolBaseClass;
5947 begin
5948 // special: search "self"
5949 // Todo nested procs
5950 Result := nil;
5951 InfoEntry := InformationEntry.Clone;
5952 InfoEntry.GoParent;
5953 tg := InfoEntry.AbbrevTag;
5954 if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
5955 c := InfoEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(tg);
5956 if c <> nil then
5957 Result := c.Create('', InfoEntry);
5958 end;
5959 InfoEntry.ReleaseReference;
5960 end;
5961
5962 var
5963 ThisNameInfo, SelfNameInfo: TNameSearchInfo;
GetSelfParameternull5964 function TFpSymbolDwarfDataProc.GetSelfParameter(AnAddress: TDbgPtr): TFpValueDwarf;
5965 var
5966 InfoEntry: TDwarfInformationEntry;
5967 tg: Cardinal;
5968 found: Boolean;
5969 begin
5970 // special: search "self"
5971 // Todo nested procs
5972 Result := nil;
5973 InfoEntry := InformationEntry.Clone;
5974 //StartScopeIdx := InfoEntry.ScopeIndex;
5975 InfoEntry.GoParent;
5976 tg := InfoEntry.AbbrevTag;
5977 if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
5978 InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
5979 found := InfoEntry.GoNamedChildEx(ThisNameInfo);
5980 if not found then begin
5981 InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
5982 found := InfoEntry.GoNamedChildEx(SelfNameInfo);
5983 end;
5984 if found then begin
5985 if ((AnAddress = 0) or InfoEntry.IsAddressInStartScope(AnAddress)) and
5986 InfoEntry.IsArtificial
5987 then begin
5988 Result := TFpValueDwarf(TFpSymbolDwarfData.CreateValueSubClass('self', InfoEntry).Value);
5989 if Result <> nil then begin
5990 Result.FDataSymbol.ReleaseReference;
5991 Result.FDataSymbol.LocalProcInfo := Self;
5992 end;
5993 debugln(FPDBG_DWARF_SEARCH, ['TFpSymbolDwarfDataProc.GetSelfParameter ', InfoEntry.ScopeDebugText, DbgSName(Result)]);
5994 end;
5995 end;
5996 end;
5997 InfoEntry.ReleaseReference;
5998 end;
5999
6000 { TFpSymbolDwarfTypeProc }
6001
6002 procedure TFpSymbolDwarfTypeProc.CreateMembers;
6003 var
6004 Info: TDwarfInformationEntry;
6005 Info2: TDwarfInformationEntry;
6006 begin
6007 if FProcMembers <> nil then
6008 exit;
6009 FProcMembers := TRefCntObjList.Create;
6010 Info := InformationEntry.Clone;
6011 Info.GoChild;
6012
6013 while Info.HasValidScope do begin
6014 if ((Info.AbbrevTag = DW_TAG_formal_parameter) or (Info.AbbrevTag = DW_TAG_variable)) //and
6015 //not(Info.IsArtificial)
6016 then begin
6017 Info2 := Info.Clone;
6018 FProcMembers.Add(Info2);
6019 Info2.ReleaseReference;
6020 end;
6021 Info.GoNext;
6022 end;
6023
6024 Info.ReleaseReference;
6025 end;
6026
6027 procedure TFpSymbolDwarfTypeProc.NameNeeded;
6028 begin
6029 case Kind of
SetNamenull6030 skFunction: SetName('function');
6031 skProcedure: SetName('procedure');
6032 else SetName('');
6033 end;
6034 end;
6035
6036 procedure TFpSymbolDwarfTypeProc.KindNeeded;
6037 begin
6038 if TypeInfo <> nil then
6039 SetKind(skFunction)
elsenull6040 else
6041 SetKind(skProcedure);
6042 end;
6043
DoReadSizenull6044 function TFpSymbolDwarfTypeProc.DoReadSize(const AValueObj: TFpValue; out
6045 ASize: TFpDbgValueSize): Boolean;
6046 begin
6047 ASize := ZeroSize;
6048 Result := FAddressInfo <> nil;
6049 DebugLn(FPDBG_DWARF_WARNINGS, 'function has no address info');
6050 if Result then
6051 ASize.Size := FAddressInfo^.EndPC - FAddressInfo^.StartPC;
6052 end;
6053
GetNestedSymbolExnull6054 function TFpSymbolDwarfTypeProc.GetNestedSymbolEx(AIndex: Int64; out
6055 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
6056 begin
6057 CreateMembers;
6058 AnParentTypeSymbol := nil;
6059 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember'){$ENDIF};
6060 FLastMember := TFpSymbolDwarf.CreateSubClass('', TDwarfInformationEntry(FProcMembers[AIndex]));
6061 {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember');{$ENDIF}
6062 Result := FLastMember;
6063 end;
6064
TFpSymbolDwarfTypeProc.GetNestedSymbolExByNamenull6065 function TFpSymbolDwarfTypeProc.GetNestedSymbolExByName(const AIndex: String;
6066 out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
6067 var
6068 Info: TDwarfInformationEntry;
6069 s: String;
6070 i: Integer;
6071 begin
6072 CreateMembers;
6073 AnParentTypeSymbol := nil;
6074 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember'){$ENDIF};
6075 FLastMember := nil;
6076 for i := 0 to FProcMembers.Count - 1 do begin
6077 Info := TDwarfInformationEntry(FProcMembers[i]);
6078 if Info.ReadName(s) and (CompareText(s, AIndex) = 0) then begin
6079 FLastMember := TFpSymbolDwarf.CreateSubClass('', Info);
6080 {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember');{$ENDIF}
6081 break;
6082 end;
6083 end;
6084 Result := FLastMember;
6085 end;
6086
TFpSymbolDwarfTypeProc.GetNestedSymbolCountnull6087 function TFpSymbolDwarfTypeProc.GetNestedSymbolCount: Integer;
6088 begin
6089 CreateMembers;
6090 Result := FProcMembers.Count;
6091 end;
6092
6093 constructor TFpSymbolDwarfTypeProc.Create(const AName: String;
6094 AnInformationEntry: TDwarfInformationEntry; AInfo: PDwarfAddressInfo);
6095 begin
6096 FAddressInfo := AInfo;
6097 inherited Create(AName, AnInformationEntry);
6098 end;
6099
6100 destructor TFpSymbolDwarfTypeProc.Destroy;
6101 begin
6102 FreeAndNil(FProcMembers);
6103 FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember'){$ENDIF};
6104 inherited Destroy;
6105 end;
6106
6107 { TFpSymbolDwarfDataVariable }
6108
GetValueAddressnull6109 function TFpSymbolDwarfDataVariable.GetValueAddress(AValueObj: TFpValueDwarf; out
6110 AnAddress: TFpDbgMemLocation): Boolean;
6111 var
6112 AttrData: TDwarfAttribData;
6113 begin
6114 if InformationEntry.GetAttribData(DW_AT_location, AttrData) then
6115 Result := LocationFromAttrData(AttrData, AValueObj, AnAddress, nil, True)
6116 else
6117 Result := ConstantFromTag(DW_AT_const_value, FConstData, AnAddress);
6118 end;
6119
HasAddressnull6120 function TFpSymbolDwarfDataVariable.HasAddress: Boolean;
6121 begin
6122 // TODO: THis is wrong. It might allow for the @ operator on a const...
6123 Result := InformationEntry.HasAttrib(DW_AT_location) or
6124 InformationEntry.HasAttrib(DW_AT_const_value);
6125 end;
6126
6127 { TFpSymbolDwarfDataParameter }
6128
GetValueAddressnull6129 function TFpSymbolDwarfDataParameter.GetValueAddress(AValueObj: TFpValueDwarf; out
6130 AnAddress: TFpDbgMemLocation): Boolean;
6131 begin
6132 Result := LocationFromTag(DW_AT_location, AValueObj, AnAddress);
6133 end;
6134
TFpSymbolDwarfDataParameter.HasAddressnull6135 function TFpSymbolDwarfDataParameter.HasAddress: Boolean;
6136 begin
6137 Result := InformationEntry.HasAttrib(DW_AT_location);
6138 end;
6139
TFpSymbolDwarfDataParameter.GetFlagsnull6140 function TFpSymbolDwarfDataParameter.GetFlags: TDbgSymbolFlags;
6141 begin
6142 Result := (inherited GetFlags) + [sfParameter];
6143 end;
6144
6145 { TFpSymbolDwarfUnit }
6146
6147 procedure TFpSymbolDwarfUnit.Init;
6148 begin
6149 inherited Init;
6150 SetSymbolType(stNone);
6151 SetKind(skUnit);
6152 end;
6153
TFpSymbolDwarfUnit.GetNestedSymbolExByNamenull6154 function TFpSymbolDwarfUnit.GetNestedSymbolExByName(const AIndex: String; out
6155 AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
6156 var
6157 Ident: TDwarfInformationEntry;
6158 begin
6159 // Todo, param to only search external.
6160 ReleaseRefAndNil(FLastChildByName);
6161 Result := nil;
6162 AnParentTypeSymbol := nil;
6163
6164 Ident := InformationEntry.Clone;
6165 Ident.GoNamedChildEx(AIndex);
6166 if Ident <> nil then
6167 Result := TFpSymbolDwarf.CreateSubClass('', Ident);
6168 ReleaseRefAndNil(Ident);
6169 FLastChildByName := Result;
6170 end;
6171
6172 constructor TFpSymbolDwarfUnit.Create(const AName: String;
6173 AnInformationEntry: TDwarfInformationEntry; ADbgInfo: TFpDwarfInfo);
6174 begin
6175 FDwarf := ADbgInfo;
6176 inherited Create(AName, AnInformationEntry);
6177 end;
6178
6179 destructor TFpSymbolDwarfUnit.Destroy;
6180 begin
6181 ReleaseRefAndNil(FLastChildByName);
6182 inherited Destroy;
6183 end;
6184
TFpSymbolDwarfUnit.CreateSymbolScopenull6185 function TFpSymbolDwarfUnit.CreateSymbolScope(
6186 ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope;
6187 begin
6188 Result := nil;
6189 if FDwarf <> nil then
6190 Result := CompilationUnit.DwarfSymbolClassMap.CreateScopeForSymbol
6191 (ALocationContext, Self, FDwarf);
6192 end;
6193
TFpSymbolDwarfUnit.CreateSymbolScopenull6194 function TFpSymbolDwarfUnit.CreateSymbolScope(
6195 ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo
6196 ): TFpDbgSymbolScope;
6197 begin
6198 Result := CompilationUnit.DwarfSymbolClassMap.CreateScopeForSymbol
6199 (ALocationContext, Self, ADwarfInfo);
6200 end;
6201
6202 initialization
6203 DwarfSymbolClassMapList.SetDefaultMap(TFpDwarfDefaultSymbolClassMap);
6204
6205 DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
6206 FPDBG_DWARF_VERBOSE := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_VERBOSE' {$IFDEF FPDBG_DWARF_VERBOSE} , True {$ENDIF} );
6207 FPDBG_DWARF_ERRORS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_ERRORS' {$IFDEF FPDBG_DWARF_ERRORS} , True {$ENDIF} );
6208 FPDBG_DWARF_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_WARNINGS' {$IFDEF FPDBG_DWARF_WARNINGS} , True {$ENDIF} );
6209 FPDBG_DWARF_SEARCH := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_SEARCH' {$IFDEF FPDBG_DWARF_SEARCH} , True {$ENDIF} );
6210 FPDBG_DWARF_DATA_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_DATA_WARNINGS' {$IFDEF FPDBG_DWARF_DATA_WARNINGS} , True {$ENDIF} );
6211
6212 ThisNameInfo := NameInfoForSearch('THIS');
6213 SelfNameInfo := NameInfoForSearch('$SELF');
6214
6215 end.
6216
6217