git.oblomov.eu Git - wine/blob - tools/winapi_check/winapi_local.pm

   1 package winapi_local;
   2
   3 use strict;
   4
   5 sub check_function {
   6     my $options = shift;
   7     my $output = shift;
   8     my $return_type = shift;
   9     my $calling_convention = shift;
  10     my $name = shift;
  11     my $refargument_types = shift;
  12     my @argument_types = @$refargument_types;
  13     my $winapi = shift;
  14
  15     my $module = $winapi->function_module($name);
  16
  17     if($winapi->name eq "win16") {
  18         my $name16 = $name;
  19         $name16 =~ s/16$//;
  20         if($name16 ne $name && $winapi->function_stub($name16)) {
  21             if($options->implemented) {
  22                 &$output("function implemented but declared as stub in .spec file");
  23             }
  24             return;
  25         } elsif($winapi->function_stub($name)) {
  26             if($options->implemented_win32) {
  27                 &$output("32-bit variant of function implemented but declared as stub in .spec file");
  28             }
  29             return;
  30         }
  31     } elsif($winapi->function_stub($name)) {
  32         if($options->implemented) {
  33             &$output("function implemented but declared as stub in .spec file");
  34         }
  35         return;
  36     }
  37
  38     my $forbidden_return_type = 0;
  39     my $implemented_return_kind;
  40     $winapi->type_used_in_module($return_type,$module);
  41     if(!defined($implemented_return_kind = $winapi->translate_argument($return_type))) {
  42         if($return_type ne "") {
  43             &$output("no translation defined: " . $return_type);
  44         }
  45     } elsif(!$winapi->is_allowed_kind($implemented_return_kind) || !$winapi->allowed_type_in_module($return_type,$module)) {
  46         $forbidden_return_type = 1;
  47         if($options->report_argument_forbidden($return_type)) {
  48             &$output("forbidden return type: $return_type ($implemented_return_kind)");
  49         }
  50     }
  51
  52     my $segmented = 0;
  53     if($implemented_return_kind =~ /^segptr|segstr$/) {
  54         $segmented = 1;
  55     }
  56
  57     my $implemented_calling_convention;
  58     if($winapi->name eq "win16") {
  59         if($calling_convention =~ /^__cdecl$/) {
  60             $implemented_calling_convention = "cdecl";
  61         } elsif($calling_convention = ~ /^__stdcall|VFWAPI|WINAPI$/) {
  62             if($implemented_return_kind =~ /^s_word|word|void$/) {
  63                 $implemented_calling_convention = "pascal16";
  64             } else {
  65                 $implemented_calling_convention = "pascal";
  66             }
  67         }
  68     } elsif($winapi->name eq "win32") {
  69         if($calling_convention =~ /^__cdecl$/) {
  70             $implemented_calling_convention = "cdecl";
  71         } elsif($calling_convention =~ /^VFWAPIV|WINAPIV$/) {
  72             $implemented_calling_convention = "varargs";
  73         } elsif($calling_convention =~ /^__stdcall|VFWAPI|WINAPI$/) {
  74             $implemented_calling_convention = "stdcall";
  75         } else {
  76             $implemented_calling_convention = "<default>";
  77         }
  78     }
  79
  80     my $declared_calling_convention = $winapi->function_calling_convention($name);
  81     my @declared_argument_kinds = split(/\s+/, $winapi->function_arguments($name));
  82
  83     if($declared_calling_convention =~ /^register|interrupt$/) {
  84         push @declared_argument_kinds, "ptr";
  85     }
  86
  87     if($declared_calling_convention =~ /^register|interupt$/ &&
  88          (($winapi->name eq "win32" && $implemented_calling_convention eq "stdcall") ||
  89          (($winapi->name eq "win16" && $implemented_calling_convention =~ /^pascal/))))
  90     {
  91         # correct
  92     } elsif($implemented_calling_convention ne $declared_calling_convention &&
  93        !($declared_calling_convention =~ /^pascal/ && $forbidden_return_type))
  94     {
  95         if($options->calling_convention) {
  96             &$output("calling convention mismatch: $implemented_calling_convention != $declared_calling_convention");
  97         }
  98     }
  99
 100     if($declared_calling_convention eq "varargs") {
 101         if($#argument_types != -1 && $argument_types[$#argument_types] eq "...") {
 102             pop @argument_types;
 103         } else {
 104             &$output("function not implemented as vararg");
 105         }
 106     } elsif($#argument_types != -1 && $argument_types[$#argument_types] eq "...") {
 107         &$output("function not declared as vararg");
 108     }
 109
 110     if($name =~ /^CRTDLL__ftol|CRTDLL__CIpow$/) {
 111         # ignore
 112     } else {
 113         my $n = 0;
 114         my @argument_kinds = map {
 115             my $type = $_;
 116             my $kind = "unknown";
 117             $winapi->type_used_in_module($type,$module);
 118             if(!defined($kind = $winapi->translate_argument($type))) {
 119                 &$output("no translation defined: " . $type);
 120             } elsif(!$winapi->is_allowed_kind($kind) ||
 121                     !$winapi->allowed_type_in_module($type, $module)) {
 122                 if($options->report_argument_forbidden($type)) {
 123                     &$output("forbidden argument " . ($n + 1) . " type (" . $type . ")");
 124                 }
 125             }
 126             if(defined($kind) && $kind eq "longlong") {
 127                 $n+=2;
 128                 ("long", "long");
 129             } else {
 130                 $n++;
 131                 $kind;
 132             }
 133         } @argument_types;
 134
 135         for my $n (0..$#argument_kinds) {
 136             if(!defined($argument_kinds[$n]) || !defined($declared_argument_kinds[$n])) { next; }
 137
 138             if($argument_kinds[$n] =~ /^segptr|segstr$/ ||
 139                $declared_argument_kinds[$n] =~ /^segptr|segstr$/)
 140             {
 141                 $segmented = 1;
 142             }
 143
 144             if($argument_kinds[$n] ne $declared_argument_kinds[$n]) {
 145                 if($options->report_argument_kind($argument_kinds[$n]) ||
 146                    $options->report_argument_kind($declared_argument_kinds[$n]))
 147                 {
 148                     &$output("argument " . ($n + 1) . " type mismatch: " .
 149                              $argument_types[$n] . " ($argument_kinds[$n]) != " . $declared_argument_kinds[$n]);
 150                 }
 151             }
 152         }
 153         if($#argument_kinds != $#declared_argument_kinds) {
 154             if($options->argument_count) {
 155                 &$output("argument count differs: " . ($#argument_types + 1) . " != " . ($#declared_argument_kinds + 1));
 156             }
 157         }
 158
 159     }
 160
 161     if($segmented && $options->shared_segmented && $winapi->is_shared_function($name)) {
 162         &$output("function using segmented pointers shared between Win16 och Win32");
 163     }
 164 }
 165
 166 sub check_file {
 167     my $options = shift;
 168     my $output = shift;
 169     my $file = shift;
 170     my $functions = shift;
 171
 172     if($options->cross_call) {
 173         my @names = sort(keys(%$functions));
 174         for my $name (@names) {
 175             my @called_names = $$functions{$name}->called_function_names;
 176             my @called_by_names = $$functions{$name}->called_by_function_names;
 177             my $module = $$functions{$name}->module;
 178             my $module16 = $$functions{$name}->module16;
 179             my $module32 = $$functions{$name}->module32;
 180
 181             if($#called_names >= 0 && (defined($module16) || defined($module32)) ) {
 182                 for my $called_name (@called_names) {
 183                     my $called_module16 = $$functions{$called_name}->module16;
 184                     my $called_module32 = $$functions{$called_name}->module32;
 185                     if(defined($module32) &&
 186                        defined($called_module16) && !defined($called_module32) &&
 187                        $name ne $called_name)
 188                     {
 189                         $output->write("$file: $module: $name: illegal call to $called_name (Win16)\n");
 190                     }
 191                 }
 192             }
 193         }
 194     }
 195 }
 196
 197 1;
 198