examples/msg/mc/parse_dwarf

   1 #!/usr/bin/perl
   2
   3 # infos = [file, ref, level, type of declaration, parent (if level>1), name, type (base type or ref dwarf), global, size, address]
   4 # type of declaration : base_type, pointer_type, const_type, structure_type, member, enumeration_type, enumerator
   5
   6
   7 use strict;
   8 use warnings;
   9 use Switch;
  10
  11 my ($argument) = @ARGV;
  12
  13 my $executable = $argument;
  14 open (FILE, $executable) or die "E/S : $!\n";
  15
  16 my @infos;
  17
  18 my $ligne="";
  19 my @champs;
  20
  21 my $file = 0;
  22 my $level=1;
  23 my $ref=0; my $parent_ref=0;
  24 my $type_decl="undef";
  25 my $name="undef";
  26 my $type="undef";
  27 my $size=0;
  28 my $global = 0;
  29 my $address=0;
  30
  31
  32 while ($ligne=<FILE>) {
  33
  34     @champs = split /\s+/, $ligne;
  35
  36     if(@champs > 0){
  37
  38         if ($champs[0] eq "<") { # new declaration
  39
  40             # save last information in infos
  41             if( $level>0 ) {
  42                 my @entry = ($file, $ref, $level, $type_decl, $parent_ref, $name, $type, $global, $size, $address);
  43                 push @infos, \@entry;
  44             }
  45
  46             # get new information
  47             my @lr = split /></, $champs[1];
  48
  49             if($lr[0] > 0){ # level = 0, information about source file
  50
  51                 if($level < $lr[0]){
  52                     $parent_ref = $ref;
  53                 }else{
  54                     if($lr[0] == 1){
  55                         $parent_ref = 0;
  56                     }
  57                 }
  58
  59                 $level = $lr[0]; # level
  60                 $ref = substr($lr[1], 0, length($lr[1]) -1 ); # dwarf ref
  61                 $type_decl = $champs[2];
  62
  63             }else{ # create new hashtable
  64
  65                 $file++;
  66                 $level=0;
  67             }
  68
  69         }else{
  70
  71             switch ($champs[1]){
  72
  73                 case "DW_AT_name" { $name = substr($champs[2], 1, length($champs[2]) - 2); }
  74                 case "DW_AT_type" { $type = substr($champs[2], 1, length($champs[2]) - 2); }
  75                 case "DW_AT_byte_size" { $size = hex($champs[2]); }
  76                 case "DW_AT_external" { $global = 1; }
  77                 case "DW_AT_location" {
  78                     if ($global == 1) {
  79                         $address = $champs[3];
  80                     }
  81                 }
  82                 else { $global = 0;}
  83
  84
  85             }
  86             #print $champs[1]." ".$champs[2]."\n";
  87         }
  88     }
  89 }
  90
  91 # save last information in infos
  92 my @entry = ($file, $ref, $level, $type_decl, $parent_ref, $name, $type, $global, $size, $address);
  93 push @infos, \@entry;
  94
  95 my $i;
  96
  97 printf "%5s %12s %6s %30s %11s %60s %15s %9s %5s %10s\n", "file", "ref", "level", "type of declaration", "parent", "name", "type", "isGlobal", "size", "address";
  98 for($i = 0; $i < @infos; $i++){
  99     printf "%5s %12s %6s %30s %11s %60s %15s %9s %5s %10s\n", $infos[$i]->[0], $infos[$i]->[1], $infos[$i]->[2], $infos[$i]->[3], $infos[$i]->[4], $infos[$i]->[5], $infos[$i]->[6], $infos[$i]->[7], $infos[$i]->[8], $infos[$i]->[9];
 100 }