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