xref: /petsc/lib/petsc/bin/maint/abi-compliance-checker/modules/Internals/Mangling.pm (revision e8b6250908b962c387f7ab2e7b38caaa661b5fa1) 
1###########################################################################
2# A module to mangle C++ symbols
3#
4# Copyright (C) 2015-2018 Andrey Ponomarenko's ABI Laboratory
5#
6# Written by Andrey Ponomarenko
7#
8# This library is free software; you can redistribute it and/or
9# modify it under the terms of the GNU Lesser General Public
10# License as published by the Free Software Foundation; either
11# version 2.1 of the License, or (at your option) any later version.
12#
13# This library is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16# Lesser General Public License for more details.
17#
18# You should have received a copy of the GNU Lesser General Public
19# License along with this library; if not, write to the Free Software
20# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
21# MA  02110-1301 USA
22###########################################################################
23use strict;
24
25my %Cache;
26
27my %IntrinsicMangling = (
28    "void" => "v",
29    "bool" => "b",
30    "wchar_t" => "w",
31    "char" => "c",
32    "signed char" => "a",
33    "unsigned char" => "h",
34    "short" => "s",
35    "unsigned short" => "t",
36    "int" => "i",
37    "unsigned int" => "j",
38    "long" => "l",
39    "unsigned long" => "m",
40    "long long" => "x",
41    "__int64" => "x",
42    "unsigned long long" => "y",
43    "__int128" => "n",
44    "unsigned __int128" => "o",
45    "float" => "f",
46    "double" => "d",
47    "long double" => "e",
48    "__float80" => "e",
49    "__float128" => "g",
50    "..." => "z"
51);
52
53my %StdcxxMangling = (
54    "3std"=>"St",
55    "3std9allocator"=>"Sa",
56    "3std12basic_string"=>"Sb",
57    "3std12basic_stringIcE"=>"Ss",
58    "3std13basic_istreamIcE"=>"Si",
59    "3std13basic_ostreamIcE"=>"So",
60    "3std14basic_iostreamIcE"=>"Sd"
61);
62
63my $DEFAULT_STD_PARMS = "std::(allocator|less|char_traits|regex_traits|istreambuf_iterator|ostreambuf_iterator)";
64
65my %ConstantSuffixR = (
66    "u"=>"unsigned int",
67    "l"=>"long",
68    "ul"=>"unsigned long",
69    "ll"=>"long long",
70    "ull"=>"unsigned long long"
71);
72
73my %OperatorMangling = (
74    "~" => "co",
75    "=" => "aS",
76    "|" => "or",
77    "^" => "eo",
78    "&" => "an",#ad (addr)
79    "==" => "eq",
80    "!" => "nt",
81    "!=" => "ne",
82    "<" => "lt",
83    "<=" => "le",
84    "<<" => "ls",
85    "<<=" => "lS",
86    ">" => "gt",
87    ">=" => "ge",
88    ">>" => "rs",
89    ">>=" => "rS",
90    "()" => "cl",
91    "%" => "rm",
92    "[]" => "ix",
93    "&&" => "aa",
94    "||" => "oo",
95    "*" => "ml",#de (deref)
96    "++" => "pp",#
97    "--" => "mm",#
98    "new" => "nw",
99    "delete" => "dl",
100    "new[]" => "na",
101    "delete[]" => "da",
102    "+=" => "pL",
103    "+" => "pl",#ps (pos)
104    "-" => "mi",#ng (neg)
105    "-=" => "mI",
106    "*=" => "mL",
107    "/=" => "dV",
108    "&=" => "aN",
109    "|=" => "oR",
110    "%=" => "rM",
111    "^=" => "eO",
112    "/" => "dv",
113    "->*" => "pm",
114    "->" => "pt",#rf (ref)
115    "," => "cm",
116    "?" => "qu",
117    "." => "dt",
118    "sizeof"=> "sz"#st
119);
120
121my $MAX_CMD_ARG = 4096;
122my $MAX_CPPFILT_INPUT = 50000;
123my $CPPFILT_SUPPORT_FILE = undef;
124
125my %TrName;
126my %GccMangledName;
127my %MangledName;
128
129my $DisabledUnmangle_MSVC = undef;
130
131sub mangleSymbol($$$)
132{ # mangling for simple methods
133  # see gcc-4.6.0/gcc/cp/mangle.c
134    my ($InfoId, $Compiler, $LVer) = @_;
135    if($Cache{"mangleSymbol"}{$LVer}{$InfoId}{$Compiler}) {
136        return $Cache{"mangleSymbol"}{$LVer}{$InfoId}{$Compiler};
137    }
138    my $Mangled = "";
139    if($Compiler eq "GCC") {
140        $Mangled = mangleSymbol_GCC($InfoId, $LVer);
141    }
142    elsif($Compiler eq "MSVC") {
143        $Mangled = mangleSymbol_MSVC($InfoId, $LVer);
144    }
145    return ($Cache{"mangleSymbol"}{$LVer}{$InfoId}{$Compiler} = $Mangled);
146}
147
148sub mangleSymbol_MSVC($$)
149{ # TODO
150    my ($InfoId, $LVer) = @_;
151    return "";
152}
153
154sub mangleSymbol_GCC($$)
155{ # see gcc-4.6.0/gcc/cp/mangle.c
156    my ($InfoId, $LVer) = @_;
157
158    my $SInfo = $In::ABI{$LVer}{"SymbolInfo"}{$InfoId};
159
160    my ($Mangled, $ClassId, $NameSpace) = ("_Z", 0, "");
161
162    my $Return = $SInfo->{"Return"};
163    my %Repl = (); # SN_ replacements
164    if($ClassId = $SInfo->{"Class"})
165    {
166        my $MangledClass = mangleParam($ClassId, $LVer, \%Repl);
167        if($MangledClass!~/\AN/) {
168            $MangledClass = "N".$MangledClass;
169        }
170        else {
171            $MangledClass=~s/E\Z//;
172        }
173        if($SInfo->{"Const"}) {
174            $MangledClass=~s/\AN/NK/;
175        }
176        if($SInfo->{"Volatile"}) {
177            $MangledClass=~s/\AN/NV/;
178        }
179        $Mangled .= $MangledClass;
180    }
181    elsif($NameSpace = $SInfo->{"NameSpace"})
182    { # mangled by name due to the absence of structured info
183        my $MangledNS = mangleNs($NameSpace, $LVer, \%Repl);
184        if($MangledNS!~/\AN/) {
185            $MangledNS = "N".$MangledNS;
186        }
187        else {
188            $MangledNS=~s/E\Z//;
189        }
190        $Mangled .= $MangledNS;
191    }
192    my ($ShortName, $TmplParams) = templateBase($SInfo->{"ShortName"});
193    my @TParams = ();
194    if(my @TPos = sort {$a<=>$b} keys(%{$SInfo->{"TParam"}}))
195    { # parsing mode
196        foreach my $PPos (@TPos) {
197            push(@TParams, $SInfo->{"TParam"}{$PPos}{"name"});
198        }
199    }
200    elsif($TmplParams)
201    { # remangling mode
202      # support for old ABI dumps
203        @TParams = sepParams($TmplParams, 0, 0);
204    }
205    if(my $Ctor = $SInfo->{"Constructor"})
206    {
207        if($Ctor ne "1") {
208            $Mangled .= $Ctor;
209        }
210        else {
211            $Mangled .= "C1";
212        }
213    }
214    elsif(my $Dtor = $SInfo->{"Destructor"})
215    {
216        if($Dtor ne "1") {
217            $Mangled .= $Dtor;
218        }
219        else {
220            $Mangled .= "D0";
221        }
222    }
223    elsif($ShortName)
224    {
225        if($SInfo->{"Data"})
226        {
227            if(not $SInfo->{"Class"}
228            and isConstType($Return, $LVer))
229            { # "const" global data is mangled as _ZL...
230                $Mangled .= "L";
231            }
232        }
233        if($ShortName=~/\Aoperator(\W.*)\Z/)
234        {
235            my $Op = $1;
236            $Op=~s/\A[ ]+//g;
237            if(my $OpMngl = $OperatorMangling{$Op}) {
238                $Mangled .= $OpMngl;
239            }
240            else { # conversion operator
241                $Mangled .= "cv".mangleParam(getTypeIdByName($Op, $LVer), $LVer, \%Repl);
242            }
243        }
244        else {
245            $Mangled .= length($ShortName).$ShortName;
246        }
247        if(@TParams)
248        { # templates
249            $Mangled .= "I";
250            foreach my $TParam (@TParams) {
251                $Mangled .= mangleTemplateParam($TParam, $LVer, \%Repl);
252            }
253            $Mangled .= "E";
254        }
255        if(not $ClassId and @TParams) {
256            addSubst($ShortName, \%Repl, 0);
257        }
258    }
259    if($ClassId or $NameSpace) {
260        $Mangled .= "E";
261    }
262    if(@TParams)
263    {
264        if($Return) {
265            $Mangled .= mangleParam($Return, $LVer, \%Repl);
266        }
267    }
268    if(not $SInfo->{"Data"})
269    {
270        my @Params = ();
271        if(defined $SInfo->{"Param"}
272        and not $SInfo->{"Destructor"})
273        {
274            @Params = sort {$a<=>$b} keys(%{$SInfo->{"Param"}});
275
276            if($SInfo->{"Class"}
277            and not $SInfo->{"Static"})
278            {
279                if($SInfo->{"Param"}{"0"}{"name"} eq "this") {
280                    shift(@Params);
281                }
282            }
283        }
284        foreach my $PPos (sort {$a<=>$b} @Params)
285        { # checking parameters
286            my $PTid = $SInfo->{"Param"}{$PPos}{"type"};
287            $Mangled .= mangleParam($PTid, $LVer, \%Repl);
288        }
289        if(not @Params) {
290            $Mangled .= "v";
291        }
292    }
293    $Mangled = writeCxxSubstitution($Mangled);
294    if($Mangled eq "_Z") {
295        return "";
296    }
297    return $Mangled;
298}
299
300sub templateBase($)
301{ # NOTE: std::_Vector_base<mysqlpp::mysql_type_info>::_Vector_impl
302  # NOTE: operators: >>, <<
303    my $Name = $_[0];
304    if($Name!~/>\Z/ or $Name!~/</) {
305        return $Name;
306    }
307    my $TParams = $Name;
308    while(my $CPos = findCenter($TParams, "<"))
309    { # search for the last <T>
310        $TParams = substr($TParams, $CPos);
311    }
312    if($TParams=~s/\A<(.+)>\Z/$1/) {
313        $Name=~s/<\Q$TParams\E>\Z//;
314    }
315    else
316    { # error
317        $TParams = "";
318    }
319    return ($Name, $TParams);
320}
321
322sub getSubNs($)
323{
324    my $Name = $_[0];
325    my @NS = ();
326    while(my $CPos = findCenter($Name, ":"))
327    {
328        push(@NS, substr($Name, 0, $CPos));
329        $Name = substr($Name, $CPos);
330        $Name=~s/\A:://;
331    }
332    return (join("::", @NS), $Name);
333}
334
335sub mangleNs($$$)
336{
337    my ($Name, $LVer, $Repl) = @_;
338    if(my $Tid = $In::ABI{$LVer}{"TName_Tid"}{$Name})
339    {
340        my $Mangled = mangleParam($Tid, $LVer, $Repl);
341        $Mangled=~s/\AN(.+)E\Z/$1/;
342        return $Mangled;
343
344    }
345    else
346    {
347        my ($MangledNS, $SubNS) = ("", "");
348        ($SubNS, $Name) = getSubNs($Name);
349        if($SubNS) {
350            $MangledNS .= mangleNs($SubNS, $LVer, $Repl);
351        }
352        $MangledNS .= length($Name).$Name;
353        addSubst($MangledNS, $Repl, 0);
354        return $MangledNS;
355    }
356}
357
358sub mangleParam($$$)
359{
360    my ($PTid, $LVer, $Repl) = @_;
361    my ($MPrefix, $Mangled) = ("", "");
362    my %ReplCopy = %{$Repl};
363    my %BaseType = getBaseType($PTid, $LVer);
364    my $BaseType_Name = $BaseType{"Name"};
365    $BaseType_Name=~s/\A(struct|union|enum) //g;
366    if(not $BaseType_Name) {
367        return "";
368    }
369    my ($ShortName, $TmplParams) = templateBase($BaseType_Name);
370    my $Suffix = getBaseTypeQual($PTid, $LVer);
371    while($Suffix=~s/\s*(const|volatile|restrict)\Z//g){};
372    while($Suffix=~/(&|\*|const)\Z/)
373    {
374        if($Suffix=~s/[ ]*&\Z//) {
375            $MPrefix .= "R";
376        }
377        if($Suffix=~s/[ ]*\*\Z//) {
378            $MPrefix .= "P";
379        }
380        if($Suffix=~s/[ ]*const\Z//)
381        {
382            if($MPrefix=~/R|P/
383            or $Suffix=~/&|\*/) {
384                $MPrefix .= "K";
385            }
386        }
387        if($Suffix=~s/[ ]*volatile\Z//) {
388            $MPrefix .= "V";
389        }
390        #if($Suffix=~s/[ ]*restrict\Z//) {
391            #$MPrefix .= "r";
392        #}
393    }
394    if(my $Token = $IntrinsicMangling{$BaseType_Name}) {
395        $Mangled .= $Token;
396    }
397    elsif($BaseType{"Type"}=~/(Class|Struct|Union|Enum)/)
398    {
399        my @TParams = ();
400        if(my @TPos = sort {$a<=>$b} keys(%{$BaseType{"TParam"}}))
401        { # parsing mode
402            foreach (@TPos) {
403                push(@TParams, $BaseType{"TParam"}{$_}{"name"});
404            }
405        }
406        elsif($TmplParams)
407        { # remangling mode
408          # support for old ABI dumps
409            @TParams = sepParams($TmplParams, 0, 0);
410        }
411        my $MangledNS = "";
412        my ($SubNS, $SName) = getSubNs($ShortName);
413        if($SubNS) {
414            $MangledNS .= mangleNs($SubNS, $LVer, $Repl);
415        }
416        $MangledNS .= length($SName).$SName;
417        if(@TParams) {
418            addSubst($MangledNS, $Repl, 0);
419        }
420        $Mangled .= "N".$MangledNS;
421        if(@TParams)
422        { # templates
423            $Mangled .= "I";
424            foreach my $TParam (@TParams) {
425                $Mangled .= mangleTemplateParam($TParam, $LVer, $Repl);
426            }
427            $Mangled .= "E";
428        }
429        $Mangled .= "E";
430    }
431    elsif($BaseType{"Type"}=~/(FuncPtr|MethodPtr)/)
432    {
433        if($BaseType{"Type"} eq "MethodPtr") {
434            $Mangled .= "M".mangleParam($BaseType{"Class"}, $LVer, $Repl)."F";
435        }
436        else {
437            $Mangled .= "PF";
438        }
439        $Mangled .= mangleParam($BaseType{"Return"}, $LVer, $Repl);
440        my @Params = sort {$a<=>$b} keys(%{$BaseType{"Param"}});
441        foreach my $Num (@Params) {
442            $Mangled .= mangleParam($BaseType{"Param"}{$Num}{"type"}, $LVer, $Repl);
443        }
444        if(not @Params) {
445            $Mangled .= "v";
446        }
447        $Mangled .= "E";
448    }
449    elsif($BaseType{"Type"} eq "FieldPtr")
450    {
451        $Mangled .= "M".mangleParam($BaseType{"Class"}, $LVer, $Repl);
452        $Mangled .= mangleParam($BaseType{"Return"}, $LVer, $Repl);
453    }
454    $Mangled = $MPrefix.$Mangled; # add prefix (RPK)
455    if(my $Optimized = writeSubstitution($Mangled, \%ReplCopy))
456    {
457        if($Mangled eq $Optimized)
458        {
459            if($ShortName!~/::/)
460            { # remove "N ... E"
461                if($MPrefix) {
462                    $Mangled=~s/\A($MPrefix)N(.+)E\Z/$1$2/g;
463                }
464                else {
465                    $Mangled=~s/\AN(.+)E\Z/$1/g;
466                }
467            }
468        }
469        else {
470            $Mangled = $Optimized;
471        }
472    }
473    addSubst($Mangled, $Repl, 1);
474    return $Mangled;
475}
476
477sub mangleTemplateParam($$$)
478{ # types + literals
479    my ($TParam, $LVer, $Repl) = @_;
480    if(my $TPTid = $In::ABI{$LVer}{"TName_Tid"}{$TParam}) {
481        return mangleParam($TPTid, $LVer, $Repl);
482    }
483    elsif($TParam=~/\A(\d+)(\w+)\Z/)
484    { # class_name<1u>::method(...)
485        return "L".$IntrinsicMangling{$ConstantSuffixR{$2}}.$1."E";
486    }
487    elsif($TParam=~/\A\(([\w ]+)\)(\d+)\Z/)
488    { # class_name<(signed char)1>::method(...)
489        return "L".$IntrinsicMangling{$1}.$2."E";
490    }
491    elsif($TParam eq "true")
492    { # class_name<true>::method(...)
493        return "Lb1E";
494    }
495    elsif($TParam eq "false")
496    { # class_name<true>::method(...)
497        return "Lb0E";
498    }
499    else { # internal error
500        return length($TParam).$TParam;
501    }
502}
503
504sub addSubst($$$)
505{
506    my ($Value, $Repl, $Rec) = @_;
507    if($Rec)
508    { # subtypes
509        my @Subs = ($Value);
510        while($Value=~s/\A(R|P|K)//) {
511            push(@Subs, $Value);
512        }
513        foreach (reverse(@Subs)) {
514            addSubst($_, $Repl, 0);
515        }
516        return;
517    }
518    if($Value=~/\AS(\d*)_\Z/) {
519        return;
520    }
521    $Value=~s/\AN(.+)E\Z/$1/g;
522    if(defined $Repl->{$Value}) {
523        return;
524    }
525    if(length($Value)<=1) {
526        return;
527    }
528    if($StdcxxMangling{$Value}) {
529        return;
530    }
531    # check for duplicates
532    my $Base = $Value;
533    foreach my $Type (sort {$Repl->{$a}<=>$Repl->{$b}} sort keys(%{$Repl}))
534    {
535        my $Num = $Repl->{$Type};
536        my $Replace = macroMangle($Num);
537        $Base=~s/\Q$Replace\E/$Type/;
538    }
539    if(my $OldNum = $Repl->{$Base})
540    {
541        $Repl->{$Value} = $OldNum;
542        return;
543    }
544    my @Repls = sort {$b<=>$a} values(%{$Repl});
545    if(@Repls) {
546        $Repl->{$Value} = $Repls[0]+1;
547    }
548    else {
549        $Repl->{$Value} = -1;
550    }
551    # register duplicates
552    # upward
553    $Base = $Value;
554    foreach my $Type (sort {$Repl->{$a}<=>$Repl->{$b}} sort keys(%{$Repl}))
555    {
556        if($Base eq $Type) {
557            next;
558        }
559        my $Num = $Repl->{$Type};
560        my $Replace = macroMangle($Num);
561        $Base=~s/\Q$Type\E/$Replace/;
562        $Repl->{$Base} = $Repl->{$Value};
563    }
564}
565
566sub macroMangle($)
567{
568    my $Num = $_[0];
569    if($Num==-1) {
570        return "S_";
571    }
572    else
573    {
574        my $Code = "";
575        if($Num<10)
576        { # S0_, S1_, S2_, ...
577            $Code = $Num;
578        }
579        elsif($Num>=10 and $Num<=35)
580        { # SA_, SB_, SC_, ...
581            $Code = chr(55+$Num);
582        }
583        else
584        { # S10_, S11_, S12_
585            $Code = $Num-26; # 26 is length of english alphabet
586        }
587        return "S".$Code."_";
588    }
589}
590
591sub writeCxxSubstitution($)
592{
593    my $Mangled = $_[0];
594    if($StdcxxMangling{$Mangled}) {
595        return $StdcxxMangling{$Mangled};
596    }
597    else
598    {
599        my @Repls = sort {$b cmp $a} keys(%StdcxxMangling);
600        @Repls = sort {length($b)<=>length($a)} @Repls;
601        foreach my $MangledType (@Repls)
602        {
603            my $Replace = $StdcxxMangling{$MangledType};
604            #if($Mangled!~/$Replace/) {
605                $Mangled=~s/N\Q$MangledType\EE/$Replace/g;
606                $Mangled=~s/\Q$MangledType\E/$Replace/g;
607            #}
608        }
609    }
610    return $Mangled;
611}
612
613sub writeSubstitution($$)
614{
615    my ($Mangled, $Repl) = @_;
616    if(defined $Repl->{$Mangled}
617    and my $MnglNum = $Repl->{$Mangled}) {
618        $Mangled = macroMangle($MnglNum);
619    }
620    else
621    {
622        my @Repls = keys(%{$Repl});
623
624        # @Repls = sort {$Repl->{$a}<=>$Repl->{$b}} @Repls;
625        # FIXME: how to apply replacements? by num or by pos
626
627        @Repls = sort {length($b)<=>length($a)} sort {$b cmp $a} @Repls;
628        foreach my $MangledType (@Repls)
629        {
630            my $Replace = macroMangle($Repl->{$MangledType});
631            if($Mangled!~/$Replace/) {
632                $Mangled=~s/N\Q$MangledType\EE/$Replace/g;
633                $Mangled=~s/\Q$MangledType\E/$Replace/g;
634            }
635        }
636    }
637    return $Mangled;
638}
639
640sub isDefaultStd($) {
641    return ($_[0]=~/\A$DEFAULT_STD_PARMS\</);
642}
643
644sub canonifyName($$)
645{ # make TIFFStreamOpen(char const*, std::basic_ostream<char, std::char_traits<char> >*)
646  # to be TIFFStreamOpen(char const*, std::basic_ostream<char>*)
647    my ($Name, $Type) = @_;
648
649    # single
650    while($Name=~/([^<>,]+),\s*$DEFAULT_STD_PARMS<([^<>,]+)>\s*/ and $1 eq $3)
651    {
652        my $P = $1;
653        $Name=~s/\Q$P\E,\s*$DEFAULT_STD_PARMS<\Q$P\E>\s*/$P/g;
654    }
655
656    # double
657    if($Name=~/$DEFAULT_STD_PARMS/)
658    {
659        if($Type eq "S")
660        {
661            my ($ShortName, $FuncParams) = splitSignature($Name);
662
663            foreach my $FParam (sepParams($FuncParams, 0, 0))
664            {
665                if(index($FParam, "<")!=-1)
666                {
667                    $FParam=~s/>([^<>]+)\Z/>/; # remove quals
668                    my $FParam_N = canonifyName($FParam, "T");
669                    if($FParam_N ne $FParam) {
670                        $Name=~s/\Q$FParam\E/$FParam_N/g;
671                    }
672                }
673            }
674        }
675        elsif($Type eq "T")
676        {
677            my ($ShortTmpl, $TmplParams) = templateBase($Name);
678
679            my @TParams = sepParams($TmplParams, 0, 0);
680            if($#TParams>=1)
681            {
682                my $FParam = $TParams[0];
683                foreach my $Pos (1 .. $#TParams)
684                {
685                    my $TParam = $TParams[$Pos];
686                    if($TParam=~/\A$DEFAULT_STD_PARMS<\Q$FParam\E\s*>\Z/) {
687                        $Name=~s/\Q$FParam, $TParam\E\s*/$FParam/g;
688                    }
689                }
690            }
691        }
692    }
693    if($Type eq "S") {
694        return formatName($Name, "S");
695    }
696    return $Name;
697}
698
699sub getUnmangled($$)
700{
701    if(defined $TrName{$_[1]}{$_[0]}) {
702        return $TrName{$_[1]}{$_[0]};
703    }
704
705    return undef;
706}
707
708sub getMangled_GCC($$)
709{
710    if(defined $GccMangledName{$_[1]}{$_[0]}) {
711        return $GccMangledName{$_[1]}{$_[0]};
712    }
713
714    return undef;
715}
716
717sub getMangled_MSVC($$)
718{
719    if(defined $MangledName{$_[1]}{$_[0]}) {
720        return $MangledName{$_[1]}{$_[0]};
721    }
722
723    return $_[0];
724}
725
726sub translateSymbols(@)
727{
728    my $LVer = pop(@_);
729    my (@MnglNames1, @MnglNames2, @ZNames, @UnmangledNames) = ();
730    my %Versioned = ();
731
732    foreach my $Symbol (sort @_)
733    {
734        if(index($Symbol, "_Z")==0)
735        {
736            push(@ZNames, $Symbol);
737            if($TrName{$LVer}{$Symbol})
738            { # already unmangled
739                next;
740            }
741            if($Symbol=~s/([\@\$]+.*)\Z//) {
742                $Versioned{$Symbol}{$Symbol.$1} = 1;
743            }
744            else {
745                $Versioned{$Symbol}{$Symbol} = 1;
746            }
747            push(@MnglNames1, $Symbol);
748        }
749        elsif(index($Symbol, "?")==0)
750        {
751            push(@MnglNames2, $Symbol);
752        }
753    }
754    if($#MnglNames1 > -1)
755    { # GCC names
756        @UnmangledNames = reverse(unmangleArray(@MnglNames1));
757        foreach my $MnglName (@MnglNames1)
758        {
759            if(my $Unmangled = pop(@UnmangledNames))
760            {
761                foreach my $M (keys(%{$Versioned{$MnglName}}))
762                {
763                    $TrName{$LVer}{$M} = canonifyName($Unmangled, "S");
764                    if(not $GccMangledName{$LVer}{$TrName{$LVer}{$M}}) {
765                        $GccMangledName{$LVer}{$TrName{$LVer}{$M}} = $M;
766                    }
767                }
768            }
769        }
770
771        foreach my $Symbol (@ZNames)
772        {
773            if(index($Symbol, "_ZTV")==0
774            and $TrName{$LVer}{$Symbol}=~/vtable for (.+)/)
775            { # bind class name and v-table symbol
776                $In::ABI{$LVer}{"ClassVTable"}{$1} = $Symbol;
777            }
778        }
779    }
780    if($#MnglNames2 > -1)
781    { # MSVC names
782        @UnmangledNames = reverse(unmangleArray(@MnglNames2));
783        foreach my $MnglName (@MnglNames2)
784        {
785            if(my $Unmangled = pop(@UnmangledNames))
786            {
787                $TrName{$LVer}{$MnglName} = formatName($Unmangled, "S");
788                $MangledName{$LVer}{$TrName{$LVer}{$MnglName}} = $MnglName;
789            }
790        }
791    }
792    return \%{$TrName{$LVer}};
793}
794
795sub unmangleArray(@)
796{
797    if($_[0]=~/\A\?/)
798    { # MSVC mangling
799        if(defined $DisabledUnmangle_MSVC) {
800            return @_;
801        }
802        my $UndNameCmd = getCmdPath("undname");
803        if(not $UndNameCmd)
804        {
805            if($In::Opt{"OS"} eq "windows") {
806                exitStatus("Not_Found", "can't find \"undname\"");
807            }
808            elsif(not defined $DisabledUnmangle_MSVC)
809            {
810                printMsg("WARNING", "can't find \"undname\", disable MSVC unmangling");
811                $DisabledUnmangle_MSVC = 1;
812                return @_;
813            }
814        }
815        my $TmpDir = $In::Opt{"Tmp"};
816        writeFile("$TmpDir/unmangle", join("\n", @_));
817        return split(/\n/, `$UndNameCmd 0x8386 \"$TmpDir/unmangle\"`);
818    }
819    else
820    { # GCC mangling
821        my $CppFiltCmd = getCmdPath("c++filt");
822        if(not $CppFiltCmd) {
823            exitStatus("Not_Found", "can't find c++filt in PATH");
824        }
825        if(not defined $CPPFILT_SUPPORT_FILE)
826        {
827            my $Info = `$CppFiltCmd -h 2>&1`;
828            $CPPFILT_SUPPORT_FILE = ($Info=~/\@<file>/);
829        }
830        my $NoStrip = "";
831
832        if($In::Opt{"OS"}=~/macos|windows/) {
833            $NoStrip = "-n";
834        }
835
836        if($CPPFILT_SUPPORT_FILE)
837        { # new versions of c++filt can take a file
838            if($#_>$MAX_CPPFILT_INPUT)
839            { # c++filt <= 2.22 may crash on large files (larger than 8mb)
840              # this is fixed in the oncoming version of Binutils
841                my @Half = splice(@_, 0, ($#_+1)/2);
842                return (unmangleArray(@Half), unmangleArray(@_))
843            }
844            else
845            {
846                my $TmpDir = $In::Opt{"Tmp"};
847                writeFile("$TmpDir/unmangle", join("\n", @_));
848                my $Res = `$CppFiltCmd $NoStrip \@\"$TmpDir/unmangle\"`;
849                if($?==139)
850                { # segmentation fault
851                    printMsg("ERROR", "internal error - c++filt crashed, try to reduce MAX_CPPFILT_FILE_SIZE constant");
852                }
853                return split(/\n/, $Res);
854            }
855        }
856        else
857        { # old-style unmangling
858            if($#_>$MAX_CMD_ARG)
859            {
860                my @Half = splice(@_, 0, ($#_+1)/2);
861                return (unmangleArray(@Half), unmangleArray(@_))
862            }
863            else
864            {
865                my $Strings = join(" ", @_);
866                my $Res = `$CppFiltCmd $NoStrip $Strings`;
867                if($?==139)
868                { # segmentation fault
869                    printMsg("ERROR", "internal error - c++filt crashed, try to reduce MAX_COMMAND_LINE_ARGUMENTS constant");
870                }
871                return split(/\n/, $Res);
872            }
873        }
874    }
875}
876
877sub debugMangling($)
878{
879    my $LVer = $_[0];
880
881    printMsg("INFO", "Debug model mangling and unmangling ($LVer)");
882
883    my %Mangled = ();
884    foreach my $InfoId (keys(%{$In::ABI{$LVer}{"SymbolInfo"}}))
885    {
886        my $SInfo = $In::ABI{$LVer}{"SymbolInfo"}{$InfoId};
887
888        if(my $Mngl = $SInfo->{"MnglName"})
889        {
890            if(my $Class = $SInfo->{"Class"})
891            {
892                if(defined $In::ABI{$LVer}{"TypeInfo"}{$Class}{"TParam"})
893                { # mngl names are not equal because of default tmpl args
894                    next;
895                }
896
897                if(index($In::ABI{$LVer}{"TypeInfo"}{$Class}{"Name"}, "...")!=-1)
898                { # no info about tmpl args
899                    next;
900                }
901            }
902
903            if($Mngl=~/\A(_Z|\?)/) {
904                $Mangled{$Mngl} = $InfoId;
905            }
906        }
907    }
908
909    translateSymbols(keys(%Mangled), $LVer);
910
911    my $Total = keys(%Mangled);
912    my ($GoodMangling, $GoodUnmangling) = (0, 0);
913
914    foreach my $Mngl (sort keys(%Mangled))
915    {
916        my $InfoId = $Mangled{$Mngl};
917
918        my $U1 = getUnmangled($Mngl, $LVer);
919        my $U2 = modelUnmangled($InfoId, "GCC", $LVer);
920        my $U3 = mangleSymbol($InfoId, "GCC", $LVer);
921
922        if($U1 ne $U2) {
923            printMsg("INFO", "Bad model unmangling:\n  Orig:  $Mngl\n  Unmgl: $U1\n  Model: $U2\n");
924        }
925        else {
926            $GoodUnmangling += 1;
927        }
928
929        if($Mngl ne $U3) {
930            printMsg("INFO", "Bad model mangling:\n  Orig:  $Mngl\n  Model: $U3\n");
931        }
932        else {
933            $GoodMangling += 1;
934        }
935    }
936
937    printMsg("INFO", "Model unmangling: $GoodUnmangling/$Total");
938    printMsg("INFO", "Model mangling: $GoodMangling/$Total");
939}
940
941sub modelUnmangled($$$)
942{
943    my ($InfoId, $Compiler, $LVer) = @_;
944    if($Cache{"modelUnmangled"}{$LVer}{$Compiler}{$InfoId}) {
945        return $Cache{"modelUnmangled"}{$LVer}{$Compiler}{$InfoId};
946    }
947
948    my $SInfo = $In::ABI{$LVer}{"SymbolInfo"}{$InfoId};
949
950    my $PureSignature = $SInfo->{"ShortName"};
951    if($SInfo->{"Destructor"}) {
952        $PureSignature = "~".$PureSignature;
953    }
954    if(not $SInfo->{"Data"})
955    {
956        my (@Params, @ParamTypes) = ();
957        if(defined $SInfo->{"Param"}
958        and not $SInfo->{"Destructor"})
959        {
960            @Params = sort {$a<=>$b} keys(%{$SInfo->{"Param"}});
961
962            if($SInfo->{"Class"}
963            and not $SInfo->{"Static"})
964            {
965                if($SInfo->{"Param"}{"0"}{"name"} eq "this") {
966                    shift(@Params);
967                }
968            }
969        }
970        foreach my $ParamPos (@Params)
971        { # checking parameters
972            my $PTid = $SInfo->{"Param"}{$ParamPos}{"type"};
973            my $PTName = $In::ABI{$LVer}{"TypeInfo"}{$PTid}{"Name"};
974
975            $PTName = unmangledFormat($PTName, $LVer);
976            $PTName=~s/\b(restrict|register)\b//g;
977
978            if($Compiler eq "MSVC") {
979                $PTName=~s/\blong long\b/__int64/;
980            }
981            @ParamTypes = (@ParamTypes, $PTName);
982        }
983        if(@ParamTypes) {
984            $PureSignature .= "(".join(", ", @ParamTypes).")";
985        }
986        else
987        {
988            if($Compiler eq "MSVC") {
989                $PureSignature .= "(void)";
990            }
991            else
992            { # GCC
993                $PureSignature .= "()";
994            }
995        }
996        $PureSignature = deleteKeywords($PureSignature);
997    }
998    if(my $ClassId = $SInfo->{"Class"})
999    {
1000        my $ClassName = unmangledFormat($In::ABI{$LVer}{"TypeInfo"}{$ClassId}{"Name"}, $LVer);
1001        $PureSignature = $ClassName."::".$PureSignature;
1002    }
1003    elsif(my $NS = $SInfo->{"NameSpace"}) {
1004        $PureSignature = $NS."::".$PureSignature;
1005    }
1006    if($SInfo->{"Const"}) {
1007        $PureSignature .= " const";
1008    }
1009    if($SInfo->{"Volatile"}) {
1010        $PureSignature .= " volatile";
1011    }
1012    my $ShowReturn = 0;
1013    if($Compiler eq "MSVC"
1014    and $SInfo->{"Data"}) {
1015        $ShowReturn = 1;
1016    }
1017    elsif(index($SInfo->{"ShortName"}, "<")!=-1)
1018    { # template instance
1019        $ShowReturn = 1;
1020    }
1021    if($ShowReturn)
1022    { # mangled names for template function specializations include return type
1023        if(my $ReturnId = $SInfo->{"Return"})
1024        {
1025            my %RType = getPureType($ReturnId, $LVer);
1026            my $ReturnName = unmangledFormat($RType{"Name"}, $LVer);
1027            $PureSignature = $ReturnName." ".$PureSignature;
1028        }
1029    }
1030    return ($Cache{"modelUnmangled"}{$LVer}{$Compiler}{$InfoId} = formatName($PureSignature, "S"));
1031}
1032
1033sub unmangledFormat($$)
1034{
1035    my ($Name, $LibVersion) = @_;
1036    $Name = uncoverTypedefs($Name, $LibVersion);
1037    while($Name=~s/([^\w>])(const|volatile)(,|>|\Z)/$1$3/g){};
1038    $Name=~s/\(\w+\)(\d)/$1/;
1039    return $Name;
1040}
1041
1042sub isConstType($$)
1043{
1044    my ($TypeId, $LVer) = @_;
1045    my %Base = getType($TypeId, $LVer);
1046    while(defined $Base{"Type"} and $Base{"Type"} eq "Typedef") {
1047        %Base = getOneStepBaseType($Base{"Tid"}, $LVer);
1048    }
1049    return ($Base{"Type"} eq "Const");
1050}
1051
1052return 1;
1053