1 unit TestHelperClasses;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, FpImgReaderBase, FpDbgDwarfConst, FpDbgLoader, FpDbgInfo,
9 DbgIntfBaseTypes, FpdMemoryTools;
10
11 const
12 TestAddrSize = sizeof(Pointer);
13
14 type
15
16 { TTestMemReader }
17
18 TTestMemReader = class(TFpDbgMemReaderBase)
19 public
20 RegisterValues: array[0..30] of TDbgPtr;
21 RegisterSizes: array[0..30] of Integer;
22 constructor Create;
ReadMemorynull23 function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
ReadMemoryExnull24 function ReadMemoryEx({%H-}AnAddress, {%H-}AnAddressSpace: TDbgPtr; {%H-}ASize: Cardinal; {%H-}ADest: Pointer): Boolean; override;
ReadRegisternull25 function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr;
26 AContext: TFpDbgLocationContext): Boolean; override;
RegisterSizenull27 function RegisterSize(ARegNum: Cardinal): Integer; override;
28 end;
29
30 TTestDwarfAbbrev = class;
31 TTestDwarfInfoEntry = class;
32
33 { TTestDummySection }
34
35 TTestDummySection = class
36 public
37 Section: TDbgImageSection;
38 procedure CreateSectionData; virtual;
39 end;
40
41 { TTestDummyFileSource }
42
43 TTestDummyFileSource = class(TDbgImageReader)
44 private
45 FSections: TStringList;
GetTestSectionnull46 function GetTestSection(const AName: String): TTestDummySection;
47 protected
GetSectionnull48 function GetSection(const AName: String): PDbgImageSection; override;
49 //procedure LoadSections;
50 public
isValidnull51 class function isValid({%H-}ASource: TDbgFileLoader): Boolean; override;
UserNamenull52 class function UserName: AnsiString; override;
53 public
54 constructor Create; overload;
55 destructor Destroy; override;
56 property TestSection[const AName: String]: TTestDummySection read GetTestSection;
57 end;
58
59 { TTestDummyImageLoader }
60
61 TTestDummyImageLoader = class(TDbgImageLoader)
62 private
63 FImgReader: TTestDummyFileSource;
64 protected
65 public
66 constructor Create; override;
67 property TestImgReader: TTestDummyFileSource read FImgReader;
68 end;
69 TTestDummyImageLoaderClass = class of TTestDummyImageLoader;
70
71 { TTestDummySectionAbbrevs }
72
73 TTestDummySectionAbbrevs = class(TTestDummySection)
74 private
75 FCurrentID: Cardinal;
76 FList: TList;
GetNextIDnull77 function GetNextID: Cardinal;
78 public
79 constructor Create;
80 destructor Destroy; override;
GetNewAbbrevObjnull81 function GetNewAbbrevObj: TTestDwarfAbbrev;
82 procedure CreateSectionData; override;
83 end;
84
85 { TTestDummySectionInfoEntries }
86
87 TTestDummySectionInfoEntries = class(TTestDummySection)
88 private
89 FAddrSize: Byte;
90 FFirstEntry: TTestDwarfInfoEntry;
91 FVersion: Word;
92 protected
CreateInfoEntryObjnull93 function CreateInfoEntryObj: TTestDwarfInfoEntry;
94 public
95 AbbrevSection: TTestDummySectionAbbrevs;
96 constructor Create;
97 destructor Destroy; override;
98 property Version: Word read FVersion write FVersion;
99 property AddrSize: Byte read FAddrSize write FAddrSize;
GetFirstInfoEntryObjnull100 function GetFirstInfoEntryObj: TTestDwarfInfoEntry;
101 procedure CreateSectionData; override;
102 end;
103
104 { TTestDwarfAbbrev }
105
106 TTestDwarfAbbrev = class
107 private
108 FSection: TTestDummySectionAbbrevs;
109 FChildren: Byte;
110 FId: Cardinal;
111 FTag: Cardinal;
112 FData: Array of Cardinal;
113 FEncoded: Array of Byte;
114 procedure Encode;
115 public
116 property Id: Cardinal read FId write FId;
117 property Tag: Cardinal read FTag write FTag;
118 property Children: Byte read FChildren write FChildren;
119 procedure Add(ATag, AForm: Cardinal);
DataLengthnull120 function DataLength: Integer;
Datanull121 function Data: Pointer;
122 end;
123
124 { TTestDwarfInfoEntry }
125
126 PTestDwarfInfoEntry = ^TTestDwarfInfoEntry;
127 TTestDwarfInfoEntry = class
128 private
129 FAbbrevObj: TTestDwarfAbbrev;
130 FSection: TTestDummySectionInfoEntries;
131 FChildren: TList;
132 FEncoded: Array of Byte;
133 FRefList: array of record
134 Index, FSize: Integer;
135 AData: TTestDwarfInfoEntry;
136 ADataRef: PTestDwarfInfoEntry;
137 end;
GetChildrennull138 function GetChildren: Byte;
GetTagnull139 function GetTag: Cardinal;
140 procedure InitEncoded;
141 procedure SetChildren(AValue: Byte);
142 procedure SetTag(AValue: Cardinal);
143 protected
144 FWrittenAtIndex: Integer;
DataLengthInclnull145 function DataLengthIncl: Integer; // with Children
146 procedure WriteToSection(ASectionMem: PByte; AIndex: Integer);
147 procedure WriteToSectionFIxRef(ASectionMem: PByte);
148 public
149 constructor Create;
150 destructor Destroy; override;
151 property Tag: Cardinal read GetTag write SetTag;
152 property Children: Byte read GetChildren write SetChildren;
153
154 procedure Add(AnAttrib, AForm: Cardinal; AData: Array of Byte);
155 procedure Add(AnAttrib, AForm: Cardinal; AData: String);
156 procedure AddSLEB(AnAttrib, AForm: Cardinal; AData: Int64);
157 procedure AddULEB(AnAttrib, AForm: Cardinal; AData: QWord);
158 procedure AddAddr(AnAttrib, AForm: Cardinal; AData: QWord);
159 procedure Add(AnAttrib, AForm: Cardinal; AData: QWord); // ULEB
AddRefnull160 function AddRef(AnAttrib, AForm: Cardinal; AData: TTestDwarfInfoEntry): Integer;
AddRefnull161 function AddRef(AnAttrib, AForm: Cardinal; AData: PTestDwarfInfoEntry): Integer;
162
163 procedure SetRef(AIndex: Integer; AData: TTestDwarfInfoEntry);
164
GetNewChildnull165 function GetNewChild: TTestDwarfInfoEntry;
DataLengthnull166 function DataLength: Integer; // Exclude Children
Datanull167 function Data: Pointer;
168 end;
169
ULEBnull170 function ULEB(ANum: QWord): TBytes;
SLEBnull171 function SLEB(ANum: Int64): TBytes;
AddrBnull172 function AddrB(ANum: Int64): TBytes;
AddrBnull173 function AddrB(ANum: Pointer): TBytes;
NumSnull174 function NumS(ANum: Int64; ASize: Integer): TBytes;
NumUnull175 function NumU(ANum: QWord; ASize: Integer): TBytes;
176
Bytesnull177 function Bytes(a: Array of TBytes): TBytes;
BytesLen1null178 function BytesLen1(a: Array of TBytes): TBytes;
BytesLen2null179 function BytesLen2(a: Array of TBytes): TBytes;
BytesLen4null180 function BytesLen4(a: Array of TBytes): TBytes;
BytesLen8null181 function BytesLen8(a: Array of TBytes): TBytes;
BytesLenUnull182 function BytesLenU(a: Array of TBytes): TBytes;
183
184 operator := (a: Smallint) b: TBytes;
185
186 implementation
187
188 operator := (a: Smallint)b: TBytes;
189 begin
190 assert( (a>= -128) and (a<=255));
191 SetLength(b, 1);
192 b[0] := Byte(a and 255);
193 end;
194
Bytesnull195 function Bytes(a: array of TBytes): TBytes;
196 var
197 i, l, p: Integer;
198 begin
199 l := 0;
200 for i := low(a) to high(a) do
201 l := l + Length(a[i]);
202 SetLength(Result, l);
203 p := 0;
204 for i := low(a) to high(a) do begin
205 l := Length(a[i]);
206 if l > 0 then
207 move(a[i][0], Result[p], l*SizeOf(Result[0]));
208 inc(p, l);
209 end;
210 end;
211
BytesLen1null212 function BytesLen1(a: array of TBytes): TBytes;
213 var
214 l: Integer;
215 d: TBytes;
216 begin
217 d := Bytes(a);
218 l := Length(d);
219 assert(l <= $ff);
220 Result := Bytes([Byte(l), d]);
221 end;
222
BytesLen2null223 function BytesLen2(a: array of TBytes): TBytes;
224 var
225 l: Integer;
226 b: array[0..1] of Byte;
227 d: TBytes;
228 begin
229 d := Bytes(a);
230 l := Length(d);
231 assert(l <= $ffff);
232 PWord(@b[0])^ := Word(l);
233 Result := Bytes([b[0], b[1], Bytes(d)]);
234 end;
235
BytesLen4null236 function BytesLen4(a: array of TBytes): TBytes;
237 var
238 l: Integer;
239 b: array[0..3] of Byte;
240 d: TBytes;
241 begin
242 d := Bytes(a);
243 l := Length(d);
244 assert(l <= $ffff);
245 PDWord(@b[0])^ := DWord(l);
246 Result := Bytes([b[0], b[1], b[2], b[3], Bytes(d)]);
247 end;
248
BytesLen8null249 function BytesLen8(a: array of TBytes): TBytes;
250 var
251 l: Integer;
252 b: array[0..7] of Byte;
253 d: TBytes;
254 begin
255 d := Bytes(a);
256 l := Length(d);
257 assert(l <= $ffff);
258 PQWord(@b[0])^ := QWord(l);
259 Result := Bytes([b[0], b[1], b[2], b[3], b[4], b[5], b[6], b[7], Bytes(d)]);
260 end;
261
BytesLenUnull262 function BytesLenU(a: array of TBytes): TBytes;
263 var
264 l: Integer;
265 begin
266 l := Length(a);
267 Result := Bytes([ULEB(l), Bytes(a)]);
268 end;
269
270 procedure WriteULEB128(ANum: QWord; var ADest: TBytes; ADestIdx: Integer);
271 procedure AddByte(AByte: Byte);
272 begin
273 if ADestIdx >= Length(ADest) then SetLength(ADest, ADestIdx + 1);
274 ADest[ADestIdx] := AByte;
275 inc(ADestIdx);
276 end;
277 begin
278 if ANum = 0 then begin
279 AddByte(0);
280 exit;
281 end;;
282
283 while ANum <> 0 do begin
284 if ANum > $7f then
285 AddByte((ANum and $7f) + $80)
286 else
287 AddByte((ANum and $7f));
288 ANum := ANum shr 7;
289 end;
290 end;
291
292 procedure WriteSLEB128(ANum: Int64; var ADest: TBytes; ADestIdx: Integer);
293 procedure AddByte(AByte: Byte);
294 begin
295 if ADestIdx >= Length(ADest) then SetLength(ADest, ADestIdx + 1);
296 ADest[ADestIdx] := AByte;
297 inc(ADestIdx);
298 end;
299 var
300 n: Integer;
301 c: Boolean;
302 UNum: QWord;
303 begin
304 if ANum = 0 then begin
305 AddByte(0);
306 exit;
307 end;
308
309 if ANum < 0 then begin
310 UNum := QWord(ANum);
311 n := 9*7;
312 while n > 0 do begin
313 if ( (UNum and (QWord($7f) shl n)) = (high(QWord) and (QWord($7f) shl n)) ) and
314 ( (UNum and (QWord(1) shl (n-1))) <> 0 )
315 then
316 UNum := UNum and not(high(QWord) shl n)
317 else
318 break;
319 dec(n, 7);
320 end;
321
322 while UNum <> 0 do begin
323 if UNum > $7f then
324 AddByte((UNum and $7f) + $80)
325 else
326 AddByte((UNum and $7f));
327 UNum := UNum shr 7;
328 end;
329
330 end
331 else begin
332
333 c := False;
334 while (ANum <> 0) or c do begin
335 c := (ANum and $40) <> 0; // write extra 0, to prevent sign extend
336 if c or (ANum > $7f) then
337 AddByte((ANum and $7f) + $80)
338 else
339 AddByte((ANum and $7f));
340 ANum := ANum shr 7;
341 end;
342
343 end;
344 end;
345
ULEBnull346 function ULEB(ANum: QWord): TBytes;
347 begin
348 SetLength(Result, 0);
349 WriteULEB128(ANum, Result, 0);
350 end;
351
SLEBnull352 function SLEB(ANum: Int64): TBytes;
353 begin
354 SetLength(Result, 0);
355 WriteSLEB128(ANum, Result, 0);
356 end;
357
AddrBnull358 function AddrB(ANum: Int64): TBytes;
359 begin
360 SetLength(Result, TestAddrSize);
361 if TestAddrSize = 4
362 then PInteger(@Result[0])^ := Integer(ANum)
363 else PInt64(@Result[0])^ := Int64(ANum);
364 end;
365
AddrBnull366 function AddrB(ANum: Pointer): TBytes;
367 begin
368 Result := AddrB(Int64(ANum));
369 end;
370
NumSnull371 function NumS(ANum: Int64; ASize: Integer): TBytes;
372 begin
373 SetLength(Result, ASize);
374 case ASize of
375 1: PShortInt(@Result[0])^ := ShortInt(ANum);
376 2: PSmallInt(@Result[0])^ := SmallInt(ANum);
377 4: PInteger(@Result[0])^ := Integer(ANum);
378 8: PInt64(@Result[0])^ := Int64(ANum);
379 end;
380 end;
381
NumUnull382 function NumU(ANum: QWord; ASize: Integer): TBytes;
383 begin
384 SetLength(Result, ASize);
385 case ASize of
386 1: PByte(@Result[0])^ := Byte(ANum);
387 2: PWord(@Result[0])^ := Word(ANum);
388 4: PDWord(@Result[0])^ := DWord(ANum);
389 8: PQWord(@Result[0])^ := QWord(ANum);
390 end;
391 end;
392
393 { TTestMemReader }
394
395 constructor TTestMemReader.Create;
396 var
397 i: Integer;
398 begin
399 inherited Create;
400 for i := 0 to length(RegisterSizes) - 1 do RegisterSizes[i] := 4;
401 end;
402
TTestMemReader.ReadMemorynull403 function TTestMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
404 ADest: Pointer): Boolean;
405 begin
406 Result := AnAddress > 1000; // avoid reading at 0x0000
407 if not Result then exit;
408 Move(Pointer(AnAddress)^, ADest^, ASize);
409 end;
410
ReadMemoryExnull411 function TTestMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr;
412 ASize: Cardinal; ADest: Pointer): Boolean;
413 begin
414 Result := False;
415 end;
416
TTestMemReader.ReadRegisternull417 function TTestMemReader.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr;
418 AContext: TFpDbgLocationContext): Boolean;
419 begin
420 Result := True;
421 AValue := RegisterValues[ARegNum];
422 end;
423
RegisterSizenull424 function TTestMemReader.RegisterSize(ARegNum: Cardinal): Integer;
425 begin
426 Result := RegisterSizes[ARegNum];
427 end;
428
429 { TTestDwarfInfoEntry }
430
431 procedure TTestDwarfInfoEntry.InitEncoded;
432 begin
433 SetLength(FEncoded, 0);
434 WriteULEB128(FAbbrevObj.Id, FEncoded, length(FEncoded));
435 end;
436
TTestDwarfInfoEntry.GetChildrennull437 function TTestDwarfInfoEntry.GetChildren: Byte;
438 begin
439 Result := FAbbrevObj.Children;
440 end;
441
GetTagnull442 function TTestDwarfInfoEntry.GetTag: Cardinal;
443 begin
444 Result := FAbbrevObj.Tag;
445 end;
446
447 procedure TTestDwarfInfoEntry.SetChildren(AValue: Byte);
448 begin
449 FAbbrevObj.Children := AValue;
450 end;
451
452 procedure TTestDwarfInfoEntry.SetTag(AValue: Cardinal);
453 begin
454 FAbbrevObj.Tag := AValue;
455 end;
456
TTestDwarfInfoEntry.DataLengthInclnull457 function TTestDwarfInfoEntry.DataLengthIncl: Integer;
458 var
459 i: Integer;
460 begin
461 Result := DataLength;
462 for i := 0 to FChildren.Count - 1 do
463 Result := Result + TTestDwarfInfoEntry(FChildren[i]).DataLengthIncl;
464 end;
465
466 procedure TTestDwarfInfoEntry.WriteToSection(ASectionMem: PByte; AIndex: Integer);
467 var
468 i: Integer;
469 begin
470 FWrittenAtIndex := AIndex;
471 Move(FEncoded[0], (ASectionMem+AIndex)^, Length(FEncoded));
472
473 AIndex := AIndex + Length(FEncoded);
474 if FAbbrevObj.Children <> 0 then begin
475 for i := 0 to FChildren.Count - 1 do begin
476 TTestDwarfInfoEntry(FChildren[i]).WriteToSection(ASectionMem, AIndex);
477 AIndex := AIndex + TTestDwarfInfoEntry(FChildren[i]).DataLengthIncl;
478 end;
479 PByte(ASectionMem+AIndex)^ := 0;
480 AIndex := AIndex + 1;
481 end
482 else
483 Assert(FChildren.Count = 0);
484
485 WriteToSectionFIxRef(ASectionMem);
486 end;
487
488 procedure TTestDwarfInfoEntry.WriteToSectionFIxRef(ASectionMem: PByte);
489 var
490 i: Integer;
491 v: Integer;
492 o: TTestDwarfInfoEntry;
493 begin
494 for i := 0 to Length(FRefList) - 1 do begin
495 assert((FRefList[i].AData <> nil) xor (FRefList[i].ADataRef <> nil));
496 o := FRefList[i].AData;
497 if (o = nil) then
498 o := FRefList[i].ADataRef^;
499 v := o.FWrittenAtIndex;
500 case FRefList[i].FSize of
501 1: PByte(ASectionMem + FWrittenAtIndex + FRefList[i].Index)^ := v;
502 2: PWord(ASectionMem + FWrittenAtIndex + FRefList[i].Index)^ := v;
503 4: PCardinal(ASectionMem + FWrittenAtIndex + FRefList[i].Index)^ := v;
504 8: PQWord(ASectionMem + FWrittenAtIndex + FRefList[i].Index)^ := v;
505 end;
506 end;
507
508
509 for i := 0 to FChildren.Count - 1 do
510 TTestDwarfInfoEntry(FChildren[i]).WriteToSectionFIxRef(ASectionMem);
511 end;
512
513 constructor TTestDwarfInfoEntry.Create;
514 begin
515 FChildren := TList.Create;
516 end;
517
518 destructor TTestDwarfInfoEntry.Destroy;
519 var
520 i: Integer;
521 begin
522 for i := 0 to FChildren.Count - 1 do
523 TObject(FChildren[i]).Free;
524 FreeAndNil(FChildren);
525 inherited Destroy;
526 end;
527
528 procedure TTestDwarfInfoEntry.Add(AnAttrib, AForm: Cardinal; AData: array of Byte);
529 var
530 c: Integer;
531 begin
532 if Length(FEncoded) = 0 then InitEncoded;
533 FAbbrevObj.Add(AnAttrib, AForm);
534 if Length(AData) = 0 then exit;
535 c := Length(FEncoded);
536 SetLength(FEncoded, c + Length(AData));
537 Move(AData[0], FEncoded[c], Length(AData));
538 end;
539
540 procedure TTestDwarfInfoEntry.Add(AnAttrib, AForm: Cardinal; AData: String);
541 var
542 c: Integer;
543 begin
544 if Length(FEncoded) = 0 then InitEncoded;
545 FAbbrevObj.Add(AnAttrib, AForm);
546 if Length(AData) = 0 then exit;
547 c := Length(FEncoded);
548 SetLength(FEncoded, c + Length(AData));
549 Move(AData[1], FEncoded[c], Length(AData));
550 end;
551
552 procedure TTestDwarfInfoEntry.AddSLEB(AnAttrib, AForm: Cardinal; AData: Int64);
553 begin
554 if Length(FEncoded) = 0 then InitEncoded;
555 FAbbrevObj.Add(AnAttrib, AForm);
556 WriteSLEB128(AData, FEncoded, length(FEncoded));
557 end;
558
559 procedure TTestDwarfInfoEntry.AddULEB(AnAttrib, AForm: Cardinal; AData: QWord);
560 begin
561 if Length(FEncoded) = 0 then InitEncoded;
562 FAbbrevObj.Add(AnAttrib, AForm);
563 WriteULEB128(AData, FEncoded, length(FEncoded));
564 end;
565
566 procedure TTestDwarfInfoEntry.AddAddr(AnAttrib, AForm: Cardinal; AData: QWord);
567 var
568 c: Integer;
569 begin
570 if Length(FEncoded) = 0 then InitEncoded;
571 FAbbrevObj.Add(AnAttrib, AForm);
572 if FSection.FAddrSize = 4 then begin
573 c := Length(FEncoded);
574 SetLength(FEncoded, c + 4);
575 PCardinal(@FEncoded[c])^ := AData;
576 end else begin
577 c := Length(FEncoded);
578 SetLength(FEncoded, c + 8);
579 PQWord(@FEncoded[c])^ := AData;
580 end;
581 end;
582
583 procedure TTestDwarfInfoEntry.Add(AnAttrib, AForm: Cardinal; AData: QWord);
584 begin
585 AddULEB(AnAttrib, AForm, AData);
586 end;
587
AddRefnull588 function TTestDwarfInfoEntry.AddRef(AnAttrib, AForm: Cardinal;
589 AData: TTestDwarfInfoEntry): Integer;
590 var
591 c: Integer;
592 l: Integer;
593 begin
594 if Length(FEncoded) = 0 then InitEncoded;
595 FAbbrevObj.Add(AnAttrib, AForm);
596
597 Result := length(FRefList);
598 SetLength(FRefList, Result + 1);
599
600 l := TestAddrSize;
601 case AForm of
602 DW_FORM_ref1: l := 1;
603 DW_FORM_ref2: l := 2;
604 DW_FORM_ref4: l := 4;
605 DW_FORM_ref8: l := 8;
606 DW_FORM_ref_addr: l := FSection.AddrSize;
607 //DW_FORM_ref_udata: l := 1;
608 else Assert(false);
609 end;
610
611 FRefList[Result].AData := AData;
612 FRefList[Result].FSize := l;
613 FRefList[Result].Index := length(FEncoded);
614
615 c := Length(FEncoded);
616 SetLength(FEncoded, c + l);
617 case l of
618 1: PByte(@FEncoded[c])^ := 0;
619 2: PWord(@FEncoded[c])^ := 0;
620 4: PCardinal(@FEncoded[c])^ := 0;
621 8: PQWord(@FEncoded[c])^ := 0;
622 end;
623 end;
624
AddRefnull625 function TTestDwarfInfoEntry.AddRef(AnAttrib, AForm: Cardinal;
626 AData: PTestDwarfInfoEntry): Integer;
627 var
628 c: Integer;
629 l: Integer;
630 begin
631 if Length(FEncoded) = 0 then InitEncoded;
632 FAbbrevObj.Add(AnAttrib, AForm);
633
634 Result := length(FRefList);
635 SetLength(FRefList, Result + 1);
636
637 l := TestAddrSize;
638 case AForm of
639 DW_FORM_ref1: l := 1;
640 DW_FORM_ref2: l := 2;
641 DW_FORM_ref4: l := 4;
642 DW_FORM_ref8: l := 8;
643 DW_FORM_ref_addr: l := FSection.AddrSize;
644 //DW_FORM_ref_udata: l := 1;
645 else Assert(false);
646 end;
647
648 FRefList[Result].ADataRef := AData;
649 FRefList[Result].FSize := l;
650 FRefList[Result].Index := length(FEncoded);
651
652 c := Length(FEncoded);
653 SetLength(FEncoded, c + l);
654 case l of
655 1: PByte(@FEncoded[c])^ := 0;
656 2: PWord(@FEncoded[c])^ := 0;
657 4: PCardinal(@FEncoded[c])^ := 0;
658 8: PQWord(@FEncoded[c])^ := 0;
659 end;
660 end;
661
662 procedure TTestDwarfInfoEntry.SetRef(AIndex: Integer; AData: TTestDwarfInfoEntry);
663 begin
664 FRefList[AIndex].AData := AData;
665 end;
666
TTestDwarfInfoEntry.GetNewChildnull667 function TTestDwarfInfoEntry.GetNewChild: TTestDwarfInfoEntry;
668 begin
669 Result := FSection.CreateInfoEntryObj;
670 FChildren.Add(Result);
671 end;
672
DataLengthnull673 function TTestDwarfInfoEntry.DataLength: Integer;
674 begin
675 if Length(FEncoded) = 0 then InitEncoded;
676 Result := Length(FEncoded);
677 if Children <> 0 then Result := Result + 1;
678 end;
679
TTestDwarfInfoEntry.Datanull680 function TTestDwarfInfoEntry.Data: Pointer;
681 begin
682 if Length(FEncoded) = 0 then InitEncoded;
683 Result := @FEncoded;
684 end;
685
686 { TTestDummySectionInfoEntries }
687
CreateInfoEntryObjnull688 function TTestDummySectionInfoEntries.CreateInfoEntryObj: TTestDwarfInfoEntry;
689 begin
690 Result := TTestDwarfInfoEntry.Create;
691 Result.FSection := Self;
692 assert(AbbrevSection <> nil);
693 Result.FAbbrevObj := AbbrevSection.GetNewAbbrevObj;
694 end;
695
696 constructor TTestDummySectionInfoEntries.Create;
697 begin
698 FVersion := 2;
699 FAddrSize := TestAddrSize;
700 end;
701
702 destructor TTestDummySectionInfoEntries.Destroy;
703 begin
704 FreeAndNil(FFirstEntry);
705 if Section.RawData <> nil then
706 Freemem(Section.RawData);
707 inherited Destroy;
708 end;
709
GetFirstInfoEntryObjnull710 function TTestDummySectionInfoEntries.GetFirstInfoEntryObj: TTestDwarfInfoEntry;
711 begin
712 if FFirstEntry= nil then
713 FFirstEntry := CreateInfoEntryObj;
714 Result := FFirstEntry;
715 end;
716
717 procedure TTestDummySectionInfoEntries.CreateSectionData;
718 var
719 l: Integer;
720 begin
721 l := FFirstEntry.DataLengthIncl + 11; // 32 bit 4,2,4,1
722
723 Section.Size := l;
724 Section.RawData := AllocMem(l);
725
726 PCardinal(Section.RawData)^ := l - 4;
727 PWord(Section.RawData+4)^ := FVersion;
728 PCardinal(Section.RawData+6)^ := 0;
729 PByte(Section.RawData+10)^ := FAddrSize;
730
731 FFirstEntry.WriteToSection(Section.RawData, 11);
732 end;
733
734 { TTestDwarfAbbrev }
735
736 procedure TTestDwarfAbbrev.Encode;
737 var
738 i: Integer;
739 begin
740 if length(FEncoded) > 0 then
741 exit;
742 WriteULEB128(FId, FEncoded, 0);
743 WriteULEB128(FTag, FEncoded, length(FEncoded));
744 WriteULEB128(FChildren, FEncoded, length(FEncoded)); // 0 or 1 / 1 byte
745 for i := 0 to Length(FData)-1 do
746 WriteULEB128(FData[i], FEncoded, length(FEncoded));
747 WriteULEB128(0, FEncoded, length(FEncoded));
748 WriteULEB128(0, FEncoded, length(FEncoded));
749 end;
750
751 procedure TTestDwarfAbbrev.Add(ATag, AForm: Cardinal);
752 var
753 c: Integer;
754 begin
755 c := Length(FData);
756 SetLength(FData, c + 2);
757 FData[c] := ATag;
758 FData[c+1] := AForm;
759 end;
760
TTestDwarfAbbrev.DataLengthnull761 function TTestDwarfAbbrev.DataLength: Integer;
762 begin
763 Encode;
764 Result := Length(FEncoded);
765 end;
766
TTestDwarfAbbrev.Datanull767 function TTestDwarfAbbrev.Data: Pointer;
768 begin
769 Encode;
770 Result := @FEncoded[0];
771 end;
772
773
774 { TTestDummySection }
775
776 procedure TTestDummySection.CreateSectionData;
777 begin
778 //
779 end;
780
781 { TTestDummyFileSource }
782
GetTestSectionnull783 function TTestDummyFileSource.GetTestSection(const AName: String): TTestDummySection;
784 var
785 i: Integer;
786 t: TTestDummySectionInfoEntries;
787 begin
788 Result := nil;
789 i := FSections.IndexOf(AName);
790 if i < 0 then begin
791 if AName = '.debug_abbrev' then
792 i := FSections.AddObject(AName, TTestDummySectionAbbrevs.Create)
793 else
794 if AName = '.debug_info' then begin
795 t := TTestDummySectionInfoEntries.Create;
796 t.AbbrevSection := GetTestSection('.debug_abbrev') as TTestDummySectionAbbrevs;
797 i := FSections.AddObject(AName, t);
798 end
799 else
800 i := FSections.AddObject(AName, TTestDummySection.Create);
801 end;
802 Result := TTestDummySection(FSections.Objects[i]);
803 end;
804
GetSectionnull805 function TTestDummyFileSource.GetSection(const AName: String): PDbgImageSection;
806 var
807 i: Integer;
808 tmp: TTestDummySection;
809 begin
810 Result := nil;
811 i := FSections.IndexOf(AName);
812 if i < 0 then
813 exit;
814 tmp := TTestDummySection(FSections.Objects[i]);
815 Result := @tmp.Section;
816 end;
817
TTestDummyFileSource.isValidnull818 class function TTestDummyFileSource.isValid(ASource: TDbgFileLoader): Boolean;
819 begin
820 Result := True;
821 end;
822
TTestDummyFileSource.UserNamenull823 class function TTestDummyFileSource.UserName: AnsiString;
824 begin
825 Result := 'Test Source';
826 end;
827
828 constructor TTestDummyFileSource.Create;
829 begin
830 inherited Create(nil, nil, False);
831 FSections := TStringList.Create;
832 end;
833
834 destructor TTestDummyFileSource.Destroy;
835 var
836 i: Integer;
837 begin
838 for i := 0 to FSections.Count - 1 do
839 FSections.Objects[i].Free;
840 FreeAndNil(FSections);
841 inherited Destroy;
842 end;
843
844 { TTestDummyImageLoader }
845
846 constructor TTestDummyImageLoader.Create;
847 begin
848 FImgReader := TTestDummyFileSource.Create;
849 ImgReader := FImgReader; // vill be destroyed by base
850 inherited Create;
851 end;
852
853 { TTestDummySectionAbbrevs }
854
GetNextIDnull855 function TTestDummySectionAbbrevs.GetNextID: Cardinal;
856 begin
857 Result := FCurrentID;
858 inc(FCurrentID);
859 end;
860
861 constructor TTestDummySectionAbbrevs.Create;
862 begin
863 FList := TList.Create;
864 Section.Size := 0;
865 Section.RawData := nil;
866 FCurrentID := 1;;
867 end;
868
869 destructor TTestDummySectionAbbrevs.Destroy;
870 begin
871 while FList.Count > 0 do begin
872 TObject(FList[0]).Free;
873 FList.Delete(0);
874 end;
875 FreeAndNil(FList);
876 if Section.RawData <> nil then
877 Freemem(Section.RawData);
878 inherited Destroy;
879 end;
880
GetNewAbbrevObjnull881 function TTestDummySectionAbbrevs.GetNewAbbrevObj: TTestDwarfAbbrev;
882 begin
883 Result := TTestDwarfAbbrev.Create;
884 Result.FSection := Self;
885 Result.Id := GetNextID;
886 FList.Add(Result);
887 end;
888
889 procedure TTestDummySectionAbbrevs.CreateSectionData;
890 var
891 i, j, l: Integer;
892 begin
893 l := 1; // one for zero at end
894 for i := 0 to FList.Count - 1 do
895 l := l + TTestDwarfAbbrev(FList[i]).DataLength;
896
897 Section.Size := l;
898 Section.RawData := AllocMem(l);
899
900 j := 0;
901 for i := 0 to FList.Count - 1 do begin
902 l := TTestDwarfAbbrev(FList[i]).DataLength;
903 move(TTestDwarfAbbrev(FList[i]).Data^, (Section.RawData+j)^, l);
904 j := j + l;
905 end;
906
907 PByte(Section.RawData+j)^ := 0;
908 assert(j < Section.Size);
909 end;
910
911 end.
912
913