137 lines
4.5 KiB
Perl
137 lines
4.5 KiB
Perl
package winapi_local;
|
|
|
|
use strict;
|
|
|
|
sub check_arguments {
|
|
my $options = shift;
|
|
my $output = shift;
|
|
my $return_type = shift;
|
|
my $calling_convention = shift;
|
|
my $name = shift;
|
|
my $refargument_types = shift;
|
|
my @argument_types = @$refargument_types;
|
|
my $winapi = shift;
|
|
|
|
my $module = $winapi->function_module($name);
|
|
|
|
my $forbidden_return_type = 0;
|
|
my $implemented_return_kind;
|
|
if(!defined($implemented_return_kind = $winapi->translate_argument($return_type))) {
|
|
if($return_type ne "") {
|
|
&$output("no translation defined: " . $return_type);
|
|
}
|
|
} 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("forbidden return type: $return_type ($implemented_return_kind)");
|
|
}
|
|
}
|
|
|
|
my $segmented = 0;
|
|
if($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 = ~ /^__stdcall|VFWAPI|WINAPI$/) {
|
|
if($implemented_return_kind =~ /^s_word|word|void$/) {
|
|
$implemented_calling_convention = "pascal16";
|
|
} else {
|
|
$implemented_calling_convention = "pascal";
|
|
}
|
|
}
|
|
} 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$/) {
|
|
$implemented_calling_convention = "stdcall";
|
|
}
|
|
}
|
|
|
|
my $declared_calling_convention = $winapi->function_calling_convention($name);
|
|
my @declared_argument_kinds = split(/\s+/, $winapi->function_arguments($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 &&
|
|
!($declared_calling_convention =~ /^pascal/ && $forbidden_return_type))
|
|
{
|
|
if($options->calling_convention) {
|
|
&$output("calling convention mismatch: $implemented_calling_convention != $declared_calling_convention");
|
|
}
|
|
}
|
|
|
|
if($declared_calling_convention eq "varargs") {
|
|
if($#argument_types != -1 && $argument_types[$#argument_types] eq "...") {
|
|
pop @argument_types;
|
|
} else {
|
|
&$output("function not implemented as vararg");
|
|
}
|
|
} elsif($#argument_types != -1 && $argument_types[$#argument_types] eq "...") {
|
|
&$output("function not declared as vararg");
|
|
}
|
|
|
|
if($name =~ /^CRTDLL__ftol|CRTDLL__CIpow$/) {
|
|
# ignore
|
|
} elsif($#argument_types != $#declared_argument_kinds) {
|
|
if($options->argument_count) {
|
|
&$output("argument count differs: " . ($#argument_types + 1) . " != " . ($#declared_argument_kinds + 1));
|
|
}
|
|
} else {
|
|
my $n = 0;
|
|
my @argument_kinds = map {
|
|
my $type = $_;
|
|
my $kind = "unknown";
|
|
if(!defined($kind = $winapi->translate_argument($type))) {
|
|
&$output("no translation defined: " . $type);
|
|
} elsif(!$winapi->is_allowed_kind($kind) ||
|
|
!$winapi->allowed_type_in_module($type, $module)) {
|
|
if($options->report_argument_forbidden($type)) {
|
|
&$output("forbidden argument " . ($n + 1) . " type (" . $type . ")");
|
|
}
|
|
}
|
|
$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;
|
|
}
|
|
|
|
if($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("argument " . ($n + 1) . " type mismatch: " .
|
|
$argument_types[$n] . " ($argument_kinds[$n]) != " . $declared_argument_kinds[$n]);
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
|
|
if($segmented && $options->shared_segmented && $winapi->is_shared_function($name)) {
|
|
&$output("function using segmented pointers shared between Win16 och Win32");
|
|
}
|
|
}
|
|
|
|
1;
|
|
|