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