File Coverage

blib/lib/Parse/Readelf/Debug/Info.pm
Criterion Covered Total %
statement 271 276 98.1
branch 227 252 90.0
condition 144 180 80.0
subroutine 12 12 100.0
pod 4 4 100.0
total 658 724 90.8


line stmt bran cond sub pod time code
1             package Parse::Readelf::Debug::Info;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             Parse::Readelf::Debug::Info - handle readelf's debug info section with a class
8              
9             =head1 SYNOPSIS
10              
11             use Parse::Readelf::Debug::Info;
12              
13             my $debug_info = new Parse::Readelf::Debug::Info($executable);
14              
15             my @item_ids = $debug_info->item_ids('l_object2a');
16             my @structure_layout1 = $debug_info->structure_layout($item_ids[0]);
17             my @some_item_ids = $debug_info->item_ids_matching('^var', 'variable');
18             my @all_item_ids = $debug_info->item_ids_matching('');
19             my @all_struct_ids = $debug_info->item_ids_matching('', '.*structure.*');
20              
21             =head1 ABSTRACT
22              
23             Parse::Readelf::Debug::Info parses the output of C
24             --debug-dump=info> and stores its interesting details in an object to
25             ease access.
26              
27             =head1 DESCRIPTION
28              
29             Normally an object of this class is constructed with the file name of
30             an object file to be parsed. Upon construction the file is analysed
31             and all relevant information about its debug info section is stored
32             inside of the object. This information can be accessed afterwards
33             using a bunch of getter methods, see L for details.
34              
35             AT THE MOMENT ONLY INFORMATION REGARDING THE BINARY ARRANGEMENT OF
36             VARIABLES (STRUCTURE LAYOUT) IS SUPPORTED. Other data is ignored for
37             now.
38              
39             Currently only output for B is supported.
40             Please contact the author for other versions and provide some example
41             C outputs.
42              
43             =cut
44              
45             #########################################################################
46              
47 3     3   749 use 5.006001;
  3         9  
48 3     3   13 use strict;
  3         6  
  3         62  
49 3     3   14 use warnings;
  3         3  
  3         88  
50 3     3   15 use Carp;
  3         5  
  3         181  
51              
52             our $VERSION = '0.19';
53              
54 3     3   514 use Parse::Readelf::Debug::Line;
  3         5  
  3         7359  
55              
56             #########################################################################
57              
58             =head1 EXPORT
59              
60             Nothing is exported by default as it's normally not needed to modify
61             any of the variables declared in the following export groups:
62              
63             =head2 :all
64              
65             all of the following groups
66              
67             =cut
68              
69             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
70              
71             require Exporter;
72              
73             our @ISA = qw(Exporter);
74             our @EXPORT = qw();
75              
76             our %EXPORT_TAGS =
77             (command => [ qw($command) ],
78             config => [ qw($display_nested_items $re_substructure_filter) ],
79             constants => [ qw($LEVEL $NAME $TYPE $SIZE $LOCATION $OFFSET
80             $BITSIZE $BITOFFSET) ],
81             fixed_regexps => [ qw($re_section_start
82             $re_section_stop
83             $re_unit_offset
84             $re_dwarf_version
85             $re_unit_signature
86             $re_type_offset) ],
87             versioned_regexps => [ qw(@re_item_start
88             @re_abstract_origin
89             @re_alignment
90             @re_bit_offset
91             @re_bit_size
92             @re_byte_size
93             @re_comp_dir
94             @re_const_expt
95             @re_const_value
96             @re_containing_type
97             @re_decl_file
98             @re_decl_line
99             @re_declaration
100             @re_default_value
101             @re_encoding
102             @re_external
103             @re_language
104             @re_linkage_name_tag
105             @re_location
106             @re_member_location
107             @re_name_tag
108             @re_producer
109             @re_signature_tag
110             @re_specification
111             @re_type
112             @re_upper_bound
113             @re_ignored_attributes
114             @tag_needs_attributes
115             @ignored_tags) ]
116             );
117             $EXPORT_TAGS{all} = [ map { @$_ } values(%EXPORT_TAGS) ];
118              
119             our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );
120              
121             #########################################################################
122              
123             =head2 :command
124              
125             =over
126              
127             =item I<$command>
128              
129             is the variable holding the command to run C to get the
130             information relevant for this module, normally C
131             --debug-dump=line>.
132              
133             =back
134              
135             =cut
136              
137             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
138              
139             our $command = 'readelf --debug-dump=info';
140              
141             #########################################################################
142              
143             =head2 :config
144              
145             =over
146              
147             =item I<$display_nested_items>
148              
149             is a variable which controls if nested items (e.g. sub-structures) are
150             not displayed unless actually used (e.g. as data type of members of
151             their parent) or if they are always displayed - which might confuse
152             the reader. The default is 0, any other value switches on the
153             unconditional display.
154              
155             =item I<$re_substructure_filter>
156              
157             is a regular expression that allows you to cut away the details of all
158             substructures whose type names match the filter. This is useful if
159             you have a bunch of types that you consider so basic that you like to
160             blend out their details, e.g. the internal representation of a complex
161             number datatype. The filter has the value C<^string$> for C++
162             standard strings as default.
163              
164             =back
165              
166             =cut
167              
168             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
169              
170             our $display_nested_items = 0;
171              
172             our $re_substructure_filter = '^string$';
173              
174             #########################################################################
175              
176             =head2 :constants
177              
178             The following constants can be used to access the elements of the
179             result of the method L (see below).
180              
181             =over
182              
183             =item I<$LEVEL>
184              
185             =item I<$NAME>
186              
187             =item I<$TYPE>
188              
189             =item I<$SIZE>
190              
191             =item I<$LOCATION>
192              
193             =item I<$OFFSET>
194              
195             =item I<$BITSIZE>
196              
197             =item I<$BITOFFSET>
198              
199             =back
200              
201             =cut
202              
203             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
204              
205             our $LEVEL = 0;
206             our $NAME = 1;
207             our $TYPE = 2;
208             our $SIZE = 3;
209             our $LOCATION = 4;
210             our $OFFSET = 5;
211             our $BITSIZE = 6;
212             our $BITOFFSET = 7;
213              
214             #########################################################################
215              
216             =head2 :fixed_regexps
217              
218             =over
219              
220             =item I<$re_section_start>
221              
222             is the regular expression that recognises the start of the info debug
223             output of C.
224              
225             =item I<$re_section_stop>
226              
227             is the regular expression that recognises the start of another debug
228             output of C.
229              
230             =item I<$re_unit_offset>
231              
232             is the regular expression that recognises the first line of a
233             compilation unit in an info debug output of C. This line
234             states the offset of the compilation unit itself. So this offset must
235             be a hexadecimal string which will (must) be stored in C<$1> without
236             any leading C<0x>. Usually it's 0 for the first unit.
237              
238             =item I<$re_dwarf_version>
239              
240             is the regular expression that recognises the Dwarf version line in an
241             info debug output of C. The version number must be an
242             integer number which will (must) be stored in C<$1>.
243              
244             =item I<$re_unit_signature>
245              
246             is the regular expression that recognises the hexadecimal signature
247             line at the start of a compilation unit in an info debug output of
248             C. The signature ID must be a string which will (must) be
249             stored in C<$1>.
250              
251             =item I<$re_type_offset>
252              
253             is the regular expression that recognises the type offset line at the
254             start of a compilation unit in an info debug output of C.
255             The offset must be a string which will (must) be stored in C<$1>
256             without any leading C<0x>.
257              
258             =back
259              
260             =cut
261              
262             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
263              
264             our $re_section_start =
265             qr(^The section \.debug_info contains:|^Contents of the \.debug_(?:info|types) section:);
266              
267             our $re_section_stop =
268             qr(^The section \.debug_.* contains:|^Contents of the \.debug_.* section:|^(?:Raw dump|Dump) of debug contents of section \.debug_line:);
269              
270             our $re_unit_offset = qr(^\s*Compilation Unit\s.*\soffset\s+(?:0x)?([0-9a-f]+));
271              
272             our $re_dwarf_version = qr(^\s*Version:\s+(\d+)\s*$);
273              
274             our $re_unit_signature = qr(^\s*Signature:\s+([0-9a-f]+)\s*$);
275              
276             our $re_type_offset = qr(^\s*Type Offset:\s+(?:0x)?([0-9a-f]+)\s*$);
277              
278             #########################################################################
279              
280             =head2 :versioned_regexps
281              
282             These regular expressions are those that recognise the (yet) supported
283             tags of the item nodes of a readelf debug info output. Each of them
284             is actually a list using the Dwarf version as index:
285              
286             =over
287              
288             =item I<@re_item_start>
289              
290             recognises the start of a new item in the debug info list. C<$1> is
291             the level, C<$2> the internal (unique) item ID, C<$3> the numeric type
292             ID and C<$4> the type tag.
293              
294             =item I<@re_bit_offset>
295              
296             recognises the bit offset tag of an item. C<$1> will contain the offset.
297              
298             =item I<@re_bit_size>
299              
300             recognises the bit size tag of an item. C<$1> will contain the size.
301              
302             =item I<@re_byte_size>
303              
304             recognises the byte size tag of an item. C<$1> will contain the size.
305              
306             =item I<@re_comp_dir>
307              
308             recognises the compilation directory tag of an item. C<$1> will
309             contain the compilation directory as string.
310              
311             =item I<@re_const_value>
312              
313             recognises the const value tag of an item. C<$1> will contain the value.
314              
315             =item I<@re_containing_type>
316              
317             recognises the containing type tag of an item. Either C<$1> will
318             contain the normal internal item ID or C will contain the Dwarf-4
319             signature of the containing type.
320              
321             =item I<@re_decl_file>
322              
323             recognises the declaration file tag of an item. C<$1> will contain
324             the number of the file name (see L).
325              
326             =item I<@re_decl_line>
327              
328             recognises the declaration line tag of an item. C<$1> will contain
329             the line number.
330              
331             =item I<@re_declaration>
332              
333             recognises the declaration tag of an item. C<$1> will usually contain a
334             1 indicating that it is set.
335              
336             =item I<@re_encoding>
337              
338             recognises the encoding tag of an item. C<$1> will contain the
339             encoding as text.
340              
341             =item I<@re_external>
342              
343             recognises the external tag of an item. C<$1> will usually contain a
344             1 indicating that it is set.
345              
346             =item I<@re_language>
347              
348             recognises the language tag of an item. C<$1> will contain the
349             language as text.
350              
351             =item I<@re_linkage_name_tag>
352              
353             recognises the linkage name tag of an item. C<$1> will contain the
354             name.
355              
356             =item I<@re_location>
357              
358             recognises the data member location tag of an item. C<$1> will
359             contain the offset.
360              
361             =item I<@re_member_location>
362              
363             recognises the data location tag of an item. C<$1> will contain the
364             hex value (with spaces between each byte).
365              
366             =item I<@re_name_tag>
367              
368             recognises the name tag of an item. C<$1> will contain the name.
369              
370             =item I<@re_producer>
371              
372             recognises the producer tag of an item. C<$1> will contain the
373             producer as string.
374              
375             =item I<@re_signature_tag>
376              
377             recognises the signature tag of an item. C<$1> will contain the
378             leading C<<0x> in case of a signature refering to the same compilation
379             unit, C<$2> will contain the hexadecimal signature.
380              
381             =item I<@re_specification>
382              
383             recognises the specification tag of an item. C<$1> will contain the
384             internal item ID of the specification.
385              
386             =item I<@re_type>
387              
388             recognises the type tag of an item. Either C<$1> will contain the
389             normal internal item ID or C will contain the Dwarf-4 signature of
390             the type.
391              
392             =item I<@re_upper_bound>
393              
394             recognises the upper bound tag of a subrange item. C<$1> will contain
395             the upper bound.
396              
397             =item I<@re_ignored_attributes>
398              
399             recognises all attributes that are simply ignored (yet).
400              
401             =back
402              
403             The last two lists are a bit different, they control what is parsed by
404             this module. They are also arrays using the Dwarf version as index.
405             What is inside each of this arrays is described below:
406              
407             =over
408              
409             =item I<@tag_needs_attributes>
410              
411             holds hashes of the type tags that are processed. Each element points
412             to a list of the absolutely needed attributes for that type of item.
413              
414             =item I<@ignored_tags>
415              
416             is a list of the type tags (see C<@re_item_start> above) that are
417             currently ignored.
418              
419             =back
420              
421             =cut
422              
423             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
424              
425             our @re_item_start =
426             ( undef, undef,
427             qr'^\s*<(\d+)><([0-9A-F]+)>:\s+abbrev\s+number:\s+(\d+)\s+\((.*)\)'i,
428             undef,
429             qr'^\s*<(\d+)><([0-9A-F]+)>:\s+abbrev\s+number:\s+(\d+)\s+\((.*)\)'i
430             );
431              
432             our @re_abstract_origin =
433             ( undef, undef,
434             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_abstract_origin\s*:\s+<(?:0x)?([0-9A-F]+)>)i,
435             undef,
436             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_abstract_origin\s*:\s+<(?:0x)?([0-9A-F]+)>)i
437             );
438              
439             our @re_alignment =
440             ( undef, undef,
441             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_alignment\s*:\s+(\d+))i,
442             undef,
443             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_alignment\s*:\s+(\d+))i
444             );
445              
446             our @re_bit_offset =
447             ( undef, undef,
448             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_bit_offset\s*:\s+(\d+))i,
449             undef,
450             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_bit_offset\s*:\s+(\d+))i
451             );
452              
453             our @re_bit_size =
454             ( undef, undef,
455             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_bit_size\s*:\s+(\d+))i,
456             undef,
457             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_bit_size\s*:\s+(\d+))i
458             );
459              
460             our @re_byte_size =
461             ( undef, undef,
462             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_byte_size\s*:\s+((?:0x)?[0-9A-F]+))i,
463             undef,
464             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_byte_size\s*:\s+((?:0x)?[0-9A-F]+))i
465             );
466              
467             our @re_comp_dir =
468             ( undef, undef,
469             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_comp_dir\s*:(?:.+:)?\s+(.+))i,
470             undef,
471             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_comp_dir\s*:(?:.+:)?\s+(.+))i
472             );
473              
474             our @re_const_expr =
475             ( undef, undef,
476             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_const_expr\s*:\s+(\d+))i,
477             undef,
478             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_const_expr\s*:\s+(\d+))i
479             );
480              
481             our @re_const_value =
482             ( undef, undef,
483             qr{^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_const_value\s*:\s+(0x[0-9a-f]+(?: 0x[0-9a-f]+)?|[1-9]\d* byte block:(?: [0-9a-f]+)+|[-1-9]\d*|\*|ALL|\(indirect string, .*|\w{1,4})\s*$}i,
484             undef,
485             qr{^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_const_value\s*:\s+(0x[0-9a-f]+(?: 0x[0-9a-f]+)?|[1-9]\d* byte block:(?: [0-9a-f]+)+|[-1-9]\d*|\*|ALL|\(indirect string, .*|\w{1,4})\s*$}i
486             );
487              
488             our @re_containing_type =
489             ( undef, undef,
490             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_containing_type\s*:\s+<(?:0x)?([0-9A-F]+)>)i,
491             undef,
492             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_containing_type\s*:\s+(?:<(?:0x)?([0-9A-F]+)>|signature\s*:\s+([0-9A-F]+)))i
493             );
494              
495             our @re_decl_file =
496             ( undef, undef,
497             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_decl_file\s*:\s+(\d+))i,
498             undef,
499             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_decl_file\s*:\s+(\d+))i
500             );
501              
502             our @re_decl_line =
503             ( undef, undef,
504             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_decl_line\s*:\s+(\d+))i,
505             undef,
506             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_decl_line\s*:\s+(\d+))i
507             );
508              
509             our @re_declaration =
510             ( undef, undef,
511             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_declaration\s*:\s+(\d+))i,
512             undef,
513             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_declaration\s*:\s+(\d+))i
514             );
515              
516             our @re_default_value =
517             ( undef, undef,
518             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_default_value\s*:\s+(\d+))i,
519             undef,
520             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_default_value\s*:\s+(\d+))i
521             );
522              
523             our @re_encoding =
524             ( undef, undef,
525             qr'^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_encoding\s*:\s+\d+\s+\(([a-z ]+)\)'i,
526             undef,
527             qr'^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_encoding\s*:\s+\d+\s+\(([a-z ]+)\)'i
528             );
529              
530             our @re_external =
531             ( undef, undef,
532             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_external\s*:\s+(\d+))i,
533             undef,
534             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_external\s*:\s+(\d+))i
535             );
536              
537             our @re_language =
538             ( undef, undef,
539             qr'^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_language\s*:\s+\d+\s+\((.+)\)'i,
540             undef,
541             qr'^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_language\s*:\s+\d+\s+\((.+)\)'i
542             );
543              
544             our @re_linkage_name_tag =
545             ( undef, undef,
546             undef, # new in Dwarf-4?
547             undef,
548             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_linkage_name\b.*:\s+(.*[\w>]))i
549             );
550              
551             our @re_location =
552             ( undef, undef,
553             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_location\s*:\s*\d+ byte block:\s+([[:xdigit:]]{1,2}(?: [[:xdigit:]]{1,2})*)\s+\W)i,
554             undef,
555             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_location\s*:\s*\d+ byte block:\s+([[:xdigit:]]{1,2}(?: [[:xdigit:]]{1,2})*)\s+\W)i
556             );
557              
558             our @re_member_location =
559             ( undef, undef,
560             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_data_member_location:.*DW_OP_(?:(?:plus_uconst|const1u):\s+(\d+))?)i,
561             undef,
562             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_data_member_location:\s+(0x[0-9a-f]+|\d+))i
563             );
564              
565             our @re_name_tag =
566             ( undef, undef,
567             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_name\b.*:\s+(.*[\w>]))i,
568             undef,
569             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_name\b.*:\s+(.*[\w>]))i
570             );
571              
572             our @re_producer =
573             ( undef, undef,
574             qr'^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_producer\s*:(?:\s+\(.+\):)?\s+(.+)'i,
575             undef,
576             qr'^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_producer\s*:(?:\s+\(.+\):)?\s+(.+)'i
577             );
578              
579             our @re_signature_tag =
580             ( undef, undef,
581             undef, # new in Dwarf-4?
582             undef,
583             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_signature\b.*:\s+(<0x)?([0-9A-F]+)>?)i
584             );
585              
586             our @re_specification =
587             ( undef, undef,
588             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_specification\s*:\s+<(?:0x)?([0-9A-F]+)>)i,
589             undef,
590             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_specification\s*:\s+<(?:0x)?([0-9A-F]+)>)i
591             );
592              
593             our @re_type =
594             ( undef, undef,
595             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_type\s*:\s+<(?:0x)?([0-9A-F]+)>)i,
596             undef,
597             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_type\s*:\s+(?:<(?:0x)?([0-9A-F]+)>|signature\s*:\s+([0-9A-F]+)))i
598             );
599              
600             our @re_upper_bound =
601             ( undef, undef,
602             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_upper_bound\s*:\s+(\d+))i,
603             undef,
604             qr(^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_upper_bound\s*:\s+(\d+))i
605             );
606              
607 3         948 use constant IGNORED_ATTRIBUTES => qw(GNU_macros
608             accessibility
609             artificial
610             encoding
611             entry_pc
612             high_pc
613             low_pc
614             macro_info
615             MIPS_linkage_name
616             producer
617             ranges
618             sibling
619             stmt_list
620 3     3   22 virtuality);
  3         5  
621             our @re_ignored_attributes =
622             ( undef, undef,
623             '^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_(?:(?:'.
624             join('|', IGNORED_ATTRIBUTES).
625             ')\b|location\s*:\s*0x)',
626             undef,
627             '^\s*(?:<[0-9A-F ]+>)?\s*DW_AT_(?:(?:'.
628             join('|', IGNORED_ATTRIBUTES).
629             ')\b|location\s*:\s*0x)'
630             );
631              
632             our @tag_needs_attributes =
633             (
634             undef,
635             undef,
636             {
637             # Note that in combination with a C typedef the name is often missing!
638             DW_TAG_array_type => [ qw(type) ],
639             DW_TAG_base_type => [ qw(name) ],
640             DW_TAG_class_type => [],
641             DW_TAG_const_type => [ qw(type) ],
642             DW_TAG_compile_unit => [ qw(name) ],
643             DW_TAG_enumerator => [ qw(name) ],
644             DW_TAG_enumeration_type => [ qw(byte_size) ],
645             DW_TAG_formal_parameter => [ qw(type) ],
646             DW_TAG_inheritance => [qw(type member_location)],
647             DW_TAG_member => [ qw(name type member_location) ],
648             DW_TAG_pointer_type => [ qw(byte_size) ],
649             DW_TAG_ptr_to_member_type => [ qw(containing_type) ],
650             DW_TAG_reference_type => [ qw(type byte_size) ],
651             DW_TAG_rvalue_reference_type => [ qw(type byte_size) ],
652             DW_TAG_structure_type => [],
653             DW_TAG_subrange_type => [ qw(upper_bound) ],
654             DW_TAG_template_type_param => [ qw(name byte_size) ],
655             DW_TAG_template_value_param => [ qw(name type) ],
656             DW_TAG_typedef => [ qw(name type) ],
657             DW_TAG_union_type => [ qw(byte_size) ],
658             DW_TAG_unspecified_type => [ qw(name) ],
659             DW_TAG_variable => [ qw(name type) ],
660             DW_TAG_volatile_type => [ qw(type) ]
661             },
662             undef,
663             {
664             # Note that in combination with a C typedef the name is often missing!
665             DW_TAG_array_type => [ qw(type) ],
666             DW_TAG_base_type => [ qw(name) ],
667             DW_TAG_class_type => [],
668             DW_TAG_const_type => [ qw(type) ],
669             DW_TAG_compile_unit => [ qw(name) ],
670             DW_TAG_enumerator => [ qw(name) ],
671             DW_TAG_enumeration_type => [ qw(byte_size) ],
672             DW_TAG_formal_parameter => [ qw(type) ],
673             DW_TAG_inheritance => [qw(type member_location)],
674             DW_TAG_member => [ qw(name type member_location) ],
675             DW_TAG_pointer_type => [ qw(byte_size) ],
676             DW_TAG_ptr_to_member_type => [ qw(containing_type) ],
677             DW_TAG_reference_type => [ qw(type byte_size) ],
678             DW_TAG_rvalue_reference_type => [ qw(type byte_size) ],
679             DW_TAG_structure_type => [],
680             DW_TAG_subrange_type => [ qw(upper_bound) ],
681             DW_TAG_template_type_param => [ qw(name byte_size) ],
682             DW_TAG_template_value_param => [ qw(name type) ],
683             DW_TAG_typedef => [ qw(name type) ],
684             DW_TAG_union_type => [ qw(byte_size) ],
685             DW_TAG_unspecified_type => [ qw(name) ],
686             DW_TAG_variable => [ qw(name type) ],
687             DW_TAG_volatile_type => [ qw(type) ]
688             }
689             );
690              
691             our @ignored_tags =
692             (
693             undef,
694             undef,
695             [
696             qw(
697             DW_TAG_GNU_call_site
698             DW_TAG_GNU_call_site_parameter
699             DW_TAG_inlined_subroutine
700             DW_TAG_imported_declaration
701             DW_TAG_imported_module
702             DW_TAG_label
703             DW_TAG_lexical_block
704             DW_TAG_namespace
705             DW_TAG_subprogram
706             DW_TAG_subroutine_type
707             DW_TAG_unspecified_parameters
708             ),
709             'Unknown TAG value: 4109',
710             'Unknown TAG value: 410a'
711             ],
712             undef,
713             [
714             qw(
715             DW_TAG_GNU_call_site
716             DW_TAG_GNU_call_site_parameter
717             DW_TAG_dwarf_procedure
718             DW_TAG_inlined_subroutine
719             DW_TAG_imported_declaration
720             DW_TAG_imported_module
721             DW_TAG_inheritance
722             DW_TAG_label
723             DW_TAG_lexical_block
724             DW_TAG_namespace
725             DW_TAG_restrict_type
726             DW_TAG_subprogram
727             DW_TAG_subroutine_type
728             DW_TAG_type_unit
729             DW_TAG_unspecified_parameters
730             ),
731             'Unknown TAG value: 4109',
732             'Unknown TAG value: 410a'
733             ]
734             );
735              
736             # list of attributes holding readelf hexadecimal IDs that must be
737             # remapped in Dwarf-4 compilation units with signatures:
738 3     3   33 use constant ID_ATTRIBUTES => qw(sibling specification type);
  3         5  
  3         171  
739              
740             # list of attributes that may hold a signature instead of an ID in
741             # Dwarf-4:
742 3     3   18 use constant SIGNATURE_ATTRIBUTES => qw(signature type);
  3         3  
  3         10738  
743              
744             #########################################################################
745              
746             =head2 new - get readelf's debug info section into an object
747              
748             $debug_info = new Parse::Readelf::Debug::Info($file_name,
749             [$line_info]);
750              
751             =head3 example:
752              
753             $debug_info1 = new Parse::Readelf::Debug::Info('program');
754             $line_info = new Parse::Readelf::Debug::Line('module.o');
755             $debug_info2 = new Parse::Readelf::Debug::Info('module.o',
756             $line_info);
757              
758             =head3 parameters:
759              
760             $file_name name of executable or object file
761             $line_info a L object
762              
763             =head3 description:
764              
765             This method parses the output of C and
766             stores its interesting details internally to be accessed later by
767             getter methods described below.
768              
769             If no L object is passed as second
770             parameter the method creates one internally at it is needed to
771             locate the source files.
772              
773             =head3 global variables used:
774              
775             The method uses all of the variables described above in the
776             L section.
777              
778             =head3 returns:
779              
780             The method returns the blessed Parse::Readelf::Debug::Info object
781             or an exception in case of an error.
782              
783             =cut
784              
785             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
786             sub new($$;$)
787             {
788 24     24 1 31607 my $this = shift;
789 24   100     328 my $class = ref($this) || $this;
790 24         86 my ($file_name, $line_info) = @_;
791 24         209 my %self = (line_info => $line_info,
792             items => [],
793             item_map => {},
794             name_map => {});
795 24         50 local $_;
796              
797             # checks:
798 24 100       89 if (! $file_name)
799 1         135 { croak 'bad call to new of ', __PACKAGE__ }
800 23 100       59 if (ref($this))
801 1         284 { carp 'cloning of a ', __PACKAGE__, ' object is not supported' }
802 23 100       737 if (! -f $file_name)
803 1         115 { croak __PACKAGE__, " can't find ", $file_name }
804 22 100 100     124 if (defined $line_info and
805             ref($line_info) ne 'Parse::Readelf::Debug::Line')
806 1         88 { croak 'bad Parse::Readelf::Debug::Line object passed to ', __PACKAGE__ }
807              
808             # first get debug line section parsed:
809 21 100       151 $self{line_info} = new Parse::Readelf::Debug::Line($file_name)
810             unless defined $line_info;
811              
812             # call readelf and prepare parsing output:
813 21 100       38658 open READELF, '-|', $command.' '.$file_name or
814             croak "can't parse ", $file_name, ' with "', $command, '" in ',
815             __PACKAGE__, ': ', $!;
816              
817             # find start of section:
818 20         12476 while ()
819 160 100       1359 { last if m/$re_section_start/; }
820              
821             # parse section:
822 20         132 my $version = -1;
823 20         54 my $unit_offset = 0;
824 20         126 my $signature = '';
825 20         202 my $type_offset = '';
826 20         259 my @level_stack = (undef);
827 20         54 my $item = undef;
828 20         33 my $needed_attributes = undef;
829 20         42 my %is_ignored = ();
830 20         46 my $tag_needs_attributes = undef;
831 20         56 my $compilation_unit = -1;
832 20         47 my %compilation_unit_list = ();
833 20         42 my $end_of_section = 0;
834 20         267 while ()
835             {
836 89120 100       412766 if (m/$re_dwarf_version/)
    100          
    100          
    100          
837             {
838 114         342 $version = $1;
839 114 100       879 confess 'DWARF version ', $version, ' not supported in ',
840             __PACKAGE__
841             unless defined $re_item_start[$version];
842 113         225 %is_ignored = map { $_ => 1 } @{$ignored_tags[$version]};
  1821         5460  
  113         576  
843 113         357 $tag_needs_attributes = $tag_needs_attributes[$version];
844 113         269 $compilation_unit++;
845 113         245 $signature = $type_offset = '';
846             }
847             elsif (m/$re_unit_offset/)
848             {
849 114         470 $unit_offset = hex($1);
850             }
851             elsif (m/$re_unit_signature/)
852             {
853 84         276 $signature = $1;
854             }
855             elsif (m/$re_type_offset/)
856             {
857 84 50       224 $signature
858             or confess 'internal error: type offset without previous ',
859             'signature at input line ', $., ' in ', __PACKAGE__;
860 84         416 $type_offset = sprintf("%x", $unit_offset + hex($1));
861             }
862 89119 100       139160 next unless $version >= 0;
863              
864             # stop at end of section (preparation):
865 89065 100 100     500190 if (m/$re_section_stop/ and not m/$re_section_start/ or eof READELF)
      100        
866             {
867 17         8325 my $dummy = grep /nothing/, ; # avoid SIGPIPE in close
868 17         606 $end_of_section = 1;
869             }
870              
871             # handle the beginning (and therefore the change) of an item:
872 89065 100 100     1799511 if ($end_of_section or m/$re_item_start[$version]/i)
    100 100        
    100 100        
    50          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
873             {
874             # check if item is complete and store it:
875 19905 100       34992 if (defined $item)
876             {
877             # fix IDs in compilation units with signature:
878 14749 100       21107 if ($signature)
879             {
880 2748         5822 foreach (ID_ATTRIBUTES)
881             {
882             $item->{$_} = $compilation_unit.'_'.$item->{$_}
883 8244 100 100     22995 if defined $item->{$_} and $item->{$_} !~ m/^S/;
884             }
885             # TODO: remove when Dwarf-4 is no longer experimental:
886 2748         8976 foreach (keys %$item)
887             {
888 16857 50       28337 confess 'internal error: attribute ', $_,
889             ' needs remapping in compilation unit ',
890             '(add to ID_ATTRIBUTES in ', __PACKAGE__, ')'
891             if m/^[0-9a-f]{1,7}$/;
892             }
893 2748 100       7156 if ($item->{id} eq $compilation_unit.'_'.$type_offset)
894             {
895 84         299 $compilation_unit_list{$signature} = $item->{id};
896             }
897             }
898             # special handling of indirect variables of
899             # non-optimised inline functions:
900 14749 100 66     27427 if (defined $item->{abstract_origin} and
      100        
901             defined $item->{type_tag} and
902             $item->{type_tag} eq 'DW_TAG_variable')
903             {
904 6         27 $item = undef;
905 6         20 next;
906             }
907             # normal handling:
908 14743         23704 foreach (@$needed_attributes)
909             {
910 18728 100       34112 next if defined $item->{$_};
911             # special handling for missing locations in unions:
912 568 50 100     2473 if ($item->{type_tag} eq 'DW_TAG_member' and
      100        
      66        
      100        
      66        
913             not defined $item->{member_location} and
914             $_ eq 'member_location' and
915             $item->{level} > 1 and
916             $level_stack[$item->{level} - 1]->{type_tag}
917             eq 'DW_TAG_union_type' and
918             $level_stack[$item->{level} - 1]->{sub_items})
919             {
920             my $sibling =
921 44         122 $level_stack[$item->{level} - 1]->{sub_items}->[0];
922             # special handling for non-first members of unions:
923 44 100       195 if (defined $sibling)
    100          
924             {
925 18   100     133 while (not defined $sibling->{member_location} and
926             $sibling->{sub_items})
927             {
928 10         50 $sibling = $sibling->{sub_items}->[0];
929             }
930 18 100       59 if (defined $sibling->{member_location})
931             {
932             $item->{member_location} =
933 15         43 $sibling->{member_location};
934 15         50 next;
935             }
936             }
937             # special handling for top-level unions:
938             elsif ($item->{level} <= 2)
939             {
940 8         24 $item->{member_location} = 0;
941 8         20 next;
942             }
943             }
944             # special handling of items that contain
945             # additional info needed by other items:
946 545 100 100     1524 if ($item->{type_tag} eq 'DW_TAG_member' and
      66        
      100        
      66        
947             defined $item->{member_location} and
948             defined $item->{type} and
949             defined $self{item_map}->{$item->{type}} and
950             not defined
951             $self{item_map}->{$item->{type}}->{member_location})
952             {
953             $self{item_map}->{$item->{type}}->{member_location} =
954 7         25 $item->{member_location};
955             }
956             #TODO: activate check again later or in case of problems (missing info):
957             # carp('necessary attribute tag ', $_, ' is missing in ',
958             # $item->{type_tag},
959             # (defined $item->{name} ? ' for '.$item->{name} : ''),
960             # ' at position ', $item->{id});
961 545         1293 $item = undef;
962 545         797 last;
963             }
964             }
965 19899 100       30002 if (defined $item)
966             {
967             confess 'item ', $item, ' has no type tag in ', __PACKAGE__
968 14198 50       21966 unless $item->{type_tag};
969 14198         16352 push @{$self{items}}, $item;
  14198         28695  
970 14198         47924 $self{item_map}->{$item->{id}} = $item;
971             # handle stack of item levels:
972 14198 100       26790 if ($item->{level} >= 1)
973             {
974 10973         25529 push @{$level_stack[$item->{level} - 1]->{sub_items}},
975             $item
976 14169 100       24335 if $item->{level} > 1;
977 14169         32210 pop @level_stack while ($#level_stack >= $item->{level});
978 14169         20361 $level_stack[$item->{level}] = $item;
979             # inheritance entries (almost) never have file/line:
980 14169 50 66     26013 if ($item->{type_tag} eq 'DW_TAG_inheritance' and
      66        
981             not defined $item->{decl_file} and
982             defined $level_stack[$item->{level} - 1]->{decl_file})
983             {
984             $item->{decl_file} =
985 36         122 $level_stack[$item->{level} - 1]->{decl_file};
986             $item->{decl_line} =
987 36         144 $level_stack[$item->{level} - 1]->{decl_line};
988             }
989             }
990             # Take special care of structure names that are stored
991             # in another node:
992 14198         18094 my $name = $item->{name};
993 14198 100 100     43773 if (not defined $name and
      100        
      100        
994             $item->{type_tag} =~ m/^DW_TAG_(?:class|structure|union)_type$/
995             and
996             defined $item->{specification} and
997             defined $self{item_map}->{$item->{specification}})
998             {
999 117         307 $name = $self{item_map}->{$item->{specification}}->{name};
1000             }
1001             # the name map can store items with unique names
1002             # (simple reference) and identical names (array of
1003             # references):
1004 14198 100       21403 if (defined $name)
1005             {
1006 4581 100       10518 if (not defined $self{name_map}->{$name})
    100          
    50          
1007 3405         9424 { $self{name_map}->{$name} = $item }
1008             elsif (ref($self{name_map}->{$name}) eq 'HASH')
1009             {
1010             $self{name_map}->{$name} =
1011 554         1299 [ $self{name_map}->{$name}, $item ]
1012             }
1013             elsif (ref($self{name_map}->{$name}) eq 'ARRAY')
1014 622         796 { push @{$self{name_map}->{$name}}, $item }
  622         1305  
1015             else
1016             {
1017             confess 'internal error: invalid reference type ',
1018 0         0 ref($self{name_map}->{$name}),
1019             ' in name_map in ', __PACKAGE__
1020             }
1021             }
1022             # for items with known location add object id:
1023 14198 100       22388 if (defined $item->{decl_file})
1024 3333         5760 { $item->{compilation_unit} = $compilation_unit }
1025             # brush up stored item with a few item tag specific fixes:
1026             $item->{name} = 'void'
1027             if ($item->{type_tag} eq 'DW_TAG_pointer_type' and
1028             not defined $item->{name} and
1029 14198 100 66     28385 not defined $item->{type});
      100        
1030             # save a bit of memory (strings):
1031             }
1032             # stop at end of section (finalisation):
1033 19899 100       29505 last if $end_of_section;
1034             # prepare node for next item (we ignore the type ID in $3
1035             # except for the carp below as the ID uses a new sequence
1036             # for every compilation unit and is therefore pretty much
1037             # worthless for us):
1038 19882 100       101156 $item = { level => $1,
1039             id => $signature ? $compilation_unit.'_'.$2 : $2,
1040             type_tag => $4,
1041             sub_items => [] };
1042 19882 100       48491 if (defined $tag_needs_attributes->{$4})
    100          
1043             {
1044 14749         57755 $needed_attributes = $tag_needs_attributes->{$4};
1045             }
1046             elsif ($is_ignored{$4})
1047             {
1048 5132         15120 pop @level_stack while ($#level_stack >= $item->{level});
1049 5132         22490 $item = undef;
1050             }
1051             else
1052             {
1053 1         107 carp 'unknown item type ', $4, ' (', $3,
1054             ') found at position ', $2;
1055 1         17 $item = undef;
1056             }
1057             }
1058             elsif (not defined $item)
1059 31361         67300 { next }
1060             elsif (m/$re_abstract_origin[$version]/)
1061 163         588 { $item->{abstract_origin} = $1 }
1062             elsif (m/$re_alignment[$version]/)
1063 0         0 { $item->{alignment} = $1 }
1064             elsif (m/$re_bit_offset[$version]/)
1065 112         634 { $item->{bit_offset} = $1 }
1066             elsif (m/$re_bit_size[$version]/)
1067 112         554 { $item->{bit_size} = $1 }
1068             elsif (m/$re_byte_size[$version]/)
1069 1858         9211 { $item->{byte_size} = $1 }
1070             elsif (m/$re_comp_dir[$version]/)
1071 29         412 { $item->{comp_dir} = $1 }
1072             elsif (m/$re_const_expr[$version]/)
1073 0         0 { $item->{const_expr} = $1 }
1074             elsif (m/$re_const_value[$version]/)
1075 883         4622 { $item->{const_value} = $1 }
1076             elsif (m/$re_containing_type[$version]/)
1077 0 0       0 { $item->{containing_type} = defined $2 ? 'S'.$2 : $1 }
1078             elsif (m/$re_decl_file[$version]/)
1079 3435         16464 { $item->{decl_file} = $1 }
1080             elsif (m/$re_decl_line[$version]/)
1081 3435         15279 { $item->{decl_line} = $1 }
1082             elsif (m/$re_declaration[$version]/)
1083 1479         7495 { $item->{declaration} = $1 }
1084             elsif (m/$re_default_value[$version]/)
1085 0         0 { $item->{default_value} = $1 }
1086             elsif (m/$re_encoding[$version]/)
1087 601         3064 { $item->{encoding} = $1 }
1088             elsif (m/$re_external[$version]/)
1089 1128         5508 { $item->{external} = $1 }
1090             elsif (m/$re_language[$version]/)
1091 29         410 { $item->{language} = $1 }
1092             elsif (defined $re_linkage_name_tag[$version] and
1093             m/$re_linkage_name_tag[$version]/)
1094 33         165 { $item->{linkage_name} = $1 }
1095             elsif (m/$re_location[$version]/)
1096 172         830 { $item->{location} = $1 }
1097             elsif (m/$re_member_location[$version]/)
1098 1264 50       7381 { $item->{member_location} = $1 if defined $1; }
1099             elsif (m/$re_name_tag[$version]/)
1100 4680         25193 { $item->{name} = $1 }
1101             elsif (m/$re_producer[$version]/)
1102 29         355 { $item->{producer} = $1 }
1103             elsif (defined $re_signature_tag[$version] and
1104             m/$re_signature_tag[$version]/)
1105 21 50       220 { $item->{signature} = defined $1 ? $2 : 'S'.$2 }
1106             elsif (m/$re_specification[$version]/)
1107 174         980 { $item->{specification} = $1 }
1108             elsif (m/$re_type[$version]/)
1109 12795 100       69587 { $item->{type} = defined $2 ? 'S'.$2 : $1 }
1110             elsif (m/$re_upper_bound[$version]/)
1111 75         557 { $item->{upper_bound} = $1 }
1112             elsif (m/$re_ignored_attributes[$version]/i)
1113             {}
1114             elsif (m/^\s*(?:<[0-9A-F ]+>)?\s*(DW_AT_\w+)\s*:/i)
1115             {
1116 1         18 chomp;
1117             carp('unknown attribute type ', $1, ' found at position ',
1118 1         388 $item->{id}, ' : ', $_);
1119             }
1120             }
1121              
1122             # remap Ss:
1123 19         50 foreach $item (values %{$self{item_map}})
  19         1462  
1124             {
1125 14198         19803 foreach (SIGNATURE_ATTRIBUTES)
1126             {
1127 28396 100 100     73090 if (defined $item->{$_} and $item->{$_} =~ m/^S([0-9A-F]+)/i)
1128 144         377 { $item->{$_} = $compilation_unit_list{$1}; }
1129             }
1130             }
1131              
1132             # now we're finished:
1133 19 100       1336 close READELF or
1134             croak 'error while attempting to parse ', $file_name,
1135             ' (maybe not an object file?)';
1136 18 100       54 @{$self{items}} > 0 or
  18         482  
1137             croak 'aborting: debug info section seems empty in ', __PACKAGE__;
1138              
1139 17         33705 bless \%self, $class;
1140             }
1141              
1142             #########################################################################
1143              
1144             =head2 item_ids - get object ID(s) of (named) item
1145              
1146             @item_ids = $debug_info->item_ids($identifier);
1147              
1148             =head3 example:
1149              
1150             @item_ids = $debug_info->item_ids('my_variable');
1151              
1152             =head3 parameters:
1153              
1154             $identifier name of item (e.g. variable name)
1155              
1156             =head3 description:
1157              
1158             This method returns the internal item ID of all identifiers with
1159             the given name as array.
1160              
1161             =head3 returns:
1162              
1163             If a name is unique, the method returns an array with exactly one
1164             element, if a name does not exist it returns an empty array and
1165             otherwise an array containing the IDs of all matching itmes is
1166             returned.
1167              
1168             =cut
1169              
1170             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1171             sub item_ids($$)
1172             {
1173 39     39 1 35750 my $this = shift;
1174 39         123 my ($identifier) = @_;
1175 39         72 local $_;
1176              
1177 39         96 my $id = $this->{name_map}{$identifier};
1178             return
1179 48         314 map { $_->{id} }
1180             (! defined $id ? ()
1181             : ref($id) eq 'HASH' ? ($id)
1182 39 100       204 : @{$id});
  9 100       27  
1183             }
1184              
1185             #########################################################################
1186              
1187             =head2 item_ids_matching - get object IDs of items matching constraints
1188              
1189             @item_ids = $debug_info->item_ids_matching($re_name, [$re_type_tag]);
1190              
1191             =head3 example:
1192              
1193             @some_item_ids = $debug_info->item_ids_matching('^var', 'variable');
1194             @all_item_ids = $debug_info->item_ids_matching('');
1195             @all_structure_ids = $debug_info->item_ids_matching('', '.*structure.*');
1196              
1197             =head3 parameters:
1198              
1199             $re_name regular expression matching name of items
1200             $re_type_tag regular expression matching type tag of items
1201              
1202             =head3 description:
1203              
1204             This method returns an array containing the internal item ID of
1205             all identifiers that match both the regular expression for their
1206             name and their type tags. Note that an empty string will match
1207             any name or type tag, even missing ones. Also note that type tags
1208             in Dwarf 2 always begin with C.
1209              
1210             =head3 returns:
1211              
1212             If a name is unique, the method returns an array with exactly one
1213             element, if a name does not exist it returns an empty array and
1214             otherwise an array containing the IDs of all matching itmes is
1215             returned. The IDs are sorted alphabetically according to their
1216             names.
1217              
1218             =cut
1219              
1220             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1221             sub item_ids_matching($$;$)
1222             {
1223 44     44 1 19116 my $this = shift;
1224 44         157 my ($re_name, $re_type_tag) = (@_, '.');
1225 44 100       166 $re_name = '.' if $re_name eq '';
1226 44         72 local $_;
1227              
1228 44         70 my @ids = ();
1229 44 100       61 foreach (map { ref($_) eq 'HASH' ? $_ : @$_ }
  10853         15069  
1230 44         633 values %{$this->{name_map}})
1231             {
1232 14244 100 100     37642 next if defined $_->{name} and $_->{name} !~ m/$re_name/;
1233             next if (not defined $_->{name} and
1234             $re_name ne '' and
1235             not ($_->{type_tag} =~ m/^DW_TAG_(?:class|structure|union)_type$/
1236             and
1237             defined $_->{specification} and
1238             $this->{item_map}->{$_->{specification}}->{name}
1239 2855 100 66     6538 =~ m/$re_name/));
      66        
      100        
1240 2563 100 66     7547 next if defined $_->{type_tag} and $_->{type_tag} !~ m/$re_type_tag/;
1241 915 50 33     1490 next if not defined $_->{type_tag} and $re_type_tag ne '';
1242 915 100       2374 push @ids, [ $_->{id}, ( defined $_->{name} ? $_->{name} : '' ) ];
1243             }
1244             return
1245 915         1542 map { $_->[0] }
1246 44         576 sort { $a->[1] cmp $b->[1] }
  4113         4640  
1247             @ids;
1248             }
1249              
1250             #########################################################################
1251              
1252             =head2 structure_layout - get structure layout of variable or data type
1253              
1254             @structure_layout =
1255             $debug_info->structure_layout($id, [$initial_offset]);
1256              
1257             =head3 example:
1258              
1259             @structure_layout1 =
1260             $debug_info->structure_layout('1a8');
1261             @structure_layout2 =
1262             $debug_info->structure_layout('2f0', 4);
1263              
1264             =head3 parameters:
1265              
1266             $id internal ID of item
1267             $initial_offset offset to be used for the beginning of the layout
1268              
1269             =head3 description:
1270              
1271             This method returns the structure layout of a variable or data
1272             type with the given item ID (which can be found with the method
1273             L<"item_ids"> or L<"item_ids_matching">). For each element of a
1274             structure it returns a sextuple containing (in that order)
1275             I, I, I, I, I
1276             source file> and I allthough some of the information might
1277             be missing (which is indicated by an empty string). For bit
1278             fields two additional fields are added: I and
1279             I (either both are defined or none at all).
1280              
1281             I is a triplet. The first two elements
1282             (object ID of module and source number) are needed to get the file
1283             name from
1284             L.
1285             The third is the line number within the source. If in Dwarf 4 the
1286             last two elements are not provided, they will be replaced by the
1287             fixed string C and the signature ID of the compilation
1288             unit instead.
1289              
1290             Note that named indices for the result are defined in the
1291             L export (see above).
1292              
1293             =head3 returns:
1294              
1295             The method returns an array of the sextuples described above.
1296              
1297             =cut
1298              
1299             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1300             sub structure_layout($$;$)
1301             {
1302 695     695 1 9377 my $this = shift;
1303 695         1056 my ($id, $initial_offset) = @_;
1304 695 100       1088 $initial_offset = 0 unless defined $initial_offset;
1305 695         833 local $_;
1306              
1307 695         998 my $item = $this->{item_map}->{$id};
1308             # ignore undefined items or standard items (as standard data types):
1309 695 100 66     1908 return () unless defined $item and defined $item->{decl_file};
1310              
1311             # handle relative level - 1:
1312 410 100       620 if (defined $this->{sl_level})
1313 361         422 { $this->{sl_level}++ }
1314             else
1315             {
1316 49         94 $this->{sl_level} = 0;
1317 49         117 $this->{tag_stack} = [];
1318             }
1319 410         501 my $level = $this->{sl_level};
1320              
1321             # maintain a stack of the item tags:
1322 410         584 $this->{tag_stack}->[$level] = $item->{type_tag};
1323              
1324             # check for nested structures (if applicable) and don't process
1325             # anything if we found one:
1326 410         534 my @result = ();
1327 410 100 100     1225 if ($display_nested_items or
      100        
      100        
1328             $item->{type_tag} ne 'DW_TAG_structure_type' or
1329             $level < 1 or
1330             $item->{type_tag} ne $this->{tag_stack}->[$level - 1])
1331             {
1332             # get name:
1333 403         513 my $name = $item->{name};
1334 403 50 100     752 if (not defined $name and
      66        
      66        
      33        
1335             $level < 1 and
1336             $item->{type_tag} =~ m/^DW_TAG_(?:class|structure|union)_type$/ and
1337             defined $item->{specification} and
1338             defined $this->{item_map}->{$item->{specification}})
1339             {
1340 2         6 $name = $this->{item_map}->{$item->{specification}}->{name};
1341             }
1342 403 100       567 $name = '' unless defined $name;
1343              
1344             # handle offset:
1345             my $offset =
1346 403 100       670 defined $item->{member_location} ? $item->{member_location} : 0;
1347 403         554 $offset += $initial_offset;
1348              
1349             # handle size - 1:
1350 403 100       698 my $size = defined $item->{byte_size} ? $item->{byte_size} : 0;
1351              
1352             # handle bit size and offset:
1353 403         495 my @bit_data = ();
1354 403 100 66     1032 if (defined $item->{bit_size} or defined $item->{bit_offset})
1355             {
1356             $bit_data[0] =
1357 78 50       156 defined $item->{bit_size} ? $item->{bit_size} : 0;
1358             $bit_data[1] =
1359 78 50       133 defined $item->{bit_offset} ? $item->{bit_offset} : 0;
1360             }
1361              
1362             # handle types:
1363 403         506 my $type_name = '';
1364 403         473 my @sub_layout = ();
1365 403 100       639 if (defined $item->{type})
1366             {
1367 332         557 my $type = $this->{item_map}->{$item->{type}};
1368 332         411 my $prefix = '';
1369 332         403 my $postfix = '';
1370             # for special types use shortcut to their sub-types:
1371 332         573 while ($type->{type_tag})
1372             {
1373             # const:
1374 386 100       1050 if ($type->{type_tag} eq 'DW_TAG_const_type')
    100          
    100          
    100          
    100          
1375             {
1376 22 100       76 $prefix .= 'const ' unless $prefix =~ m/const/;
1377 22         49 $type = $this->{item_map}->{$type->{type}};
1378 22         49 next;
1379             }
1380             # volatile:
1381             elsif ($type->{type_tag} eq 'DW_TAG_volatile_type')
1382             {
1383 6 50       22 $prefix .= 'volatile ' unless $prefix =~ m/volatile/;
1384 6         15 $type = $this->{item_map}->{$type->{type}};
1385 6         16 next;
1386             }
1387             # reference:
1388             elsif ($type->{type_tag} eq 'DW_TAG_reference_type')
1389             {
1390 8         25 $postfix .= '&';
1391 8         26 $type = $this->{item_map}->{$type->{type}};
1392 8         21 next;
1393             }
1394             # pointer:
1395             elsif ($type->{type_tag} eq 'DW_TAG_pointer_type')
1396             {
1397 16         28 $postfix .= '*';
1398 16 100 66     51 if (defined $type->{type} and
1399             defined $this->{item_map}->{$type->{type}})
1400             {
1401 4         11 $type = $this->{item_map}->{$type->{type}};
1402 4         9 next;
1403             }
1404             }
1405             # arrays:
1406             elsif ($type->{type_tag} eq 'DW_TAG_array_type')
1407             {
1408 14         25 foreach (0..$#{$type->{sub_items}})
  14         48  
1409             {
1410 14         34 $name .= '[';
1411             $name .= $type->{sub_items}->[$_]->{upper_bound} + 1
1412 14 50       52 if defined $type->{sub_items}->[$_]->{upper_bound};
1413 14         31 $name .= ']';
1414             }
1415 14         28 $type = $this->{item_map}->{$type->{type}};
1416 14         25 next;
1417             }
1418 332         383 last;
1419             }
1420              
1421             # handle size - 2:
1422             $size = $type->{byte_size}
1423             if ($size == 0 and
1424             defined $type->{byte_size} and
1425 332 100 100     1135 $type->{byte_size} > 0);
      66        
1426              
1427             # handle details of types in recursion:
1428 332         667 @sub_layout = $this->structure_layout($item->{type}, $offset);
1429              
1430             # for templates use shortcut to their specification:
1431 332 100 100     775 if ($type->{type_tag} =~ m/^DW_TAG_(?:class|structure|union)_type$/
1432             and
1433             defined $type->{specification})
1434 6         11 { $type = $this->{item_map}->{$type->{specification}} }
1435              
1436             # set type name:
1437 332 100       575 $type_name = $type->{name} if defined $type->{name};
1438             # TODO: all shold be known in later version:
1439 332 50 33     523 $type_name = ''
      66        
1440             if $type_name eq '' and ($prefix or $postfix);
1441 332 100       473 $type_name = $prefix.$type_name if $prefix;
1442 332 100       459 $type_name .= $postfix if $postfix;
1443              
1444             # apply structure filter, if applicable:
1445 332 100 66     970 @sub_layout = ()
1446             if defined $re_substructure_filter and
1447             $type_name =~ m/$re_substructure_filter/;
1448              
1449             # handle size - 3:
1450 332   66     672 while ($size == 0 and
      66        
1451             defined $type->{type} and
1452             $type = $this->{item_map}->{$type->{type}})
1453             {
1454             $size = $type->{byte_size}
1455             if (defined $type->{byte_size} and
1456 6 50 33     29 $type->{byte_size} > 0);
1457             }
1458             }
1459              
1460             # handle size - 4:
1461 403   66     909 while ($name =~ m/\[(\d+)\]/g and $1 > 0)
1462 14         52 { $size *= $1 }
1463              
1464             # for structured items continue recursion (but ignore
1465             # declarations not declaring real members!):
1466 403         450 foreach (@{$item->{sub_items}})
  403         713  
1467             {
1468             push @sub_layout, $this->structure_layout($_->{id}, $offset)
1469 312 50       795 unless $_->{type_tag} eq 'DW_TAG_typedef';
1470             }
1471              
1472             # sort sub-structure:
1473 403 100       666 if (@sub_layout)
1474             {
1475             @sub_layout =
1476             sort {
1477 119 100 100     278 ($a->[$OFFSET] <=> $b->[$OFFSET]
  896 100       1895  
    100          
    50          
1478             ||
1479             (defined $a->[$BITOFFSET]
1480             ? (defined $b->[$BITOFFSET]
1481             ? $a->[$BITOFFSET] <=> $b->[$BITOFFSET] : 1)
1482             : (defined $b->[$BITOFFSET] ? -1 : 0)
1483             )
1484             ||
1485             $a->[$LEVEL] <=> $b->[$LEVEL]
1486             )
1487             }
1488             @sub_layout;
1489             }
1490              
1491             # handle location of definition:
1492 403         573 my $location = [];
1493 403 50 33     1408 if (defined $item->{compilation_unit} and
      33        
1494             defined $item->{decl_file} and
1495             defined $item->{decl_line})
1496             {
1497             $location = [$item->{compilation_unit},
1498             $item->{decl_file},
1499 403         893 $item->{decl_line} ];
1500             }
1501              
1502             # for unnamed singular substructures eliminate singular level:
1503 403 100 100     1091 if ($item->{type_tag} =~ m/^DW_TAG_(?:class|structure|union)_type$/ and
      66        
      66        
1504             not $name and
1505             not $type_name and
1506             0 == @bit_data)
1507             {
1508 7         20 @result = @sub_layout;
1509             }
1510             else
1511             {
1512 396         1098 @result = ([$level, $name, $type_name, $size, $location,
1513             $offset, @bit_data],
1514             @sub_layout);
1515             }
1516             }
1517              
1518             # handle relative level - 2:
1519 410 100       677 if ($this->{sl_level} > 0)
1520 361         421 { $this->{sl_level}-- }
1521             else
1522             {
1523 49         108 delete $this->{tag_stack};
1524 49         65 delete $this->{sl_level};
1525             }
1526              
1527             # put everything together and return:
1528 410         1008 return @result;
1529             }
1530              
1531             1;
1532              
1533             #########################################################################
1534              
1535             __END__