sub readDWARFDump()

in src/main/abi-symbols/abi-dumper.pl [1364:1957]


sub readDWARFDump($$)
{
    my ($FH, $Primary) = @_;
    
    my $TypeUnit_Sign = undef;
    my $TypeUnit_Offset = undef;
    my $Type_Offset = undef;
    
    my $Shift_Enabled = 1;
    my $ID_Shift = undef;
    
    my $CUnit = undef;
    
    if($AltDebugInfo) {
        $Compressed = 1;
    }
    
    my $ID = undef;
    my $Kind = undef;
    my $NS = undef;
    
    my $MAX_ID = undef;
    
    my %Shift = map {$_=>1} (
        "specification",
        "spec",
        "type",
        "sibling",
        "object_pointer",
        "objptr",
        "containing_type",
        "container",
        "abstract_origin",
        "orig",
        "import",
        "signature"
    );
    
    my %SkipNode = (
        "imported_declaration" => 1,
        "imported_module" => 1
    );
    
    my %SkipAttr = (
        "high_pc" => 1,
        "frame_base" => 1,
        "encoding" => 1,
        "Compilation" => 1,
        "comp_dir" => 1,
        "declaration" => 1,
        "prototyped" => 1,
        "GNU_vector" => 1,
        "GNU_all_call_sites" => 1,
        "explicit" => 1
    );
    
    my %RenameAttr = (
        "data_member_location" => "mloc",
        "decl_file" => "file",
        "decl_line" => "line",
        "linkage_name" => "linkage",
        "object_pointer" => "objptr",
        "artificial" => "art",
        "external" => "ext",
        "specification" => "spec",
        "byte_size" => "size",
        "accessibility" => "access",
        "const_value" => "cval",
        "containing_type" => "container",
        "abstract_origin" => "orig",
        "virtuality" => "virt",
        "vtable_elem_location" => "vloc"
    );
    
    my %RenameKind = (
        "formal_parameter" => "param",
        "subprogram" => "prog",
        "unspecified_parameters" => "unspec_params",
        "template_type_parameter" => "tmpl_param"
    );
    
    my %MarkByUnit = (
        "member" => 1,
        "subprogram" => 1,
        "prog" => 1,
        "variable" => 1
    );
    
    my $Lexical_Block = undef;
    my $Inlined_Block = undef;
    my $Subprogram_Block = undef;
    my $Skip_Block = undef;
    
    while(my $Line = <$FH>)
    {
        if(defined $ID and $Line=~/\A\s*(\w+)\s+(.+?)\s*\Z/)
        {
            if(defined $Skip_Block) {
                next;
            }
            
            my $Attr = $1;
            my $Val = $2;
            
            if(defined $RenameAttr{$Attr}) {
                $Attr = $RenameAttr{$Attr};
            }
            
            if(index($Val, "(flag")==0)
            { # artificial, external (on Fedora)
              # flag_present
                $Val = 1;
            }
            
            if(defined $Compressed)
            {
                if($Kind eq "imported_unit") {
                    next;
                }
            }
            
            if($Kind eq "member")
            {
                if($Attr eq "mloc") {
                    delete($DWARF_Info{$ID}{"unit"});
                }
            }
            
            if($Attr eq "sibling")
            {
                if($Kind ne "structure_type") {
                    next;
                }
            }
            elsif($Attr eq "Type")
            {
                if($Line=~/Type\s+signature:\s*0x(\w+)/) {
                    $TypeUnit_Sign = $1;
                }
                if($Line=~/Type\s+offset:\s*0x(\w+)/) {
                    $Type_Offset = hex($1);
                }
                if($Line=~/Type\s+unit\s+at\s+offset\s+(\d+)/) {
                    $TypeUnit_Offset = $1;
                }
                next;
            }
            elsif(defined $SkipAttr{$Attr})
            { # unused
                next;
            }
            
            if($Val=~/\A\s*\(([^()]*)\)\s*\[\s*(\w+)\]\s*\Z/)
            { # ref4, ref_udata, ref_addr, etc.
                $Val = hex($2);
                
                if($1 eq "GNU_ref_alt") {
                    $Val = -$Val;
                }
            }
            elsif($Attr eq "name")
            {
                $Val=~s/\A\([^()]*\)\s*\"(.*)\"\Z/$1/;
                
                if(defined $LambdaSupport)
                {
                    if(index($Val, "<lambda(")==0)
                    {
                        $Val=~s/\A</{/;
                        $Val=~s/>\Z/}/;
                    }
                }
            }
            elsif(index($Attr, "linkage_name")!=-1 or $Attr eq "linkage")
            {
                $Val=~s/\A\([^()]*\)\s*\"(.*)\"\Z/$1/;
                $Attr = "linkage";
            }
            elsif(index($Attr, "location")!=-1 or $Attr eq "mloc" or $Attr eq "vloc")
            {
                if($Val=~/\)\s*\Z/)
                { # value on the next line
                    my $NL = <$FH>;
                    $Val .= $NL;

                    if(defined $ExtraDump)
                    {
                        if($NL=~/\A\s{4,}\[\s*(\w+)\]\s*(piece \d+|\w+)/)
                        {
                            $FullLoc{$ID}{$1} = $2;
                        }
                    }
                    
                    if(index($Val, "GNU_entry_value")!=-1)
                    { # value on the next line
                        $NL = <$FH>;
                        $Val .= $NL;
                    }
                }
                
                if($Val=~/\A\(\w+\)\s*(-?)(\w+)\Z/)
                { # (data1) 1c
                    if ($2 != 0xFFFFFFFFFFFFFFFF) {
                        $Val = hex($2);
                        if($1) {
                            $Val = -$Val;
                       }
                    }
                }
                else
                {
                    if($Val=~/ (-?\d+)\Z/) {
                        $Val = $1;
                    }
                    else
                    {
                        if($Attr eq "location"
                        and $Kind eq "param")
                        {
                            if($Val=~/location list\s+\[\s*(\w+)\]\Z/)
                            {
                                $Attr = "location_list";
                                $Val = $1;
                            }
                            elsif($Val=~/ reg(\d+)\Z/)
                            {
                                $Attr = "register";
                                $Val = $1;
                            }
                        }
                    }
                }
            }
            elsif($Attr eq "access")
            {
                $Val=~s/\A\(.+?\)\s*//;
                $Val=~s/\s*\(.+?\)\Z//;
                
                # NOTE: members: private by default
            }
            else
            {
                $Val=~s/\A\(\w+\)\s*//;
                
                if(substr($Val, 0, 1) eq "{"
                and $Val=~/{(.+)}/)
                { # {ID}
                    $Val = $1;
                    $Post_Change{$ID} = 1;
                }
            }
            
            if($Val eq "")
            {
                if($Attr eq "ext") {
                    next;
                }
            }
            
            if(defined $Shift_Enabled and $ID_Shift)
            {
                if(defined $Shift{$Attr}
                and not $Post_Change{$ID}) {
                    $Val += $ID_Shift;
                }
                
                # $DWARF_Info{$ID}{"rID"} = $ID-$ID_Shift;
            }
            
            if(not $Primary)
            {
                if(defined $Shift{$Attr}) {
                    $Val = -$Val;
                }
            }
            
            if($Kind ne "partial_unit"
            and $Kind ne "imported_unit")
            {
                if($Attr ne "stmt_list") {
                    $DWARF_Info{$ID}{$Attr} = "$Val";
                }
            }
            
            if($Kind eq "compile_unit")
            {
                if($Attr eq "stmt_list")
                {
                    $CUnit = $Val;
                    $Partial = undef
                }
                
                if(not defined $LIB_LANG)
                {
                    if($Attr eq "language")
                    {
                        if(index($Val, "Assembler")==-1)
                        {
                            $Val=~s/\s*\(.+?\)\Z//;
                            
                            if($Val=~/C\d/i) {
                                $LIB_LANG = "C";
                            }
                            elsif($Val=~/C\+\+|C_plus_plus/i) {
                                $LIB_LANG = "C++";
                            }
                            else {
                                $LIB_LANG = $Val;
                            }
                        }
                    }
                }
                
                if(not defined $SYS_COMP and not defined $SYS_GCCV)
                {
                    if($Attr eq "producer")
                    {
                        if(index($Val, "GNU AS")==-1)
                        {
                            $Val=~s/\A\"//;
                            $Val=~s/\"\Z//;
                            
                            if($Val=~/GNU\s+(C\d*|C\+\+\d*|GIMPLE)\s+(.+)\Z/)
                            {
                                $SYS_GCCV = $2;
                                if($SYS_GCCV=~/\A(\d+\.\d+)(\.\d+|)/)
                                { # 4.6.1 20110627 (Mandriva)
                                    $SYS_GCCV = $1.$2;
                                }
                            }
                            elsif($Val=~/clang\s+version\s+([^\s\(]+)/) {
                                $SYS_CLANGV = $1;
                            }
                            else {
                                $SYS_COMP = $Val;
                            }
                            
                            if(not defined $KeepRegsAndOffsets)
                            {
                                my %Opts = ();
                                while($Val=~s/(\A| )(\-O([0-3]|g))( |\Z)/ /) {
                                    $Opts{keys(%Opts)} = $2;
                                }
                                
                                if(keys(%Opts))
                                {
                                    if($Opts{keys(%Opts)-1} ne "-Og")
                                    {
                                        if(not defined $Quiet) {
                                            printMsg("WARNING", "incompatible build option detected: ".$Opts{keys(%Opts)-1}." (required -Og for better analysis)");
                                        }
                                        $IncompatibleOpt = 1;
                                    }
                                }
                                else
                                {
                                    if(not defined $Quiet) {
                                        printMsg("WARNING", "the object should be compiled with -Og option for better analysis");
                                    }
                                    $IncompatibleOpt = 1;
                                }
                            }
                            
                            if(index($Val, "-fkeep-inline-functions")!=-1) {
                                $FKeepInLine = 1;
                            }
                        }
                    }
                }
            }
            elsif($Kind eq "type_unit")
            {
                if($Attr eq "stmt_list")
                {
                    $CUnit = $Val;
                    $Partial = 1;
                }
            }
            elsif($Kind eq "partial_unit")
            { # support for dwz
                if($Attr eq "stmt_list")
                {
                    $CUnit = $Val;
                    $Partial = 1;
                }
            }
        }
        elsif(defined $ExtraDump and $Line=~/\A\s{4,}\[\s*(\w+)\]\s*(piece \d+|\w+)/)
        {
            $FullLoc{$ID}{$1} = $2;
        }
        elsif($Line=~/\A \[\s*(\w+)\](\s*)(\w+)/)
        {
            $ID = hex($1);
            $NS = length($2);
            $Kind = $3;
            
            if(defined $RenameKind{$Kind}) {
                $Kind = $RenameKind{$Kind};
            }
            
            if(not defined $Compressed)
            {
                if($Kind eq "partial_unit" or $Kind eq "type_unit")
                { # compressed debug_info
                    $Compressed = 1;
                    
                    if($TooBig) {
                        printMsg("WARNING", "input object is compressed and large, may require a lot of RAM memory to process");
                    }
                }
            }
            
            if($Kind eq "compile_unit" and $CUnit
            and not defined $AllUnits)
            { # read the previous compile unit
                completeDump($Primary);
                
                if($Primary) {
                    readABI();
                }
            }
            
            $Skip_Block = undef;
            
            if(defined $SkipNode{$Kind})
            {
                $Skip_Block = 1;
                next;
            }
            
            if($Kind eq "lexical_block")
            {
                if(defined $Lexical_Block)
                {
                    if(length($NS)<=length($Lexical_Block)) {
                        $Lexical_Block = $NS;
                    }
                }
                else {
                    $Lexical_Block = $NS;
                }
                $Skip_Block = 1;
                next;
            }
            else
            {
                if(defined $Lexical_Block)
                {
                    if($NS>$Lexical_Block)
                    {
                        $LexicalId{$ID} = 1;
                        if(not $LambdaSupport)
                        {
                            $Skip_Block = 1;
                            next;
                        }
                    }
                    else
                    { # end of lexical block
                        $Lexical_Block = undef;
                    }
                }
            }
            
            if($Kind eq "inlined_subroutine")
            {
                $Inlined_Block = $NS;
                $Skip_Block = 1;
                next;
            }
            else
            {
                if(defined $Inlined_Block)
                {
                    if($NS>$Inlined_Block)
                    {
                        $Skip_Block = 1;
                        next;
                    }
                    else
                    { # end of inlined subroutine
                        $Inlined_Block = undef;
                    }
                }
            }
            
            if($Kind eq "prog")
            {
                $Subprogram_Block = $NS;
            }
            else
            {
                if(defined $Subprogram_Block)
                {
                    if($NS>$Subprogram_Block)
                    {
                        if($Kind eq "variable")
                        { # temp variables
                            $Skip_Block = 1;
                            next;
                        }
                    }
                    else
                    { # end of subprogram block
                        $Subprogram_Block = undef;
                    }
                }
            }
            
            if(not $Primary) {
                $ID = -$ID;
            }
            
            if(defined $Shift_Enabled)
            {
                if($Kind eq "type_unit")
                {
                    if(not defined $ID_Shift)
                    {
                        if($ID_Shift<=$MAX_ID) {
                            $ID_Shift = $MAX_ID;
                        }
                        else {
                            $ID_Shift = 0;
                        }
                    }
                }
                
                if($ID_Shift) {
                    $ID += $ID_Shift;
                }
            }
            
            if(defined $TypeUnit_Sign)
            {
                if($Kind ne "type_unit"
                and $Kind ne "namespace")
                {
                    if($TypeUnit_Offset+$Type_Offset+$ID_Shift==$ID)
                    {
                        $TypeUnit{$TypeUnit_Sign} = "$ID";
                        $TypeUnit_Sign = undef;
                    }
                }
            }
            
            if($Kind ne "partial_unit"
            and $Kind ne "imported_unit")
            {
                $DWARF_Info{$ID} = {};
                $DWARF_Info{$ID}{"kind"} = $Kind;
                $DWARF_Info{$ID}{"ns"} = $NS;
                
                if(defined $CUnit)
                {
                    if(defined $MarkByUnit{$Kind}
                    or defined $TypeType{$Kind}) {
                        $DWARF_Info{$ID}{"unit"} = $CUnit;
                    }
                }
                
                if($ID>0) {
                    push(@IDs, $ID);
                }
                else {
                    push(@IDs_I, $ID);
                }
            }
            
            if(not defined $ID_Shift) {
                $MAX_ID = $ID;
            }
        }
        elsif(not defined $SYS_WORD
        and $Line=~/Address\s*size:\s*(\d+)/i)
        {
            $SYS_WORD = $1;
        }
    }
    
    close($FH);
    
    if($Primary and not defined $ID) {
        printMsg("ERROR", "the debuginfo looks empty or corrupted");
    }
    
    # read the last compile unit
    completeDump($Primary);
    
    if($Primary) {
        readABI();
    }
}