• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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###########################################################################
34use strict;
35
36my $BYTE = 8;
37
38my %UsedReg = ();
39my %UsedStack = ();
40
41my %IntAlgn = (
42    "x86"=>{
43        "double"=>4,
44        "long double"=>4
45    }
46);
47
48sub 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
166sub 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
278sub 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
344sub callingConvention_R_Model($$$$$$) {
345    return callingConvention_R_I_Model(@_, 1);
346}
347
348sub 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
360sub 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
548sub 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
567sub 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
594sub 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
614sub pushStack_R($$)
615{
616    my ($SInfo, $Word) = @_;
617    return pushStack($SInfo, $Word, $Word, { 0 => ".result_ptr" });
618}
619
620sub pushStack_C($$$)
621{
622    my ($SInfo, $Class, $TInfo) = @_;
623    return pushStack($SInfo, $Class->{"Algn"}, $Class->{"Size"}, $Class->{"Elems"});
624}
625
626sub 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
639sub 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
650sub 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
664sub 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
681sub 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
701sub callingConvention_P_Model($$$$$$) {
702    return callingConvention_P_I_Model(@_, 1);
703}
704
705sub 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
908sub 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
970sub 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
1004sub 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
1044sub 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
1098sub 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
1109sub 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
1251sub isScalar($) {
1252    return ($_[0]=~/\A(unsigned |)(char|short|int|long|long long)\Z/);
1253}
1254
1255sub isFloat($) {
1256    return ($_[0]=~/\A(float|double|long double)\Z/);
1257}
1258
1259sub 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
1293sub 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
1327return 1;