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