| package winapi_local; |
| |
| use strict; |
| |
| use nativeapi qw($nativeapi); |
| use options qw($options); |
| use output qw($output); |
| use winapi qw($win16api $win32api @winapis); |
| |
| sub check_function { |
| my $function = shift; |
| |
| my $return_type = $function->return_type; |
| my $calling_convention = $function->calling_convention; |
| my $calling_convention16 = $function->calling_convention16; |
| my $calling_convention32 = $function->calling_convention32; |
| my $internal_name = $function->internal_name; |
| my $external_name16 = $function->external_name16; |
| my $external_name32 = $function->external_name32; |
| my $module16 = $function->module16; |
| my $module32 = $function->module32; |
| my $refargument_types = $function->argument_types; |
| |
| if(!defined($refargument_types)) { |
| return; |
| } |
| |
| if($options->win16 && $options->report_module($module16)) { |
| _check_function($return_type, |
| $calling_convention, $external_name16, |
| $internal_name, $refargument_types, |
| $win16api); |
| } |
| |
| if($options->win32 && $options->report_module($module32)) { |
| _check_function($return_type, |
| $calling_convention, $external_name32, |
| $internal_name, $refargument_types, |
| $win32api); |
| } |
| } |
| |
| sub _check_function { |
| my $return_type = shift; |
| my $calling_convention = shift; |
| my $external_name = shift; |
| my $internal_name = shift; |
| my $refargument_types = shift; |
| my @argument_types = @$refargument_types; |
| my $winapi = shift; |
| |
| my $module = $winapi->function_internal_module($internal_name); |
| |
| if($winapi->name eq "win16") { |
| if($winapi->is_function_stub_in_module($module, $internal_name)) { |
| if($options->implemented) { |
| $output->write("function implemented but declared as stub in .spec file\n"); |
| } |
| return; |
| } elsif($winapi->is_function_stub_in_module($module, $internal_name)) { |
| if($options->implemented_win32) { |
| $output->write("32-bit variant of function implemented but declared as stub in .spec file\n"); |
| } |
| return; |
| } |
| } elsif($winapi->is_function_stub_in_module($module, $internal_name)) { |
| if($options->implemented) { |
| $output->write("function implemented but declared as stub in .spec file\n"); |
| } |
| return; |
| } |
| |
| my $forbidden_return_type = 0; |
| my $implemented_return_kind; |
| $winapi->type_used_in_module($return_type,$module); |
| if(!defined($implemented_return_kind = $winapi->translate_argument($return_type))) { |
| if($return_type ne "") { |
| $output->write("no translation defined: " . $return_type . "\n"); |
| } |
| } elsif(!$winapi->is_allowed_kind($implemented_return_kind) || !$winapi->allowed_type_in_module($return_type,$module)) { |
| $forbidden_return_type = 1; |
| if($options->report_argument_forbidden($return_type)) { |
| $output->write("return type is forbidden: $return_type ($implemented_return_kind)\n"); |
| } |
| } |
| |
| my $segmented = 0; |
| if(defined($implemented_return_kind) && $implemented_return_kind =~ /^segptr|segstr$/) { |
| $segmented = 1; |
| } |
| |
| my $implemented_calling_convention; |
| if($winapi->name eq "win16") { |
| if($calling_convention =~ /^__cdecl$/) { |
| $implemented_calling_convention = "cdecl"; |
| } elsif($calling_convention =~ /^VFWAPIV|WINAPIV$/) { |
| $implemented_calling_convention = "varargs"; |
| } elsif($calling_convention =~ /^__stdcall|VFWAPI|WINAPI|CALLBACK$/) { |
| if($implemented_return_kind =~ /^s_word|word|void$/) { |
| $implemented_calling_convention = "pascal16"; |
| } else { |
| $implemented_calling_convention = "pascal"; |
| } |
| } elsif($calling_convention =~ /^__asm$/) { |
| $implemented_calling_convention = "asm"; |
| } else { |
| $implemented_calling_convention = "cdecl"; |
| } |
| } elsif($winapi->name eq "win32") { |
| if($calling_convention =~ /^__cdecl$/) { |
| $implemented_calling_convention = "cdecl"; |
| } elsif($calling_convention =~ /^VFWAPIV|WINAPIV$/) { |
| $implemented_calling_convention = "varargs"; |
| } elsif($calling_convention =~ /^__stdcall|VFWAPI|WINAPI|CALLBACK$/) { |
| if(defined($implemented_return_kind) && $implemented_return_kind =~ /^longlong$/) { |
| $implemented_calling_convention = "stdcall"; # FIXME: Check entry flags |
| } else { |
| $implemented_calling_convention = "stdcall"; |
| } |
| } elsif($calling_convention =~ /^__asm$/) { |
| $implemented_calling_convention = "asm"; |
| } else { |
| $implemented_calling_convention = "cdecl"; |
| } |
| } |
| |
| my $declared_calling_convention = $winapi->function_internal_calling_convention($internal_name); |
| my @declared_argument_kinds = split(/\s+/, $winapi->function_internal_arguments($internal_name)); |
| |
| if($declared_calling_convention =~ /^register|interrupt$/) { |
| push @declared_argument_kinds, "ptr"; |
| } |
| |
| if($declared_calling_convention =~ /^register|interupt$/ && |
| (($winapi->name eq "win32" && $implemented_calling_convention eq "stdcall") || |
| (($winapi->name eq "win16" && $implemented_calling_convention =~ /^pascal/)))) |
| { |
| # correct |
| } elsif($implemented_calling_convention ne $declared_calling_convention && |
| $implemented_calling_convention ne "asm" && |
| !($declared_calling_convention =~ /^pascal/ && $forbidden_return_type) && |
| !($implemented_calling_convention =~ /^cdecl|varargs$/ && $declared_calling_convention =~ /^cdecl|varargs$/)) |
| { |
| if($options->calling_convention && ( |
| ($options->calling_convention_win16 && $winapi->name eq "win16") || |
| ($options->calling_convention_win32 && $winapi->name eq "win32")) && |
| !$nativeapi->is_function($internal_name)) |
| { |
| $output->write("calling convention mismatch: $implemented_calling_convention != $declared_calling_convention\n"); |
| } |
| } |
| |
| if($declared_calling_convention eq "varargs") { |
| if($#argument_types != -1 && $argument_types[$#argument_types] eq "...") { |
| pop @argument_types; |
| } else { |
| $output->write("function not implemented as vararg\n"); |
| } |
| } elsif($#argument_types != -1 && $argument_types[$#argument_types] eq "...") { |
| if($#argument_types == 0 || $winapi->name eq "win16") { |
| pop @argument_types; |
| } else { |
| $output->write("function not declared as vararg\n"); |
| } |
| } |
| |
| if($#argument_types != -1 && $argument_types[$#argument_types] eq "CONTEXT *" && |
| $internal_name !~ /^(Get|Set)ThreadContext$/) # FIXME: Kludge |
| { |
| $#argument_types--; |
| } |
| |
| if($internal_name =~ /^NTDLL__ftol|NTDLL__CIpow$/) { # FIXME: Kludge |
| # ignore |
| } else { |
| my $n = 0; |
| my @argument_kinds = map { |
| my $type = $_; |
| my $kind = "unknown"; |
| $winapi->type_used_in_module($type,$module); |
| if(!defined($kind = $winapi->translate_argument($type))) { |
| $output->write("no translation defined: " . $type . "\n"); |
| } elsif(!$winapi->is_allowed_kind($kind) || |
| !$winapi->allowed_type_in_module($type, $module)) { |
| if($options->report_argument_forbidden($type)) { |
| $output->write("forbidden argument " . ($n + 1) . " type " . $type . " (" . $kind . ")\n"); |
| } |
| } |
| |
| # FIXME: Kludge |
| if(defined($kind) && $kind eq "longlong") { |
| $n+=2; |
| ("long", "long"); |
| } else { |
| $n++; |
| $kind; |
| } |
| } @argument_types; |
| |
| for my $n (0..$#argument_kinds) { |
| if(!defined($argument_kinds[$n]) || !defined($declared_argument_kinds[$n])) { next; } |
| |
| if($argument_kinds[$n] =~ /^segptr|segstr$/ || |
| $declared_argument_kinds[$n] =~ /^segptr|segstr$/) |
| { |
| $segmented = 1; |
| } |
| |
| # FIXME: Kludge |
| if(!defined($argument_types[$n])) { |
| $argument_types[$n] = ""; |
| } |
| |
| if(!$winapi->is_allowed_kind($argument_kinds[$n]) || |
| !$winapi->allowed_type_in_module($argument_types[$n], $module)) |
| { |
| if($options->report_argument_forbidden($argument_types[$n])) { |
| $output->write("argument " . ($n + 1) . " type is forbidden: " . |
| "$argument_types[$n] ($argument_kinds[$n])\n"); |
| } |
| } elsif($argument_kinds[$n] ne $declared_argument_kinds[$n]) { |
| if($options->report_argument_kind($argument_kinds[$n]) || |
| $options->report_argument_kind($declared_argument_kinds[$n])) |
| { |
| $output->write("argument " . ($n + 1) . " type mismatch: " . |
| $argument_types[$n] . " ($argument_kinds[$n]) != " . |
| $declared_argument_kinds[$n] . "\n"); |
| } |
| } |
| } |
| |
| if($#argument_kinds != $#declared_argument_kinds && |
| $implemented_calling_convention ne "asm") |
| { |
| if($options->argument_count) { |
| $output->write("argument count differs: " . |
| ($#argument_types + 1) . " != " . |
| ($#declared_argument_kinds + 1) . "\n"); |
| } |
| } |
| |
| } |
| |
| if($segmented && $options->shared_segmented && $winapi->is_shared_internal_function($internal_name)) { |
| $output->write("function using segmented pointers shared between Win16 och Win32\n"); |
| } |
| } |
| |
| sub check_statements { |
| my $functions = shift; |
| my $function = shift; |
| |
| my $module16 = $function->module16; |
| my $module32 = $function->module32; |
| |
| if($options->win16 && $options->report_module($module16)) { |
| _check_statements($win16api, $functions, $function); |
| } |
| |
| if($options->win32 && $options->report_module($module32)) { |
| _check_statements($win16api, $functions, $function); |
| } |
| } |
| |
| sub _check_statements { |
| my $winapi = shift; |
| my $functions = shift; |
| my $function = shift; |
| |
| my $module = $function->module; |
| my $internal_name = $function->internal_name; |
| |
| my $first_debug_message = 1; |
| local $_ = $function->statements; |
| while(defined($_)) { |
| if(s/(\w+)\s*(?:\(\s*(\w+)\s*\))?\s*\(\s*((?:\"[^\"]*\"|\([^\)]*\)|[^\)])*?)\s*\)//) { |
| my $called_name = $1; |
| my $channel = $2; |
| my $called_arguments = $3; |
| if($called_name =~ /^if|for|while|switch|sizeof$/) { |
| # Nothing |
| } elsif($called_name =~ /^ERR|FIXME|MSG|TRACE|WARN$/) { |
| if($first_debug_message && $called_name =~ /^FIXME|TRACE$/) { |
| $first_debug_message = 0; |
| if($called_arguments =~ /^\"\((.*?)\)(.*?)\"\s*,\s*(.*?)$/) { |
| my $formating = $1; |
| my $extra = $2; |
| my $arguments = $3; |
| |
| my $format; |
| my $argument; |
| my $n = 0; |
| while($formating && ($formating =~ s/^([^,]*),?//, $format = $1, $format =~ s/^\s*(.*?)\s*$/$1/) && |
| $arguments && ($arguments =~ s/^([^,]*),?//, $argument = $1, $argument =~ s/^\s*(.*?)\s*$/$1/)) |
| { |
| my $type = @{$function->argument_types}[$n]; |
| my $name = @{$function->argument_names}[$n]; |
| |
| $n++; |
| |
| if(!defined($type)) { last; } |
| |
| $format =~ s/^\w+\s*[:=]?\s*//; |
| $format =~ s/\s*\{[^\{\}]*\}$//; |
| $format =~ s/\s*\[[^\[\]]*\]$//; |
| $format =~ s/^\'(.*?)\'$/$1/; |
| $format =~ s/^\\\"(.*?)\\\"$/$1/; |
| |
| if($options->debug_messages) { |
| if($argument !~ /$name/) { |
| $output->write("$called_name: argument $n is wrong ($name != '$argument')\n"); |
| } elsif(!$winapi->is_allowed_type_format($module, $type, $format)) { |
| $output->write("$called_name: argument $n ($type $name) has illegal format ($format)\n"); |
| } |
| } |
| } |
| |
| if($options->debug_messages) { |
| my $count = $#{$function->argument_types} + 1; |
| if($n != $count) { |
| $output->write("$called_name: argument count mismatch ($n != $count)\n"); |
| } |
| } |
| } |
| } |
| } else { |
| $$functions{$internal_name}->function_called($called_name); |
| if(!defined($$functions{$called_name})) { |
| $$functions{$called_name} = 'winapi_function'->new; |
| } |
| $$functions{$called_name}->function_called_by($internal_name); |
| } |
| } else { |
| undef $_; |
| } |
| } |
| } |
| |
| sub check_file { |
| my $file = shift; |
| my $functions = shift; |
| |
| if($options->cross_call) { |
| my @names = sort(keys(%$functions)); |
| for my $name (@names) { |
| my @called_names = $$functions{$name}->called_function_names; |
| my @called_by_names = $$functions{$name}->called_by_function_names; |
| my $module = $$functions{$name}->module; |
| |
| if($options->cross_call_win32_win16) { |
| my $module16 = $$functions{$name}->module16; |
| my $module32 = $$functions{$name}->module32; |
| |
| if($#called_names >= 0 && (defined($module16) || defined($module32)) ) { |
| for my $called_name (@called_names) { |
| my $called_module16 = $$functions{$called_name}->module16; |
| my $called_module32 = $$functions{$called_name}->module32; |
| if(defined($module32) && |
| defined($called_module16) && !defined($called_module32) && |
| $name ne $called_name) |
| { |
| $output->write("$file: $module: $name: illegal call to $called_name (Win32 -> Win16)\n"); |
| } |
| } |
| } |
| } |
| |
| if($options->cross_call_unicode_ascii) { |
| if($name =~ /W$/) { |
| for my $called_name (@called_names) { |
| if($called_name =~ /A$/) { |
| $output->write("$file: $module: $name: illegal call to $called_name (Unicode -> ASCII)\n"); |
| } |
| } |
| } |
| } |
| } |
| } |
| } |
| |
| 1; |
| |
