tools/winapi_check/winapi_local.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 #
  18
  19 package winapi_local;
  20
  21 use strict;
  22
  23 use nativeapi qw($nativeapi);
  24 use options qw($options);
  25 use output qw($output);
  26 use winapi qw($win16api $win32api @winapis);
  27
  28 sub check_function {
  29     my $function = shift;
  30
  31     my $return_type = $function->return_type;
  32     my $calling_convention = $function->calling_convention;
  33     my $calling_convention16 = $function->calling_convention16;
  34     my $calling_convention32 = $function->calling_convention32;
  35     my $internal_name = $function->internal_name;
  36     my $external_name16 = $function->external_name16;
  37     my $external_name32 = $function->external_name32;
  38     my $module16 = $function->module16;
  39     my $module32 = $function->module32;
  40     my $refargument_types = $function->argument_types;
  41
  42     if(!defined($refargument_types)) {
  43         return;
  44     }
  45
  46     if($options->win16 && $options->report_module($module16)) {
  47         _check_function($return_type,
  48                         $calling_convention, $external_name16,
  49                         $internal_name, $refargument_types,
  50                         $win16api);
  51     }
  52
  53     if($options->win32 && $options->report_module($module32)) {
  54         _check_function($return_type,
  55                         $calling_convention, $external_name32,
  56                         $internal_name, $refargument_types,
  57                         $win32api);
  58     }
  59 }
  60
  61 sub _check_function {
  62     my $return_type = shift;
  63     my $calling_convention = shift;
  64     my $external_name = shift;
  65     my $internal_name = shift;
  66     my $refargument_types = shift;
  67     my @argument_types = @$refargument_types;
  68     my $winapi = shift;
  69
  70     my $module = $winapi->function_internal_module($internal_name);
  71
  72     if($winapi->name eq "win16") {
  73         if($winapi->is_function_stub_in_module($module, $internal_name)) {
  74             if($options->implemented) {
  75                 $output->write("function implemented but declared as stub in .spec file\n");
  76             }
  77             return;
  78         } elsif($winapi->is_function_stub_in_module($module, $internal_name)) {
  79             if($options->implemented_win32) {
  80                 $output->write("32-bit variant of function implemented but declared as stub in .spec file\n");
  81             }
  82             return;
  83         }
  84     } elsif($winapi->is_function_stub_in_module($module, $internal_name)) {
  85         if($options->implemented) {
  86             $output->write("function implemented but declared as stub in .spec file\n");
  87         }
  88         return;
  89     }
  90
  91     my $forbidden_return_type = 0;
  92     my $implemented_return_kind;
  93     $winapi->type_used_in_module($return_type,$module);
  94     if(!defined($implemented_return_kind = $winapi->translate_argument($return_type))) {
  95         $winapi->declare_argument($return_type, "unknown");
  96         if($return_type ne "") {
  97             $output->write("no translation defined: " . $return_type . "\n");
  98         }
  99     } elsif(!$winapi->is_allowed_kind($implemented_return_kind) ||
 100             !$winapi->is_allowed_type_in_module($return_type, $module))
 101     {
 102         $forbidden_return_type = 1;
 103         $winapi->allow_kind($implemented_return_kind);
 104         $winapi->allow_type_in_module($return_type, $module);
 105         if($options->report_argument_forbidden($return_type)) {
 106             $output->write("return type is forbidden: $return_type ($implemented_return_kind)\n");
 107         }
 108     }
 109
 110     my $segmented = 0;
 111     if(defined($implemented_return_kind) && $implemented_return_kind =~ /^segptr|segstr$/) {
 112         $segmented = 1;
 113     }
 114
 115     my $implemented_calling_convention;
 116     if($winapi->name eq "win16") {
 117         if($calling_convention =~ /^__cdecl$/) {
 118             $implemented_calling_convention = "cdecl";
 119         } elsif($calling_convention =~ /^VFWAPIV|WINAPIV$/) {
 120             $implemented_calling_convention = "varargs";
 121         } elsif($calling_convention =~ /^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
 122             if($implemented_return_kind =~ /^s_word|word|void$/) {
 123                 $implemented_calling_convention = "pascal16";
 124             } else {
 125                 $implemented_calling_convention = "pascal";
 126             }
 127         } elsif($calling_convention =~ /^__asm$/) {
 128             $implemented_calling_convention = "asm";
 129         } else {
 130             $implemented_calling_convention = "cdecl";
 131         }
 132     } elsif($winapi->name eq "win32") {
 133         if($calling_convention =~ /^__cdecl$/) {
 134             $implemented_calling_convention = "cdecl";
 135         } elsif($calling_convention =~ /^VFWAPIV|WINAPIV$/) {
 136             $implemented_calling_convention = "varargs";
 137         } elsif($calling_convention =~ /^__stdcall|VFWAPI|WINAPI|CALLBACK$/) {
 138             if(defined($implemented_return_kind) && $implemented_return_kind =~ /^longlong$/) {
 139                 $implemented_calling_convention = "stdcall"; # FIXME: Check entry flags
 140             } else {
 141                 $implemented_calling_convention = "stdcall";
 142             }
 143         } elsif($calling_convention =~ /^__asm$/) {
 144             $implemented_calling_convention = "asm";
 145         } else {
 146             $implemented_calling_convention = "cdecl";
 147         }
 148     }
 149
 150     my $declared_calling_convention = $winapi->function_internal_calling_convention($internal_name) || "";
 151     my @declared_argument_kinds = split(/\s+/, $winapi->function_internal_arguments($internal_name));
 152
 153     my $declared_register = 0;
 154     if ($declared_calling_convention =~ /^(\w+) -register$/) {
 155         $declared_register = 1;
 156         $declared_calling_convention = $1;
 157     }
 158
 159     if($implemented_calling_convention ne $declared_calling_convention &&
 160        $implemented_calling_convention ne "asm" &&
 161        !($declared_calling_convention =~ /^pascal/ && $forbidden_return_type) &&
 162        !($implemented_calling_convention =~ /^cdecl|varargs$/ && $declared_calling_convention =~ /^cdecl|varargs$/))
 163     {
 164         if($options->calling_convention && (
 165             ($options->calling_convention_win16 && $winapi->name eq "win16") ||
 166             ($options->calling_convention_win32 && $winapi->name eq "win32")) &&
 167             !$nativeapi->is_function($internal_name))
 168         {
 169             $output->write("calling convention mismatch: $implemented_calling_convention != $declared_calling_convention\n");
 170         }
 171     }
 172
 173     if($declared_calling_convention eq "varargs") {
 174         if ($#argument_types != -1 &&
 175             (($winapi->name eq "win32" && $argument_types[$#argument_types] eq "...") ||
 176             ($winapi->name eq "win16" && $argument_types[$#argument_types] eq "VA_LIST16")))
 177         {
 178             pop @argument_types;
 179         } else {
 180             $output->write("function not implemented as varargs\n");
 181         }
 182     } elsif ($#argument_types != -1 &&
 183         (($winapi->name eq "win32" && $argument_types[$#argument_types] eq "...") ||
 184         ($winapi->name eq "win16" && $argument_types[$#argument_types] eq "VA_LIST16")))
 185     {
 186         if($#argument_types == 0) {
 187             pop @argument_types;
 188         } else {
 189             $output->write("function not declared as varargs\n");
 190         }
 191     }
 192
 193     if($#argument_types != -1 && $argument_types[$#argument_types] eq "CONTEXT *" &&
 194        $internal_name =~ /^(?:RtlRaiseException|RtlUnwind|NtRaiseException)$/) # FIXME: Kludge
 195     {
 196         $#argument_types--;
 197     }
 198
 199     if($internal_name =~ /^NTDLL__ftol|NTDLL__CIpow$/) { # FIXME: Kludge
 200         # ignore
 201     } else {
 202         my $n = 0;
 203         my @argument_kinds = map {
 204             my $type = $_;
 205             my $kind = "unknown";
 206             $winapi->type_used_in_module($type,$module);
 207             if($type eq "CONTEXT86 *") {
 208                 $kind = "context86";
 209             } elsif(!defined($kind = $winapi->translate_argument($type))) {
 210                 $winapi->declare_argument($type, "unknown");
 211                 $output->write("no translation defined: " . $type . "\n");
 212             } elsif(!$winapi->is_allowed_kind($kind) ||
 213                     !$winapi->is_allowed_type_in_module($type, $module))
 214             {
 215                 $winapi->allow_kind($kind);
 216                 $winapi->allow_type_in_module($type, $module);
 217                 if($options->report_argument_forbidden($type)) {
 218                     $output->write("argument " . ($n + 1) . " type is forbidden: " . $type . " (" . $kind . ")\n");
 219                 }
 220             }
 221
 222             # FIXME: Kludge
 223             if(defined($kind) && $kind eq "struct16") {
 224                 $n+=4;
 225                 ("long", "long", "long", "long");
 226             } elsif(defined($kind) && $kind =~ /^(?:longlong)$/) {
 227                 $n+=2;
 228                 ("long", "long");
 229             } else {
 230                 $n++;
 231                 $kind;
 232             }
 233         } @argument_types;
 234
 235         if ($declared_register && $argument_kinds[$#argument_kinds] ne "context86") {
 236             $output->write("function declared as register, but CONTEXT86 * is not last argument\n");
 237         }
 238
 239         for my $n (0..$#argument_kinds) {
 240             if(!defined($argument_kinds[$n]) || !defined($declared_argument_kinds[$n])) { next; }
 241
 242             if($argument_kinds[$n] =~ /^segptr|segstr$/ ||
 243                $declared_argument_kinds[$n] =~ /^segptr|segstr$/)
 244             {
 245                 $segmented = 1;
 246             }
 247
 248             # FIXME: Kludge
 249             if(!defined($argument_types[$n])) {
 250                 $argument_types[$n] = "";
 251             }
 252
 253             if($argument_kinds[$n] eq "context86") {
 254                 # Nothing
 255             } elsif(!$winapi->is_allowed_kind($argument_kinds[$n]) ||
 256                !$winapi->is_allowed_type_in_module($argument_types[$n], $module))
 257             {
 258                 $winapi->allow_kind($argument_kinds[$n]);
 259                 $winapi->allow_type_in_module($argument_types[$n],, $module);
 260                 if($options->report_argument_forbidden($argument_types[$n])) {
 261                     $output->write("argument " . ($n + 1) . " type is forbidden: " .
 262                                    "$argument_types[$n] ($argument_kinds[$n])\n");
 263                 }
 264             } elsif($argument_kinds[$n] ne $declared_argument_kinds[$n]) {
 265                 if($options->report_argument_kind($argument_kinds[$n]) ||
 266                    $options->report_argument_kind($declared_argument_kinds[$n]))
 267                 {
 268                     $output->write("argument " . ($n + 1) . " type mismatch: " .
 269                              $argument_types[$n] . " ($argument_kinds[$n]) != " .
 270                              $declared_argument_kinds[$n] . "\n");
 271                 }
 272             }
 273         }
 274
 275         if($#argument_kinds != $#declared_argument_kinds &&
 276            $implemented_calling_convention ne "asm")
 277         {
 278             if($options->argument_count) {
 279                 $output->write("argument count differs: " .
 280                     ($#argument_types + 1) . " != " .
 281                     ($#declared_argument_kinds + 1) . "\n");
 282             }
 283         }
 284
 285     }
 286
 287     if($segmented && $options->shared_segmented && $winapi->is_shared_internal_function($internal_name)) {
 288         $output->write("function using segmented pointers shared between Win16 och Win32\n");
 289     }
 290 }
 291
 292 sub check_statements {
 293     my $functions = shift;
 294     my $function = shift;
 295
 296     my $module16 = $function->module16;
 297     my $module32 = $function->module32;
 298
 299     if($options->win16 && $options->report_module($module16)) {
 300         _check_statements($win16api, $functions, $function);
 301     }
 302
 303     if($options->win32 && $options->report_module($module32)) {
 304         _check_statements($win16api, $functions, $function);
 305     }
 306 }
 307
 308 sub _check_statements {
 309     my $winapi = shift;
 310     my $functions = shift;
 311     my $function = shift;
 312
 313     my $module = $function->module;
 314     my $internal_name = $function->internal_name;
 315
 316     my $first_debug_message = 1;
 317     local $_ = $function->statements;
 318     while(defined($_)) {
 319         if(s/(\w+)\s*(?:\(\s*(\w+)\s*\))?\s*\(\s*((?:\"[^\"]*\"|\([^\)]*\)|[^\)])*?)\s*\)//) {
 320             my $called_name = $1;
 321             my $channel = $2;
 322             my $called_arguments = $3;
 323             if($called_name =~ /^if|for|while|switch|sizeof$/) {
 324                 # Nothing
 325             } elsif($called_name =~ /^ERR|FIXME|MSG|TRACE|WARN$/) {
 326                 if($first_debug_message && $called_name =~ /^FIXME|TRACE$/) {
 327                     $first_debug_message = 0;
 328                     if($called_arguments =~ /^\"\((.*?)\)(.*?)\"\s*,\s*(.*?)$/) {
 329                         my $formating = $1;
 330                         my $extra = $2;
 331                         my $arguments = $3;
 332
 333                         my $format;
 334                         my $argument;
 335                         my $n = 0;
 336                         while($formating && ($formating =~ s/^([^,]*),?//, $format = $1, $format =~ s/^\s*(.*?)\s*$/$1/) &&
 337                               $arguments && ($arguments =~ s/^([^,]*),?//, $argument = $1, $argument =~ s/^\s*(.*?)\s*$/$1/))
 338                         {
 339                             my $type = @{$function->argument_types}[$n];
 340                             my $name = @{$function->argument_names}[$n];
 341
 342                             $n++;
 343
 344                             if(!defined($type)) { last; }
 345
 346                             $format =~ s/^\w+\s*[:=]?\s*//;
 347                             $format =~ s/\s*\{[^\{\}]*\}$//;
 348                             $format =~ s/\s*\[[^\[\]]*\]$//;
 349                             $format =~ s/^\'(.*?)\'$/$1/;
 350                             $format =~ s/^\\\"(.*?)\\\"$/$1/;
 351
 352                             if($options->debug_messages) {
 353                                 if($argument !~ /$name/) {
 354                                     $output->write("$called_name: argument $n is wrong ($name != '$argument')\n");
 355                                 } elsif(!$winapi->is_allowed_type_format($module, $type, $format)) {
 356                                     $output->write("$called_name: argument $n ($type $name) has illegal format ($format)\n");
 357                                 }
 358                             }
 359                         }
 360
 361                         if($options->debug_messages) {
 362                             my $count = $#{$function->argument_types} + 1;
 363                             if($n != $count) {
 364                                 $output->write("$called_name: argument count mismatch ($n != $count)\n");
 365                             }
 366                         }
 367                     }
 368                 }
 369             } elsif($options->cross_call) {
 370                 # $output->write("$internal_name: called $called_name\n");
 371                 $$functions{$internal_name}->function_called($called_name);
 372                 if(!defined($$functions{$called_name})) {
 373                     my $called_function = 'winapi_function'->new;
 374
 375                     $called_function->internal_name($called_name);
 376
 377                     $$functions{$called_name} = $called_function;
 378                 }
 379                 $$functions{$called_name}->function_called_by($internal_name);
 380             }
 381         } else {
 382             undef $_;
 383         }
 384     }
 385 }
 386
 387 sub check_file {
 388     my $file = shift;
 389     my $functions = shift;
 390
 391     if($options->cross_call) {
 392         my @names = sort(keys(%$functions));
 393         for my $name (@names) {
 394             my $function = $$functions{$name};
 395
 396             my @called_names = $function->called_function_names;
 397             my @called_by_names = $function->called_by_function_names;
 398             my $module = $function->module;
 399
 400             if($options->cross_call_win32_win16) {
 401                 my $module16 = $function->module16;
 402                 my $module32 = $function->module32;
 403
 404                 if($#called_names >= 0 && (defined($module16) || defined($module32)) ) {
 405                     for my $called_name (@called_names) {
 406                         my $called_function = $$functions{$called_name};
 407
 408                         my $called_module16 = $called_function->module16;
 409                         my $called_module32 = $called_function->module32;
 410                         if(defined($module32) &&
 411                            defined($called_module16) && !defined($called_module32) &&
 412                            $name ne $called_name)
 413                         {
 414                             $output->write("$file: $module: $name: illegal call to $called_name (Win32 -> Win16)\n");
 415                         }
 416                     }
 417                 }
 418             }
 419
 420             if($options->cross_call_unicode_ascii) {
 421                 if($name =~ /(?<!A)W$/) {
 422                     for my $called_name (@called_names) {
 423                         if($called_name =~ /A$/) {
 424                             $output->write("$file: $module: $name: illegal call to $called_name (Unicode -> ASCII)\n");
 425                         }
 426                     }
 427                 }
 428             }
 429         }
 430     }
 431 }
 432
 433 1;