Home | History | Annotate | Download | only in Internals 
      1 ###########################################################################
      2 # Module for ACC tool to create a model of calling conventions
      3 #
      4 # Copyright (C) 2009-2011 Institute for System Programming, RAS
      5 # Copyright (C) 2011-2012 Nokia Corporation and/or its subsidiary(-ies)
      6 # Copyright (C) 2011-2012 ROSA Laboratory
      7 # Copyright (C) 2012-2015 Andrey Ponomarenko's ABI Laboratory
      8 #
      9 # Written by Andrey Ponomarenko
     10 #
     11 # PLATFORMS
     12 # =========
     13 #  Linux, FreeBSD and Mac OS X
     14 #    x86 - System V ABI Intel386 Architecture Processor Supplement
     15 #    x86_64 - System V ABI AMD64 Architecture Processor Supplement
     16 #
     17 #  MS Windows
     18 #    x86 - MSDN Argument Passing and Naming Conventions
     19 #    x86_64 - MSDN x64 Software Conventions
     20 #
     21 # This program is free software: you can redistribute it and/or modify
     22 # it under the terms of the GNU General Public License or the GNU Lesser
     23 # General Public License as published by the Free Software Foundation.
     24 #
     25 # This program is distributed in the hope that it will be useful,
     26 # but WITHOUT ANY WARRANTY; without even the implied warranty of
     27 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     28 # GNU General Public License for more details.
     29 #
     30 # You should have received a copy of the GNU General Public License
     31 # and the GNU Lesser General Public License along with this program.
     32 # If not, see <http://www.gnu.org/licenses/>.
     33 ###########################################################################
     34 use strict;
     35 
     36 my $BYTE = 8;
     37 
     38 my %UsedReg = ();
     39 my %UsedStack = ();
     40 
     41 my %IntAlgn = (
     42     "x86"=>{
     43         "double"=>4,
     44         "long double"=>4
     45     }
     46 );
     47 
     48 sub classifyType($$$$$)
     49 {
     50     my ($Tid, $TInfo, $Arch, $System, $Word) = @_;
     51     my %Type = get_PureType($Tid, $TInfo);
     52     my %Classes = ();
     53     if($Type{"Name"} eq "void")
     54     {
     55         $Classes{0}{"Class"} = "VOID";
     56         return %Classes;
     57     }
     58     if($System=~/\A(unix|linux|macos|freebsd)\Z/)
     59     { # GCC
     60         if($Arch eq "x86")
     61         {
     62             if(isFloat($Type{"Name"})) {
     63                 $Classes{0}{"Class"} = "FLOAT";
     64             }
     65             elsif($Type{"Type"}=~/Intrinsic|Enum|Pointer|Ptr/) {
     66                 $Classes{0}{"Class"} = "INTEGRAL";
     67             }
     68             else { # Struct, Class, Union
     69                 $Classes{0}{"Class"} = "MEMORY";
     70             }
     71         }
     72         elsif($Arch eq "x86_64")
     73         {
     74             if($Type{"Type"}=~/Enum|Pointer|Ptr/
     75             or isScalar($Type{"Name"})
     76             or $Type{"Name"}=~/\A(_Bool|bool)\Z/) {
     77                 $Classes{0}{"Class"} = "INTEGER";
     78             }
     79             elsif($Type{"Name"} eq "__int128"
     80             or $Type{"Name"} eq "unsigned __int128")
     81             {
     82                 $Classes{0}{"Class"} = "INTEGER";
     83                 $Classes{1}{"Class"} = "INTEGER";
     84             }
     85             elsif($Type{"Name"}=~/\A(float|double|_Decimal32|_Decimal64|__m64)\Z/) {
     86                 $Classes{0}{"Class"} = "SSE";
     87             }
     88             elsif($Type{"Name"}=~/\A(__float128|_Decimal128|__m128)\Z/)
     89             {
     90                 $Classes{0}{"Class"} = "SSE";
     91                 $Classes{8}{"Class"} = "SSEUP";
     92             }
     93             elsif($Type{"Name"} eq "__m256")
     94             {
     95                 $Classes{0}{"Class"} = "SSE";
     96                 $Classes{24}{"Class"} = "SSEUP";
     97             }
     98             elsif($Type{"Name"} eq "long double")
     99             {
    100                 $Classes{0}{"Class"} = "X87";
    101                 $Classes{8}{"Class"} = "X87UP";
    102             }
    103             elsif($Type{"Name"}=~/\Acomplex (float|double)\Z/) {
    104                 $Classes{0}{"Class"} = "MEMORY";
    105             }
    106             elsif($Type{"Name"} eq "complex long double") {
    107                 $Classes{0}{"Class"} = "COMPLEX_X87";
    108             }
    109             elsif($Type{"Type"}=~/Struct|Class|Union|Array/)
    110             {
    111                 if($Type{"Size"}>4*8) {
    112                     $Classes{0}{"Class"} = "MEMORY";
    113                 }
    114                 else {
    115                     %Classes = classifyAggregate($Tid, $TInfo, $Arch, $System, $Word);
    116                 }
    117             }
    118             else {
    119                 $Classes{0}{"Class"} = "MEMORY";
    120             }
    121         }
    122         elsif($Arch eq "arm")
    123         {
    124         }
    125     }
    126     elsif($System eq "windows")
    127     { # MS C++ Compiler
    128         if($Arch eq "x86")
    129         {
    130             if(isFloat($Type{"Name"})) {
    131                 $Classes{0}{"Class"} = "FLOAT";
    132             }
    133             elsif($Type{"Type"}=~/Intrinsic|Enum|Pointer|Ptr/) {
    134                 $Classes{0}{"Class"} = "INTEGRAL";
    135             }
    136             elsif($Type{"Type"}=~/\A(Struct|Union)\Z/ and $Type{"Size"}<=8) {
    137                 $Classes{0}{"Class"} = "POD";
    138             }
    139             else { # Struct, Class, Union
    140                 $Classes{0}{"Class"} = "MEMORY";
    141             }
    142         }
    143         elsif($Arch eq "x86_64")
    144         {
    145             if($Type{"Name"}=~/\A(float|double|long double)\Z/) {
    146                 $Classes{0}{"Class"} = "FLOAT";
    147             }
    148             elsif($Type{"Name"}=~/\A__m128(|i|d)\Z/) {
    149                 $Classes{0}{"Class"} = "M128";
    150             }
    151             elsif(isScalar($Type{"Name"})
    152             or $Type{"Type"}=~/Enum|Pointer|Ptr/
    153             or $Type{"Name"}=~/\A(_Bool|bool)\Z/
    154             or ($Type{"Type"}=~/\A(Struct|Union)\Z/ and $Type{"Size"}<=8)
    155             or $Type{"Name"} eq "__m64") {
    156                 $Classes{0}{"Class"} = "INTEGRAL";
    157             }
    158             else {
    159                 $Classes{0}{"Class"} = "MEMORY";
    160             }
    161         }
    162     }
    163     return %Classes;
    164 }
    165 
    166 sub classifyAggregate($$$$$)
    167 {
    168     my ($Tid, $TInfo, $Arch, $System, $Word) = @_;
    169     my %Type = get_PureType($Tid, $TInfo);
    170     my %Group = ();
    171     my $GroupID = 0;
    172     my %Classes = ();
    173     my %Offsets = ();
    174     if($Type{"Type"} eq "Array")
    175     {
    176         my %Base = get_OneStep_BaseType($Tid, $TInfo);
    177         my %BaseType = get_PureType($Base{"Tid"}, $TInfo);
    178         my $Pos = 0;
    179         my $Max = 0;
    180         if(my $BSize = $BaseType{"Size"}) {
    181             $Max = ($Type{"Size"}/$BSize) - 1;
    182         }
    183         foreach my $Pos (0 .. $Max)
    184         {
    185             # if($TInfo->{1}{"Name"} eq "void")
    186             # { # DWARF ABI Dump
    187             #     $Type{"Memb"}{$Pos}{"offset"} = $Type{"Size"}/($Max+1);
    188             # }
    189             $Type{"Memb"}{$Pos}{"algn"} = getAlignment_Model($BaseType{"Tid"}, $TInfo, $Arch);
    190             $Type{"Memb"}{$Pos}{"type"} = $BaseType{"Tid"};
    191             $Type{"Memb"}{$Pos}{"name"} = "[$Pos]";
    192         }
    193     }
    194     if($Type{"Type"} eq "Union")
    195     {
    196         foreach my $Pos (keys(%{$Type{"Memb"}}))
    197         {
    198             $Offsets{$Pos} = $Pos;
    199             $Group{0}{$Pos} = 1;
    200         }
    201     }
    202     else
    203     { # Struct, Class
    204         foreach my $Pos (keys(%{$Type{"Memb"}}))
    205         {
    206             my $Offset = getOffset($Pos, \%Type, $TInfo, $Arch, $Word)/$BYTE;
    207             $Offsets{$Pos} = $Offset;
    208             my $GroupOffset = int($Offset/$Word)*$Word;
    209             $Group{$GroupOffset}{$Pos} = 1;
    210         }
    211     }
    212     foreach my $GroupOffset (sort {int($a)<=>int($b)} (keys(%Group)))
    213     {
    214         my %GroupClasses = ();
    215         foreach my $Pos (sort {int($a)<=>int($b)} (keys(%{$Group{$GroupOffset}})))
    216         { # split the field into the classes
    217             my $MTid = $Type{"Memb"}{$Pos}{"type"};
    218             my $MName = $Type{"Memb"}{$Pos}{"name"};
    219             my %SubClasses = classifyType($MTid, $TInfo, $Arch, $System, $Word);
    220             foreach my $Offset (sort {int($a)<=>int($b)} keys(%SubClasses))
    221             {
    222                 if(defined $SubClasses{$Offset}{"Elems"})
    223                 {
    224                     foreach (keys(%{$SubClasses{$Offset}{"Elems"}})) {
    225                         $SubClasses{$Offset}{"Elems"}{$_} = joinFields($MName, $SubClasses{$Offset}{"Elems"}{$_});
    226                     }
    227                 }
    228                 else {
    229                     $SubClasses{$Offset}{"Elems"}{0} = $MName;
    230                 }
    231             }
    232             
    233             # add to the group
    234             foreach my $Offset (sort {int($a)<=>int($b)} keys(%SubClasses)) { 
    235                 $GroupClasses{$Offsets{$Pos}+$Offset} = $SubClasses{$Offset};
    236             }
    237         }
    238         
    239         # merge classes in the group
    240         my %MergeGroup = ();
    241         
    242         foreach my $Offset (sort {int($a)<=>int($b)} keys(%GroupClasses)) {
    243             $MergeGroup{int($Offset/$Word)}{$Offset} = $GroupClasses{$Offset};
    244         }
    245         
    246         foreach my $Offset (sort {int($a)<=>int($b)} keys(%MergeGroup)) {
    247             while(postMerger($Arch, $System, $MergeGroup{$Offset})) { };
    248         }
    249         
    250         %GroupClasses = ();
    251         foreach my $M_Offset (sort {int($a)<=>int($b)} keys(%MergeGroup))
    252         {
    253             foreach my $Offset (sort {int($a)<=>int($b)} keys(%{$MergeGroup{$M_Offset}}))
    254             {
    255                 $GroupClasses{$Offset} = $MergeGroup{$M_Offset}{$Offset};
    256             }
    257         }
    258         
    259         # add to the result list of classes
    260         foreach my $Offset (sort {int($a)<=>int($b)} keys(%GroupClasses))
    261         {
    262             if($Type{"Type"} eq "Union")
    263             {
    264                 foreach my $P (keys(%{$GroupClasses{$Offset}{"Elems"}}))
    265                 {
    266                     if($P!=0) {
    267                         delete($GroupClasses{$Offset}{"Elems"}{$P});
    268                     }
    269                 }
    270             }
    271             $Classes{$Offset} = $GroupClasses{$Offset};
    272         }
    273     }
    274     
    275     return %Classes;
    276 }
    277 
    278 sub postMerger($$$)
    279 {
    280     my ($Arch, $System, $PreClasses) = @_;
    281     my @Offsets = sort {int($a)<=>int($b)} keys(%{$PreClasses});
    282     if($#Offsets==0) {
    283         return 0;
    284     }
    285     my %PostClasses = ();
    286     my $Num = 0;
    287     my $Merged = 0;
    288     while($Num<=$#Offsets-1)
    289     {
    290         my $Offset1 = $Offsets[$Num];
    291         my $Offset2 = $Offsets[$Num+1];
    292         my $Class1 = $PreClasses->{$Offset1}{"Class"};
    293         my $Class2 = $PreClasses->{$Offset2}{"Class"};
    294         my $ResClass = "";
    295         if($System=~/\A(unix|linux|macos|freebsd)\Z/)
    296         { # GCC
    297             if($Arch eq "x86_64")
    298             {
    299                 if($Class1 eq $Class2) {
    300                     $ResClass = $Class1;
    301                 }
    302                 elsif($Class1 eq "MEMORY"
    303                 or $Class2 eq "MEMORY") {
    304                     $ResClass = "MEMORY";
    305                 }
    306                 elsif($Class1 eq "INTEGER"
    307                 or $Class2 eq "INTEGER") {
    308                     $ResClass = "INTEGER";
    309                 }
    310                 elsif($Class1=~/X87/
    311                 or $Class2=~/X87/) {
    312                     $ResClass = "MEMORY";
    313                 }
    314                 else {
    315                     $ResClass = "SSE";
    316                 }
    317             }
    318         }
    319         if($ResClass)
    320         { # combine
    321             $PostClasses{$Offset1}{"Class"} = $ResClass;
    322             foreach (keys(%{$PreClasses->{$Offset1}{"Elems"}})) {
    323                 $PostClasses{$Offset1}{"Elems"}{$Offset1+$_} = $PreClasses->{$Offset1}{"Elems"}{$_};
    324             }
    325             foreach (keys(%{$PreClasses->{$Offset2}{"Elems"}})) {
    326                 $PostClasses{$Offset1}{"Elems"}{$Offset2+$_} = $PreClasses->{$Offset2}{"Elems"}{$_};
    327             }
    328             $Merged = 1;
    329         }
    330         else
    331         { # save unchanged
    332             $PostClasses{$Offset1} = $PreClasses->{$Offset1};
    333             $PostClasses{$Offset2} = $PreClasses->{$Offset2};
    334         }
    335         $Num += 2;
    336     }
    337     if($Num==$#Offsets) {
    338         $PostClasses{$Offsets[$Num]} = $PreClasses->{$Offsets[$Num]};
    339     }
    340     %{$PreClasses} = %PostClasses;
    341     return $Merged;
    342 }
    343 
    344 sub callingConvention_R_Model($$$$$$) {
    345     return callingConvention_R_I_Model(@_, 1);
    346 }
    347 
    348 sub joinFields($$)
    349 {
    350     my ($F1, $F2) = @_;
    351     if(substr($F2, 0, 1) eq "[")
    352     { # array elements
    353         return $F1.$F2;
    354     }
    355     else { # fields
    356         return $F1.".".$F2;
    357     }
    358 }
    359 
    360 sub callingConvention_R_I_Model($$$$$$)
    361 {
    362     my ($SInfo, $TInfo, $Arch, $System, $Word, $Target) = @_;
    363     my %Conv = ();
    364     my $RTid = $SInfo->{"Return"};
    365     my %Type = get_PureType($RTid, $TInfo);
    366     
    367     if($Target) {
    368         %UsedReg = ();
    369     }
    370     
    371     my %UsedReg_Copy = %UsedReg;
    372     
    373     my %Classes = classifyType($RTid, $TInfo, $Arch, $System, $Word);
    374     
    375     foreach my $Offset (sort {int($a)<=>int($b)} keys(%Classes))
    376     {
    377         my $Elems = undef;
    378         if(defined $Classes{$Offset}{"Elems"})
    379         {
    380             foreach (keys(%{$Classes{$Offset}{"Elems"}})) {
    381                 $Classes{$Offset}{"Elems"}{$_} = joinFields(".result", $Classes{$Offset}{"Elems"}{$_});
    382             }
    383             $Elems = $Classes{$Offset}{"Elems"};
    384         }
    385         else {
    386             $Elems = { 0 => ".result" };
    387         }
    388         
    389         my $CName = $Classes{$Offset}{"Class"};
    390         
    391         if($CName eq "VOID") {
    392             next;
    393         }
    394         
    395         if($System=~/\A(unix|linux|macos|freebsd)\Z/)
    396         { # GCC
    397             if($Arch eq "x86")
    398             {
    399                 if($CName eq "FLOAT")
    400                 { # x87 register
    401                     useRegister("st0", "f", $Elems, $SInfo);
    402                 }
    403                 elsif($CName eq "INTEGRAL")
    404                 {
    405                     useRegister("eax", "f", $Elems, $SInfo);
    406                 }
    407                 elsif($CName eq "MEMORY") {
    408                     pushStack_R($SInfo, $Word);
    409                 }
    410             }
    411             elsif($Arch eq "x86_64")
    412             {
    413                 my @INT = ("rax", "rdx");
    414                 my @SSE = ("xmm0", "xmm1");
    415                 if($CName eq "INTEGER")
    416                 {
    417                     if(my $R = getLastAvailable($SInfo, "f", @INT))
    418                     {
    419                         useRegister($R, "f", $Elems, $SInfo);
    420                     }
    421                     else
    422                     { # revert registers
    423                       # pass as MEMORY
    424                         %UsedReg = %UsedReg_Copy;
    425                         useHidden($SInfo, $Arch, $System, $Word);
    426                         $Conv{"Hidden"} = 1;
    427                         last;
    428                     }
    429                 }
    430                 elsif($CName eq "SSE")
    431                 {
    432                     if(my $R = getLastAvailable($SInfo, "8l", @SSE))
    433                     {
    434                         useRegister($R, "8l", $Elems, $SInfo);
    435                     }
    436                     else
    437                     {
    438                         %UsedReg = %UsedReg_Copy;
    439                         useHidden($SInfo, $Arch, $System, $Word);
    440                         $Conv{"Hidden"} = 1;
    441                         last;
    442                     }
    443                 }
    444                 elsif($CName eq "SSEUP")
    445                 {
    446                     if(my $R = getLastUsed($SInfo, "xmm0", "xmm1"))
    447                     {
    448                         useRegister($R, "8h", $Elems, $SInfo);
    449                     }
    450                     else
    451                     {
    452                         %UsedReg = %UsedReg_Copy;
    453                         useHidden($SInfo, $Arch, $System, $Word);
    454                         $Conv{"Hidden"} = 1;
    455                         last;
    456                     }
    457                 }
    458                 elsif($CName eq "X87")
    459                 {
    460                     useRegister("st0", "8l", $Elems, $SInfo);
    461                 }
    462                 elsif($CName eq "X87UP")
    463                 {
    464                     useRegister("st0", "8h", $Elems, $SInfo);
    465                 }
    466                 elsif($CName eq "COMPLEX_X87")
    467                 {
    468                     useRegister("st0", "f", $Elems, $SInfo);
    469                     useRegister("st1", "f", $Elems, $SInfo);
    470                 }
    471                 elsif($CName eq "MEMORY")
    472                 {
    473                     useHidden($SInfo, $Arch, $System, $Word);
    474                     $Conv{"Hidden"} = 1;
    475                     last;
    476                 }
    477             }
    478             elsif($Arch eq "arm")
    479             { # TODO
    480             }
    481         }
    482         elsif($System eq "windows")
    483         { # MS C++ Compiler
    484             if($Arch eq "x86")
    485             {
    486                 if($CName eq "FLOAT")
    487                 {
    488                     useRegister("fp0", "f", $Elems, $SInfo);
    489                 }
    490                 elsif($CName eq "INTEGRAL")
    491                 {
    492                     useRegister("eax", "f", $Elems, $SInfo);
    493                 }
    494                 elsif($CName eq "POD")
    495                 {
    496                     useRegister("eax", "f", $Elems, $SInfo);
    497                     useRegister("edx", "f", $Elems, $SInfo);
    498                 }
    499                 elsif($CName eq "MEMORY" or $CName eq "M128")
    500                 {
    501                     useHidden($SInfo, $Arch, $System, $Word);
    502                     $Conv{"Hidden"} = 1;
    503                 }
    504             }
    505             elsif($Arch eq "x86_64")
    506             {
    507                 if($CName eq "FLOAT" or $CName eq "M128")
    508                 {
    509                     useRegister("xmm0", "f", $Elems, $SInfo);
    510                 }
    511                 elsif($CName eq "INTEGRAL")
    512                 {
    513                     useRegister("eax", "f", $Elems, $SInfo);
    514                 }
    515                 elsif($CName eq "MEMORY")
    516                 {
    517                     useHidden($SInfo, $Arch, $System, $Word);
    518                     $Conv{"Hidden"} = 1;
    519                 }
    520             }
    521         }
    522     }
    523     
    524     
    525     if(my %Regs = usedBy(".result", $SInfo))
    526     {
    527         $Conv{"Method"} = "reg";
    528         $Conv{"Registers"} = join(", ", sort(keys(%Regs)));
    529     }
    530     elsif(my %Regs = usedBy(".result_ptr", $SInfo))
    531     {
    532         $Conv{"Method"} = "reg";
    533         $Conv{"Registers"} = join(", ", sort(keys(%Regs)));
    534     }
    535     
    536     if(not $Conv{"Method"})
    537     { # unknown
    538         if($Type{"Name"} ne "void")
    539         {
    540             $Conv{"Method"} = "stack";
    541             $Conv{"Hidden"} = 1;
    542         }
    543     }
    544     
    545     return %Conv;
    546 }
    547 
    548 sub usedBy($$)
    549 {
    550     my ($Name, $SInfo) = @_;
    551     my %Regs = ();
    552     foreach my $Reg (sort keys(%{$UsedReg{$SInfo}}))
    553     {
    554         foreach my $Size (sort keys(%{$UsedReg{$SInfo}{$Reg}}))
    555         {
    556             foreach my $Offset (sort keys(%{$UsedReg{$SInfo}{$Reg}{$Size}}))
    557             {
    558                 if($UsedReg{$SInfo}{$Reg}{$Size}{$Offset}=~/\A\Q$Name\E(\.|\Z)/) {
    559                     $Regs{$Reg} = 1;
    560                 }
    561             }
    562         }
    563     }
    564     return %Regs;
    565 }
    566 
    567 sub useHidden($$$$)
    568 {
    569     my ($SInfo, $Arch, $System, $Word) = @_;
    570     if($System=~/\A(unix|linux|macos|freebsd)\Z/)
    571     { # GCC
    572         if($Arch eq "x86") {
    573             pushStack_R($SInfo, $Word);
    574         }
    575         elsif($Arch eq "x86_64")
    576         {
    577             my $Elems = { 0 => ".result_ptr" };
    578             useRegister("rdi", "f", $Elems, $SInfo);
    579         }
    580     }
    581     elsif($System eq "windows")
    582     { # MS C++ Compiler
    583         if($Arch eq "x86") {
    584             pushStack_R($SInfo, $Word);
    585         }
    586         elsif($Arch eq "x86_64")
    587         {
    588             my $Elems = { 0 => ".result_ptr" };
    589             useRegister("rcx", "f", $Elems, $SInfo);
    590         }
    591     }
    592 }
    593 
    594 sub pushStack_P($$$$)
    595 {
    596     my ($SInfo, $Pos, $TInfo, $StackAlgn) = @_;
    597     my $PTid = $SInfo->{"Param"}{$Pos}{"type"};
    598     my $PName = $SInfo->{"Param"}{$Pos}{"name"};
    599     
    600     if(my $Offset = $SInfo->{"Param"}{$Pos}{"offset"})
    601     { # DWARF ABI Dump
    602         return pushStack_Offset($SInfo, $Offset, $TInfo->{$PTid}{"Size"}, { 0 => $PName });
    603     }
    604     else
    605     {
    606         my $Alignment = $SInfo->{"Param"}{$Pos}{"algn"};
    607         if($Alignment<$StackAlgn) {
    608             $Alignment = $StackAlgn;
    609         }
    610         return pushStack($SInfo, $Alignment, $TInfo->{$PTid}{"Size"}, { 0 => $PName });
    611     }
    612 }
    613 
    614 sub pushStack_R($$)
    615 {
    616     my ($SInfo, $Word) = @_;
    617     return pushStack($SInfo, $Word, $Word, { 0 => ".result_ptr" });
    618 }
    619 
    620 sub pushStack_C($$$)
    621 {
    622     my ($SInfo, $Class, $TInfo) = @_;
    623     return pushStack($SInfo, $Class->{"Algn"}, $Class->{"Size"}, $Class->{"Elems"});
    624 }
    625 
    626 sub pushStack($$$$)
    627 {
    628     my ($SInfo, $Algn, $Size, $Elem) = @_;
    629     my $Offset = 0;
    630     if(my @Offsets = sort {int($a)<=>int($b)} keys(%{$UsedStack{$SInfo}}))
    631     {
    632         $Offset = $Offsets[$#Offsets];
    633         $Offset += $UsedStack{$SInfo}{$Offset}{"Size"};
    634         $Offset += getPadding($Offset, $Algn);
    635     }
    636     return pushStack_Offset($SInfo, $Offset, $Size, $Elem);
    637 }
    638 
    639 sub pushStack_Offset($$$$)
    640 {
    641     my ($SInfo, $Offset, $Size, $Elem) = @_;
    642     my %Info = (
    643         "Size" => $Size,
    644         "Elem" => $Elem
    645     );
    646     $UsedStack{$SInfo}{$Offset} = \%Info;
    647     return $Offset;
    648 }
    649 
    650 sub useRegister($$$$)
    651 {
    652     my ($R, $Offset, $Elems, $SInfo) = @_;
    653     if(defined $UsedReg{$SInfo}{$R})
    654     {
    655         if(defined $UsedReg{$SInfo}{$R}{$Offset})
    656         { # busy
    657             return 0;
    658         }
    659     }
    660     $UsedReg{$SInfo}{$R}{$Offset}=$Elems;
    661     return $R;
    662 }
    663 
    664 sub getLastAvailable(@)
    665 {
    666     my $SInfo = shift(@_);
    667     my $Offset = shift(@_);
    668     my $Pos = 0;
    669     foreach (@_)
    670     {
    671         if(not defined $UsedReg{$SInfo}{$_}) {
    672             return $_;
    673         }
    674         elsif(not defined $UsedReg{$SInfo}{$_}{$Offset}) {
    675             return $_;
    676         }
    677     }
    678     return undef;
    679 }
    680 
    681 sub getLastUsed(@)
    682 {
    683     my $SInfo = shift(@_);
    684     my $Pos = 0;
    685     foreach (@_)
    686     {
    687         if(not defined $UsedReg{$SInfo}{$_})
    688         {
    689             if($Pos>0) {
    690                 return @_[$Pos-1];
    691             }
    692             else {
    693                 return @_[0];
    694             }
    695         }
    696         $Pos+=1;
    697     }
    698     return undef;
    699 }
    700 
    701 sub callingConvention_P_Model($$$$$$) {
    702     return callingConvention_P_I_Model(@_, 1);
    703 }
    704 
    705 sub callingConvention_P_I_Model($$$$$$$)
    706 { # calling conventions for different compilers and operating systems
    707     my ($SInfo, $Pos, $TInfo, $Arch, $System, $Word, $Target) = @_;
    708     my %Conv = ();
    709     my $ParamTypeId = $SInfo->{"Param"}{$Pos}{"type"};
    710     my $PName = $SInfo->{"Param"}{$Pos}{"name"};
    711     my %Type = get_PureType($ParamTypeId, $TInfo);
    712     
    713     if($Target)
    714     {
    715         %UsedReg = ();
    716         
    717         # distribute return value
    718         if(my $RTid = $SInfo->{"Return"}) {
    719             callingConvention_R_I_Model($SInfo, $TInfo, $Arch, $System, $Word, 0);
    720         }
    721         # distribute other parameters
    722         if($Pos>0)
    723         {
    724             my %PConv = ();
    725             my $PPos = 0;
    726             while($PConv{"Next"} ne $Pos)
    727             {
    728                 %PConv = callingConvention_P_I_Model($SInfo, $PPos++, $TInfo, $Arch, $System, $Word, 0);
    729                 if(not $PConv{"Next"}) {
    730                     last;
    731                 }
    732             }
    733         }
    734     }
    735     
    736     my %UsedReg_Copy = %UsedReg;
    737     
    738     my %Classes = classifyType($ParamTypeId, $TInfo, $Arch, $System, $Word);
    739     
    740     my $Error = 0;
    741     foreach my $Offset (sort {int($a)<=>int($b)} keys(%Classes))
    742     {
    743         my $Elems = undef;
    744         if(defined $Classes{$Offset}{"Elems"})
    745         {
    746             foreach (keys(%{$Classes{$Offset}{"Elems"}})) {
    747                 $Classes{$Offset}{"Elems"}{$_} = joinFields($PName, $Classes{$Offset}{"Elems"}{$_});
    748             }
    749             $Elems = $Classes{$Offset}{"Elems"};
    750         }
    751         else {
    752             $Elems = { 0 => $PName };
    753         }
    754         
    755         my $CName = $Classes{$Offset}{"Class"};
    756         
    757         if($CName eq "VOID") {
    758             next;
    759         }
    760         
    761         if($System=~/\A(unix|linux|macos|freebsd)\Z/)
    762         { # GCC
    763             if($Arch eq "x86")
    764             {
    765                 pushStack_P($SInfo, $Pos, $TInfo, $Word);
    766                 last;
    767             }
    768             elsif($Arch eq "x86_64")
    769             {
    770                 my @INT = ("rdi", "rsi", "rdx", "rcx", "r8", "r9");
    771                 my @SSE = ("xmm0", "xmm1", "xmm2", "xmm3", "xmm4", "xmm5", "xmm6", "xmm7");
    772                 
    773                 if($CName eq "INTEGER")
    774                 {
    775                     if(my $R = getLastAvailable($SInfo, "f", @INT)) {
    776                         useRegister($R, "f", $Elems, $SInfo);
    777                     }
    778                     else
    779                     { # revert registers and
    780                       # push the argument on the stack
    781                         %UsedReg = %UsedReg_Copy;
    782                         pushStack_P($SInfo, $Pos, $TInfo, $Word);
    783                         last;
    784                     }
    785                 }
    786                 elsif($CName eq "SSE")
    787                 {
    788                     if(my $R = getLastAvailable($SInfo, "8l", @SSE)) {
    789                         useRegister($R, "8l", $Elems, $SInfo);
    790                     }
    791                     else
    792                     {
    793                         %UsedReg = %UsedReg_Copy;
    794                         pushStack_P($SInfo, $Pos, $TInfo, $Word);
    795                         last;
    796                     }
    797                 }
    798                 elsif($CName eq "SSEUP")
    799                 {
    800                     if(my $R = getLastUsed($SInfo, @SSE)) {
    801                         useRegister($R, "8h", $Elems, $SInfo);
    802                     }
    803                     else
    804                     {
    805                         %UsedReg = %UsedReg_Copy;
    806                         pushStack_P($SInfo, $Pos, $TInfo, $Word);
    807                         last;
    808                     }
    809                 }
    810                 elsif($CName=~/X87|MEMORY/)
    811                 { # MEMORY, X87, X87UP, COMPLEX_X87
    812                     pushStack_P($SInfo, $Pos, $TInfo, $Word);
    813                     last;
    814                 }
    815                 else
    816                 {
    817                     pushStack_P($SInfo, $Pos, $TInfo, $Word);
    818                     last;
    819                 }
    820             }
    821             elsif($Arch eq "arm")
    822             { # Procedure Call Standard for the ARM Architecture
    823               # TODO
    824                 pushStack_P($SInfo, $Pos, $TInfo, $Word);
    825                 last;
    826             }
    827             else
    828             { # TODO
    829                 pushStack_P($SInfo, $Pos, $TInfo, $Word);
    830                 last;
    831             }
    832         }
    833         elsif($System eq "windows")
    834         { # MS C++ Compiler
    835             if($Arch eq "x86")
    836             {
    837                 pushStack_P($SInfo, $Pos, $TInfo, $Word);
    838                 last;
    839             }
    840             elsif($Arch eq "x86_64")
    841             {
    842                 if($Pos<=3)
    843                 {
    844                     if($CName eq "FLOAT")
    845                     {
    846                         useRegister("xmm".$Pos, "8l", $Elems, $SInfo);
    847                     }
    848                     elsif($CName eq "INTEGRAL")
    849                     {
    850                         if($Pos==0) {
    851                             useRegister("rcx", "f", $Elems, $SInfo);
    852                         }
    853                         elsif($Pos==1) {
    854                             useRegister("rdx", "f", $Elems, $SInfo);
    855                         }
    856                         elsif($Pos==2) {
    857                             useRegister("r8", "f", $Elems, $SInfo);
    858                         }
    859                         elsif($Pos==3) {
    860                             useRegister("r9", "f", $Elems, $SInfo);
    861                         }
    862                         else
    863                         {
    864                             pushStack_P($SInfo, $Pos, $TInfo, $Word);
    865                             last;
    866                         }
    867                     }
    868                     else
    869                     {
    870                         pushStack_P($SInfo, $Pos, $TInfo, $Word);
    871                         last;
    872                     }
    873                 }
    874                 else
    875                 {
    876                     pushStack_P($SInfo, $Pos, $TInfo, $Word);
    877                     last;
    878                 }
    879             }
    880         }
    881         else
    882         { # TODO
    883             pushStack_P($SInfo, $Pos, $TInfo, $Word);
    884             last;
    885         }
    886     }
    887     
    888     if(my %Regs = usedBy($PName, $SInfo))
    889     {
    890         $Conv{"Method"} = "reg";
    891         $Conv{"Registers"} = join(", ", sort(keys(%Regs)));
    892     }
    893     else
    894     {
    895         if($Type{"Name"} ne "void") {
    896             $Conv{"Method"} = "stack";
    897         }
    898     }
    899     
    900     if(defined $SInfo->{"Param"}{$Pos+1})
    901     { # TODO
    902         $Conv{"Next"} = $Pos+1;
    903     }
    904     
    905     return %Conv;
    906 }
    907 
    908 sub getAlignment_Model($$$)
    909 {
    910     my ($Tid, $TInfo, $Arch) = @_;
    911     
    912     if(not $Tid)
    913     { # incomplete ABI dump
    914         return 0;
    915     }
    916     
    917     if(defined $TInfo->{$Tid}{"Algn"}) {
    918         return $TInfo->{$Tid}{"Algn"};
    919     }
    920     else
    921     {
    922         if($TInfo->{$Tid}{"Type"}=~/Struct|Class|Union|MethodPtr/)
    923         {
    924             if(defined $TInfo->{$Tid}{"Memb"})
    925             {
    926                 my $Max = 0;
    927                 foreach my $Pos (keys(%{$TInfo->{$Tid}{"Memb"}}))
    928                 {
    929                     my $Algn = $TInfo->{$Tid}{"Memb"}{$Pos}{"algn"};
    930                     if(not $Algn) {
    931                         $Algn = getAlignment_Model($TInfo->{$Tid}{"Memb"}{$Pos}{"type"}, $TInfo, $Arch);
    932                     }
    933                     if($Algn>$Max) {
    934                         $Max = $Algn;
    935                     }
    936                 }
    937                 return $Max;
    938             }
    939             return 0;
    940         }
    941         elsif($TInfo->{$Tid}{"Type"} eq "Array")
    942         {
    943             my %Base = get_OneStep_BaseType($Tid, $TInfo);
    944             
    945             if($Base{"Tid"} eq $Tid)
    946             { # emergency exit
    947                 return 0;
    948             }
    949             
    950             return getAlignment_Model($Base{"Tid"}, $TInfo, $Arch);
    951         }
    952         elsif($TInfo->{$Tid}{"Type"}=~/Intrinsic|Enum|Pointer|FuncPtr/)
    953         { # model
    954             return getInt_Algn($Tid, $TInfo, $Arch);
    955         }
    956         else
    957         {
    958             my %PureType = get_PureType($Tid, $TInfo);
    959             
    960             if($PureType{"Tid"} eq $Tid)
    961             { # emergency exit
    962                 return 0;
    963             }
    964             
    965             return getAlignment_Model($PureType{"Tid"}, $TInfo, $Arch);
    966         }
    967     }
    968 }
    969 
    970 sub getInt_Algn($$$)
    971 {
    972     my ($Tid, $TInfo, $Arch) = @_;
    973     my $Name = $TInfo->{$Tid}{"Name"};
    974     if(my $Algn = $IntAlgn{$Arch}{$Name}) {
    975         return $Algn;
    976     }
    977     else
    978     {
    979         my $Size = $TInfo->{$Tid}{"Size"};
    980         if($Arch eq "x86_64")
    981         { # x86_64: sizeof==alignment
    982             return $Size;
    983         }
    984         elsif($Arch eq "arm")
    985         {
    986             if($Size>8)
    987             { # 128-bit vector (16)
    988                 return 8;
    989             }
    990             return $Size;
    991         }
    992         elsif($Arch eq "x86")
    993         {
    994             if($Size>4)
    995             { # "double" (8) and "long double" (12)
    996                 return 4;
    997             }
    998             return $Size;
    999         }
   1000         return $Size;
   1001     }
   1002 }
   1003 
   1004 sub getAlignment($$$$$)
   1005 {
   1006     my ($Pos, $TypePtr, $TInfo, $Arch, $Word) = @_;
   1007     my $Tid = $TypePtr->{"Memb"}{$Pos}{"type"};
   1008     my %Type = get_PureType($Tid, $TInfo);
   1009     my $Computed = $TypePtr->{"Memb"}{$Pos}{"algn"};
   1010     my  $Alignment = 0;
   1011     
   1012     if(my $BSize = $TypePtr->{"Memb"}{$Pos}{"bitfield"})
   1013     { # bitfields
   1014         if($Computed)
   1015         { # real in bits
   1016             $Alignment = $Computed;
   1017         }
   1018         else
   1019         { # model
   1020             if($BSize eq $Type{"Size"}*$BYTE)
   1021             {
   1022                 $Alignment = $BSize;
   1023             }
   1024             else {
   1025                 $Alignment = 1;
   1026             }
   1027         }
   1028         return ($Alignment, $BSize);
   1029     }
   1030     else
   1031     { # other fields
   1032         if($Computed)
   1033         { # real in bytes
   1034             $Alignment = $Computed*$BYTE;
   1035         }
   1036         else
   1037         { # model
   1038             $Alignment = getAlignment_Model($Tid, $TInfo, $Arch)*$BYTE;
   1039         }
   1040         return ($Alignment, $Type{"Size"}*$BYTE);
   1041     }
   1042 }
   1043 
   1044 sub getOffset($$$$$)
   1045 { # offset of the field including padding
   1046     my ($FieldPos, $TypePtr, $TInfo, $Arch, $Word) = @_;
   1047     
   1048     if($TypePtr->{"Type"} eq "Union") {
   1049         return 0;
   1050     }
   1051     
   1052     # if((my $Off = $TypePtr->{"Memb"}{$FieldPos}{"offset"}) ne "")
   1053     # { # DWARF ABI Dump (generated by the ABI Dumper tool)
   1054     #    return $Off*$BYTE;
   1055     # }
   1056     
   1057     my $Offset = 0;
   1058     my $Buffer=0;
   1059     
   1060     foreach my $Pos (0 .. keys(%{$TypePtr->{"Memb"}})-1)
   1061     {
   1062         my ($Alignment, $MSize) = getAlignment($Pos, $TypePtr, $TInfo, $Arch, $Word);
   1063         
   1064         if(not $Alignment)
   1065         { # support for old ABI dumps
   1066             if($MSize=~/\A(8|16|32|64)\Z/)
   1067             {
   1068                 if($Buffer+$MSize<$Word*$BYTE)
   1069                 {
   1070                     $Alignment = 1;
   1071                     $Buffer += $MSize;
   1072                 }
   1073                 else
   1074                 {
   1075                     $Alignment = $MSize;
   1076                     $Buffer = 0;
   1077                 }
   1078             }
   1079             else
   1080             {
   1081                 $Alignment = 1;
   1082                 $Buffer += $MSize;
   1083             }
   1084         }
   1085         
   1086         # padding
   1087         $Offset += getPadding($Offset, $Alignment);
   1088         if($Pos==$FieldPos)
   1089         { # after the padding
   1090           # before the field
   1091             return $Offset;
   1092         }
   1093         $Offset += $MSize;
   1094     }
   1095     return $FieldPos; # if something is going wrong
   1096 }
   1097 
   1098 sub getPadding($$)
   1099 {
   1100     my ($Offset, $Alignment) = @_;
   1101     my $Padding = 0;
   1102     if($Offset % $Alignment!=0)
   1103     { # not aligned, add padding
   1104         $Padding = $Alignment - $Offset % $Alignment;
   1105     }
   1106     return $Padding;
   1107 }
   1108 
   1109 sub isMemPadded($$$$$$)
   1110 { # check if the target field can be added/removed/changed
   1111   # without shifting other fields because of padding bits
   1112     my ($FieldPos, $Size, $TypePtr, $Skip, $TInfo, $Arch, $Word) = @_;
   1113     return 0 if($FieldPos==0);
   1114     delete($TypePtr->{"Memb"}{""});
   1115     my $Offset = 0;
   1116     my (%Alignment, %MSize) = ();
   1117     my $MaxAlgn = 0;
   1118     my $End = keys(%{$TypePtr->{"Memb"}})-1;
   1119     my $NextField = $FieldPos+1;
   1120     foreach my $Pos (0 .. $End)
   1121     {
   1122         if($Skip and $Skip->{$Pos})
   1123         { # skip removed/added fields
   1124             if($Pos > $FieldPos)
   1125             { # after the target
   1126                 $NextField += 1;
   1127                 next;
   1128             }
   1129         }
   1130         ($Alignment{$Pos}, $MSize{$Pos}) = getAlignment($Pos, $TypePtr, $TInfo, $Arch, $Word);
   1131         
   1132         if(not $Alignment{$Pos})
   1133         { # emergency exit
   1134             return 0;
   1135         }
   1136         
   1137         if($Alignment{$Pos}>$MaxAlgn) {
   1138             $MaxAlgn = $Alignment{$Pos};
   1139         }
   1140         if($Pos==$FieldPos)
   1141         {
   1142             if($Size==-1)
   1143             { # added/removed fields
   1144                 if($Pos!=$End)
   1145                 { # skip target field and see
   1146                   # if enough padding will be
   1147                   # created on the next step
   1148                   # to include this field
   1149                     next;
   1150                 }
   1151             }
   1152         }
   1153         # padding
   1154         my $Padding = 0;
   1155         if($Offset % $Alignment{$Pos}!=0)
   1156         { # not aligned, add padding
   1157             $Padding = $Alignment{$Pos} - $Offset % $Alignment{$Pos};
   1158         }
   1159         if($Pos==$NextField)
   1160         { # try to place target field in the padding
   1161             if($Size==-1)
   1162             { # added/removed fields
   1163                 my $TPadding = 0;
   1164                 if($Offset % $Alignment{$FieldPos}!=0)
   1165                 {# padding of the target field
   1166                     $TPadding = $Alignment{$FieldPos} - $Offset % $Alignment{$FieldPos};
   1167                 }
   1168                 if($TPadding+$MSize{$FieldPos}<=$Padding)
   1169                 { # enough padding to place target field
   1170                     return 1;
   1171                 }
   1172                 else {
   1173                     return 0;
   1174                 }
   1175             }
   1176             else
   1177             { # changed fields
   1178                 my $Delta = $Size-$MSize{$FieldPos};
   1179                 if($Delta>=0)
   1180                 { # increased
   1181                     if($Size-$MSize{$FieldPos}<=$Padding)
   1182                     { # enough padding to change target field
   1183                         return 1;
   1184                     }
   1185                     else {
   1186                         return 0;
   1187                     }
   1188                 }
   1189                 else
   1190                 { # decreased
   1191                     $Delta = abs($Delta);
   1192                     if($Delta+$Padding>=$MSize{$Pos})
   1193                     { # try to place the next field
   1194                         if(($Offset-$Delta) % $Alignment{$Pos} != 0)
   1195                         { # padding of the next field in new place
   1196                             my $NPadding = $Alignment{$Pos} - ($Offset-$Delta) % $Alignment{$Pos};
   1197                             if($NPadding+$MSize{$Pos}<=$Delta+$Padding)
   1198                             { # enough delta+padding to store next field
   1199                                 return 0;
   1200                             }
   1201                         }
   1202                         else
   1203                         {
   1204                             return 0;
   1205                         }
   1206                     }
   1207                     return 1;
   1208                 }
   1209             }
   1210         }
   1211         elsif($Pos==$End)
   1212         { # target field is the last field
   1213             if($Size==-1)
   1214             { # added/removed fields
   1215                 if($Offset % $MaxAlgn!=0)
   1216                 { # tail padding
   1217                     my $TailPadding = $MaxAlgn - $Offset % $MaxAlgn;
   1218                     if($Padding+$MSize{$Pos}<=$TailPadding)
   1219                     { # enough tail padding to place the last field
   1220                         return 1;
   1221                     }
   1222                 }
   1223                 return 0;
   1224             }
   1225             else
   1226             { # changed fields
   1227                 # scenario #1
   1228                 my $Offset1 = $Offset+$Padding+$MSize{$Pos};
   1229                 if($Offset1 % $MaxAlgn != 0)
   1230                 { # tail padding
   1231                     $Offset1 += $MaxAlgn - $Offset1 % $MaxAlgn;
   1232                 }
   1233                 # scenario #2
   1234                 my $Offset2 = $Offset+$Padding+$Size;
   1235                 if($Offset2 % $MaxAlgn != 0)
   1236                 { # tail padding
   1237                     $Offset2 += $MaxAlgn - $Offset2 % $MaxAlgn;
   1238                 }
   1239                 if($Offset1!=$Offset2)
   1240                 { # different sizes of structure
   1241                     return 0;
   1242                 }
   1243                 return 1;
   1244             }
   1245         }
   1246         $Offset += $Padding+$MSize{$Pos};
   1247     }
   1248     return 0;
   1249 }
   1250 
   1251 sub isScalar($) {
   1252     return ($_[0]=~/\A(unsigned |)(char|short|int|long|long long)\Z/);
   1253 }
   1254 
   1255 sub isFloat($) {
   1256     return ($_[0]=~/\A(float|double|long double)\Z/);
   1257 }
   1258 
   1259 sub callingConvention_R_Real($)
   1260 {
   1261     my $SInfo = $_[0];
   1262     my %Conv = ();
   1263     my %Regs = ();
   1264     my $Hidden = 0;
   1265     foreach my $Elem (keys(%{$SInfo->{"Reg"}}))
   1266     {
   1267         my $Reg = $SInfo->{"Reg"}{$Elem};
   1268         if($Elem eq ".result_ptr")
   1269         {
   1270             $Hidden = 1;
   1271             $Regs{$Reg} = 1;
   1272         }
   1273         elsif(index($Elem, ".result")==0) {
   1274             $Regs{$Reg} = 1;
   1275         }
   1276     }
   1277     if(my @R = sort keys(%Regs))
   1278     {
   1279         $Conv{"Method"} = "reg";
   1280         $Conv{"Registers"} = join(", ", @R);
   1281         if($Hidden) {
   1282             $Conv{"Hidden"} = 1;
   1283         }
   1284     }
   1285     else
   1286     {
   1287         $Conv{"Method"} = "stack";
   1288         $Conv{"Hidden"} = 1;
   1289     }
   1290     return %Conv;
   1291 }
   1292 
   1293 sub callingConvention_P_Real($$)
   1294 {
   1295     my ($SInfo, $Pos) = @_;
   1296     my %Conv = ();
   1297     my %Regs = ();
   1298     foreach my $Elem (keys(%{$SInfo->{"Reg"}}))
   1299     {
   1300         my $Reg = $SInfo->{"Reg"}{$Elem};
   1301         if($Elem=~/\A$Pos([\.\+]|\Z)/) {
   1302             $Regs{$Reg} = 1;
   1303         }
   1304     }
   1305     if(my @R = sort keys(%Regs))
   1306     {
   1307         $Conv{"Method"} = "reg";
   1308         $Conv{"Registers"} = join(", ", @R);
   1309     }
   1310     else
   1311     {
   1312         $Conv{"Method"} = "stack";
   1313         
   1314         if(defined $SInfo->{"Param"}
   1315         and defined $SInfo->{"Param"}{0})
   1316         {
   1317             if(not defined $SInfo->{"Param"}{0}{"offset"})
   1318             {
   1319                 $Conv{"Method"} = "unknown";
   1320             }
   1321         }
   1322     }
   1323     
   1324     return %Conv;
   1325 }
   1326 
   1327 return 1;