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

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