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 $external_name = shift;
  11     my $internal_name = shift;
  12     my $refargument_types = shift;
  13     my @argument_types = @$refargument_types;
  14     my $nativeapi = shift;
  15     my $winapi = shift;
  16
  17     my $module = $winapi->function_module($internal_name);
  18
  19     if($winapi->name eq "win16") {
  20         my $name16 = $internal_name;
  21         $name16 =~ s/16$//;
  22         if($name16 ne $internal_name && $winapi->function_stub($name16)) {
  23             if($options->implemented) {
  24                 $output->write("function implemented but declared as stub in .spec file\n");
  25             }
  26             return;
  27         } elsif($winapi->function_stub($internal_name)) {
  28             if($options->implemented_win32) {
  29                 $output->write("32-bit variant of function implemented but declared as stub in .spec file\n");
  30             }
  31             return;
  32         }
  33     } elsif($winapi->function_stub($internal_name)) {
  34         if($options->implemented) {
  35             $output->write("function implemented but declared as stub in .spec file\n");
  36         }
  37         return;
  38     }
  39
  40     my $forbidden_return_type = 0;
  41     my $implemented_return_kind;
  42     $winapi->type_used_in_module($return_type,$module);
  43     if(!defined($implemented_return_kind = $winapi->translate_argument($return_type))) {
  44         if($return_type ne "") {
  45             $output->write("no translation defined: " . $return_type . "\n");
  46         }
  47     } elsif(!$winapi->is_allowed_kind($implemented_return_kind) || !$winapi->allowed_type_in_module($return_type,$module)) {
  48         $forbidden_return_type = 1;
  49         if($options->report_argument_forbidden($return_type)) {
  50             $output->write("return type is forbidden: $return_type ($implemented_return_kind)\n");
  51         }
  52     }
  53
  54     my $segmented = 0;
  55     if($implemented_return_kind =~ /^segptr|segstr$/) {
  56         $segmented = 1;
  57     }
  58
  59     my $implemented_calling_convention;
  60     if($winapi->name eq "win16") {
  61         if($calling_convention =~ /^__cdecl$/) {
  62             $implemented_calling_convention = "cdecl";
  63         } elsif($calling_convention =~ /^VFWAPIV|WINAPIV$/) {
  64             $implemented_calling_convention = "varargs";
  65         } elsif($calling_convention = ~ /^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
  66             if($implemented_return_kind =~ /^s_word|word|void$/) {
  67                 $implemented_calling_convention = "pascal16";
  68             } else {
  69                 $implemented_calling_convention = "pascal";
  70             }
  71         }
  72     } elsif($winapi->name eq "win32") {
  73         if($calling_convention =~ /^__cdecl$/) {
  74             $implemented_calling_convention = "cdecl";
  75         } elsif($calling_convention =~ /^VFWAPIV|WINAPIV$/) {
  76             $implemented_calling_convention = "varargs";
  77         } elsif($calling_convention =~ /^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
  78             if($implemented_return_kind =~ /^longlong$/) {
  79                 $implemented_calling_convention = "stdcall64";
  80             } else {
  81                 $implemented_calling_convention = "stdcall";
  82             }
  83         } else {
  84             $implemented_calling_convention = "cdecl";
  85         }
  86     }
  87
  88     my $declared_calling_convention = $winapi->function_calling_convention($internal_name);
  89     my @declared_argument_kinds = split(/\s+/, $winapi->function_arguments($internal_name));
  90
  91     if($declared_calling_convention =~ /^register|interrupt$/) {
  92         push @declared_argument_kinds, "ptr";
  93     }
  94
  95     if($declared_calling_convention =~ /^register|interupt$/ &&
  96          (($winapi->name eq "win32" && $implemented_calling_convention eq "stdcall") ||
  97          (($winapi->name eq "win16" && $implemented_calling_convention =~ /^pascal/))))
  98     {
  99         # correct
 100     } elsif($implemented_calling_convention ne $declared_calling_convention &&
 101        !($declared_calling_convention =~ /^pascal/ && $forbidden_return_type) &&
 102        !($implemented_calling_convention =~ /^cdecl|varargs$/ && $declared_calling_convention =~ /^cdecl|varargs$/))
 103     {
 104         if($options->calling_convention && (
 105             ($options->calling_convention_win16 && $winapi->name eq "win16") ||
 106             ($options->calling_convention_win32 && $winapi->name eq "win32")) &&
 107             !$nativeapi->is_function($internal_name))
 108         {
 109             $output->write("calling convention mismatch: $implemented_calling_convention != $declared_calling_convention\n");
 110         }
 111     }
 112
 113     if($declared_calling_convention eq "varargs") {
 114         if($#argument_types != -1 && $argument_types[$#argument_types] eq "...") {
 115             pop @argument_types;
 116         } else {
 117             $output->write("function not implemented as vararg\n");
 118         }
 119     } elsif($#argument_types != -1 && $argument_types[$#argument_types] eq "...") {
 120         $output->write("function not declared as vararg\n");
 121     }
 122
 123     if($#argument_types != -1 && $argument_types[$#argument_types] eq "CONTEXT *" &&
 124        $internal_name !~ /^(Get|Set)ThreadContext$/) # FIXME: Kludge
 125     {
 126         $#argument_types--;
 127     }
 128
 129     if($internal_name =~ /^NTDLL__ftol|NTDLL__CIpow$/) { # FIXME: Kludge
 130         # ignore
 131     } else {
 132         my $n = 0;
 133         my @argument_kinds = map {
 134             my $type = $_;
 135             my $kind = "unknown";
 136             $winapi->type_used_in_module($type,$module);
 137             if(!defined($kind = $winapi->translate_argument($type))) {
 138                 $output->write("no translation defined: " . $type . "\n");
 139             } elsif(!$winapi->is_allowed_kind($kind) ||
 140                     !$winapi->allowed_type_in_module($type, $module)) {
 141                 if($options->report_argument_forbidden($type)) {
 142                     $output->write("forbidden argument " . ($n + 1) . " type " . $type . " (" . $kind . ")\n");
 143                 }
 144             }
 145
 146             # FIXME: Kludge
 147             if(defined($kind) && $kind eq "longlong") {
 148                 $n+=2;
 149                 ("long", "long");
 150             } else {
 151                 $n++;
 152                 $kind;
 153             }
 154         } @argument_types;
 155
 156         for my $n (0..$#argument_kinds) {
 157             if(!defined($argument_kinds[$n]) || !defined($declared_argument_kinds[$n])) { next; }
 158
 159             if($argument_kinds[$n] =~ /^segptr|segstr$/ ||
 160                $declared_argument_kinds[$n] =~ /^segptr|segstr$/)
 161             {
 162                 $segmented = 1;
 163             }
 164
 165             # FIXME: Kludge
 166             if(!defined($argument_types[$n])) {
 167                 $argument_types[$n] = "";
 168             }
 169
 170             if(!$winapi->is_allowed_kind($argument_kinds[$n]) ||
 171                !$winapi->allowed_type_in_module($argument_types[$n], $module))
 172             {
 173                 if($options->report_argument_forbidden($argument_types[$n])) {
 174                     $output->write("argument " . ($n + 1) . " type is forbidden: " .
 175                                    "$argument_types[$n] ($argument_kinds[$n])\n");
 176                 }
 177             } elsif($argument_kinds[$n] ne $declared_argument_kinds[$n]) {
 178                 if($options->report_argument_kind($argument_kinds[$n]) ||
 179                    $options->report_argument_kind($declared_argument_kinds[$n]))
 180                 {
 181                     $output->write("argument " . ($n + 1) . " type mismatch: " .
 182                              $argument_types[$n] . " ($argument_kinds[$n]) != " .
 183                              $declared_argument_kinds[$n] . "\n");
 184                 }
 185             }
 186         }
 187         if($#argument_kinds != $#declared_argument_kinds) {
 188             if($options->argument_count) {
 189                 $output->write("argument count differs: " .
 190                     ($#argument_types + 1) . " != " .
 191                     ($#declared_argument_kinds + 1) . "\n");
 192             }
 193         }
 194
 195     }
 196
 197     if($segmented && $options->shared_segmented && $winapi->is_shared_function($internal_name)) {
 198         $output->write("function using segmented pointers shared between Win16 och Win32\n");
 199     }
 200 }
 201
 202 sub check_statements {
 203     my $options = shift;
 204     my $output = shift;
 205     my $winapi = shift;
 206     my $functions = shift;
 207     my $function = shift;
 208
 209     my $module = $function->module;
 210     my $internal_name = $function->internal_name;
 211
 212     my $first_debug_message = 1;
 213     local $_ = $function->statements;
 214     while(defined($_)) {
 215         if(s/(\w+)\s*(?:\(\s*(\w+)\s*\))?\s*\(\s*((?:\"[^\"]*\"|\([^\)]*\)|[^\)])*?)\s*\)//) {
 216             my $called_name = $1;
 217             my $channel = $2;
 218             my $called_arguments = $3;
 219             if($called_name =~ /^if|for|while|switch|sizeof$/) {
 220                 # Nothing
 221             } elsif($called_name =~ /^ERR|FIXME|MSG|TRACE|WARN$/) {
 222                 if($first_debug_message && $called_name =~ /^FIXME|TRACE$/) {
 223                     $first_debug_message = 0;
 224                     if($called_arguments =~ /^\"\((.*?)\)(.*?)\"\s*,\s*(.*?)$/) {
 225                         my $formating = $1;
 226                         my $extra = $2;
 227                         my $arguments = $3;
 228
 229                         my $format;
 230                         my $argument;
 231                         my $n = 0;
 232                         while($formating && ($formating =~ s/^([^,]*),?//, $format = $1, $format =~ s/^\s*(.*?)\s*$/$1/) &&
 233                               $arguments && ($arguments =~ s/^([^,]*),?//, $argument = $1, $argument =~ s/^\s*(.*?)\s*$/$1/))
 234                         {
 235                             my $type = @{$function->argument_types}[$n];
 236                             my $name = @{$function->argument_names}[$n];
 237
 238                             $n++;
 239
 240                             if(!defined($type)) { last; }
 241
 242                             $format =~ s/^\w+\s*[:=]?\s*//;
 243                             $format =~ s/\s*\{[^\{\}]*\}$//;
 244                             $format =~ s/\s*\[[^\[\]]*\]$//;
 245                             $format =~ s/^\'(.*?)\'$/$1/;
 246                             $format =~ s/^\\\"(.*?)\\\"$/$1/;
 247
 248                             if($argument !~ /$name/) {
 249                                 $output->write("$called_name: argument $n is wrong ($name != '$argument')\n");
 250                             } elsif(!$winapi->is_allowed_type_format($module, $type, $format)) {
 251                                 $output->write("$called_name: argument $n ($type $name) has illegal format ($format)\n");
 252                             }
 253                         }
 254
 255                         my $count = $#{$function->argument_types} + 1;
 256                         if($n != $count) {
 257                             $output->write("$called_name: argument count mismatch ($n != $count)\n");
 258                         }
 259                     }
 260                 }
 261             } else {
 262                 $$functions{$internal_name}->function_called($called_name);
 263                 if(!defined($$functions{$called_name})) {
 264                     $$functions{$called_name} = 'winapi_function'->new;
 265                 }
 266                 $$functions{$called_name}->function_called_by($internal_name);
 267             }
 268         } else {
 269             undef $_;
 270         }
 271     }
 272 }
 273
 274 sub check_file {
 275     my $options = shift;
 276     my $output = shift;
 277     my $file = shift;
 278     my $functions = shift;
 279
 280     if($options->cross_call) {
 281         my @names = sort(keys(%$functions));
 282         for my $name (@names) {
 283             my @called_names = $$functions{$name}->called_function_names;
 284             my @called_by_names = $$functions{$name}->called_by_function_names;
 285             my $module = $$functions{$name}->module;
 286
 287             if($options->cross_call_win32_win16) {
 288                 my $module16 = $$functions{$name}->module16;
 289                 my $module32 = $$functions{$name}->module32;
 290
 291                 if($#called_names >= 0 && (defined($module16) || defined($module32)) ) {
 292                     for my $called_name (@called_names) {
 293                         my $called_module16 = $$functions{$called_name}->module16;
 294                         my $called_module32 = $$functions{$called_name}->module32;
 295                         if(defined($module32) &&
 296                            defined($called_module16) && !defined($called_module32) &&
 297                            $name ne $called_name)
 298                         {
 299                             $output->write("$file: $module: $name: illegal call to $called_name (Win32 -> Win16)\n");
 300                         }
 301                     }
 302                 }
 303             }
 304
 305             if($options->cross_call_unicode_ascii) {
 306                 if($name =~ /W$/) {
 307                     for my $called_name (@called_names) {
 308                         if($called_name =~ /A$/) {
 309                             $output->write("$file: $module: $name: illegal call to $called_name (Unicode -> ASCII)\n");
 310                         }
 311                     }
 312                 }
 313             }
 314         }
 315     }
 316 }
 317
 318 1;
 319