2 # Copyright 1999, 2000, 2001 Patrik Stridvall
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.
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.
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
23 use nativeapi qw($nativeapi);
24 use options qw($options);
25 use output qw($output);
26 use winapi qw($win16api $win32api @winapis);
28 sub check_function($) {
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;
42 if(!defined($refargument_types)) {
46 if($options->win16 && $options->report_module($module16)) {
47 _check_function($return_type,
48 $calling_convention, $external_name16,
49 $internal_name, $refargument_types,
53 if($options->win32 && $options->report_module($module32)) {
54 _check_function($return_type,
55 $calling_convention, $external_name32,
56 $internal_name, $refargument_types,
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;
70 my $module = $winapi->function_internal_module($internal_name);
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");
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");
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");
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");
99 } elsif(!$winapi->is_allowed_kind($implemented_return_kind) ||
100 !$winapi->is_allowed_type_in_module($return_type, $module))
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");
111 if(defined($implemented_return_kind) && $implemented_return_kind =~ /^segptr|segstr$/) {
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(defined($implemented_return_kind) && $implemented_return_kind =~ /^s_word|word|void$/) {
123 $implemented_calling_convention = "pascal16";
125 $implemented_calling_convention = "pascal";
127 } elsif($calling_convention =~ /^__asm$/) {
128 $implemented_calling_convention = "asm";
130 $implemented_calling_convention = "cdecl";
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
141 $implemented_calling_convention = "stdcall";
143 } elsif($calling_convention =~ /^__asm$/) {
144 $implemented_calling_convention = "asm";
146 $implemented_calling_convention = "cdecl";
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));
153 my $declared_register = 0;
154 if ($declared_calling_convention =~ /^(\w+) -register$/) {
155 $declared_register = 1;
156 $declared_calling_convention = $1;
159 if ($declared_register)
161 if ($implemented_calling_convention eq "stdcall")
163 $output->write("-register functions should not be implemented as stdcall\n");
166 elsif($implemented_calling_convention ne $declared_calling_convention &&
167 $implemented_calling_convention ne "asm" &&
168 !($declared_calling_convention =~ /^pascal/ && $forbidden_return_type) &&
169 !($implemented_calling_convention =~ /^cdecl|varargs$/ && $declared_calling_convention =~ /^cdecl|varargs$/))
171 if($options->calling_convention && (
172 ($options->calling_convention_win16 && $winapi->name eq "win16") ||
173 ($options->calling_convention_win32 && $winapi->name eq "win32")) &&
174 !$nativeapi->is_function($internal_name))
176 $output->write("calling convention mismatch: $implemented_calling_convention != $declared_calling_convention\n");
180 if($declared_calling_convention eq "varargs") {
181 if ($#argument_types != -1 &&
182 (($winapi->name eq "win32" && $argument_types[$#argument_types] eq "...") ||
183 ($winapi->name eq "win16" && $argument_types[$#argument_types] eq "VA_LIST16")))
187 $output->write("function not implemented as varargs\n");
189 } elsif ($#argument_types != -1 &&
190 (($winapi->name eq "win32" && $argument_types[$#argument_types] eq "...") ||
191 ($winapi->name eq "win16" && $argument_types[$#argument_types] eq "VA_LIST16")))
193 if($#argument_types == 0) {
196 $output->write("function not declared as varargs\n");
200 if($#argument_types != -1 && $argument_types[$#argument_types] eq "CONTEXT *" &&
201 $internal_name =~ /^(?:RtlRaiseException|RtlUnwind|NtRaiseException)$/) # FIXME: Kludge
206 if($internal_name =~ /^NTDLL__ftol|NTDLL__CIpow$/) { # FIXME: Kludge
210 my @argument_kinds = map {
212 my $kind = "unknown";
213 $winapi->type_used_in_module($type,$module);
214 if($type eq "CONTEXT86 *") {
216 } elsif(!defined($kind = $winapi->translate_argument($type))) {
217 $winapi->declare_argument($type, "unknown");
218 $output->write("no translation defined: " . $type . "\n");
219 } elsif(!$winapi->is_allowed_kind($kind) ||
220 !$winapi->is_allowed_type_in_module($type, $module))
222 $winapi->allow_kind($kind);
223 $winapi->allow_type_in_module($type, $module);
224 if($options->report_argument_forbidden($type)) {
225 $output->write("argument " . ($n + 1) . " type is forbidden: " . $type . " (" . $kind . ")\n");
230 if(defined($kind) && $kind eq "struct16") {
232 ("long", "long", "long", "long");
233 } elsif(defined($kind) && $kind =~ /^(?:longlong)$/) {
242 if ($declared_register && $argument_kinds[$#argument_kinds] ne "context86") {
243 $output->write("function declared as register, but CONTEXT86 * is not last argument\n");
246 for my $n (0..$#argument_kinds) {
247 if(!defined($argument_kinds[$n]) || !defined($declared_argument_kinds[$n])) { next; }
249 if($argument_kinds[$n] =~ /^segptr|segstr$/ ||
250 $declared_argument_kinds[$n] =~ /^segptr|segstr$/)
256 if(!defined($argument_types[$n])) {
257 $argument_types[$n] = "";
260 if($argument_kinds[$n] eq "context86") {
262 } elsif(!$winapi->is_allowed_kind($argument_kinds[$n]) ||
263 !$winapi->is_allowed_type_in_module($argument_types[$n], $module))
265 $winapi->allow_kind($argument_kinds[$n]);
266 $winapi->allow_type_in_module($argument_types[$n],, $module);
267 if($options->report_argument_forbidden($argument_types[$n])) {
268 $output->write("argument " . ($n + 1) . " type is forbidden: " .
269 "$argument_types[$n] ($argument_kinds[$n])\n");
271 } elsif($argument_kinds[$n] ne $declared_argument_kinds[$n]) {
272 if($options->report_argument_kind($argument_kinds[$n]) ||
273 $options->report_argument_kind($declared_argument_kinds[$n]))
275 $output->write("argument " . ($n + 1) . " type mismatch: " .
276 $argument_types[$n] . " ($argument_kinds[$n]) != " .
277 $declared_argument_kinds[$n] . "\n");
282 if ($options->argument_count &&
283 $implemented_calling_convention ne "asm")
285 if ($#argument_kinds != $#declared_argument_kinds and
286 $#argument_types != $#declared_argument_kinds) {
287 $output->write("argument count differs: " .
288 ($#argument_kinds + 1) . " != " .
289 ($#declared_argument_kinds + 1) . "\n");
290 } elsif ($#argument_kinds != $#declared_argument_kinds or
291 $#argument_types != $#declared_argument_kinds) {
292 $output->write("argument count differs: " .
293 ($#argument_kinds + 1) . "/" . ($#argument_types + 1) .
294 " != " . ($#declared_argument_kinds + 1) .
295 " (long vs. long long problem?)\n");
301 if($segmented && $options->shared_segmented && $winapi->is_shared_internal_function($internal_name)) {
302 $output->write("function using segmented pointers shared between Win16 and Win32\n");
306 sub check_statements($$) {
307 my $functions = shift;
308 my $function = shift;
310 my $module16 = $function->module16;
311 my $module32 = $function->module32;
313 if($options->win16 && $options->report_module($module16)) {
314 _check_statements($win16api, $functions, $function);
317 if($options->win32 && $options->report_module($module32)) {
318 _check_statements($win16api, $functions, $function);
322 sub _check_statements($$$) {
324 my $functions = shift;
325 my $function = shift;
327 my $module = $function->module;
328 my $internal_name = $function->internal_name;
330 my $first_debug_message = 1;
331 local $_ = $function->statements;
333 if(s/(\w+)\s*(?:\(\s*(\w+)\s*\))?\s*\(\s*((?:\"[^\"]*\"|\([^\)]*\)|[^\)])*?)\s*\)//) {
334 my $called_name = $1;
336 my $called_arguments = $3;
337 if($called_name =~ /^if|for|while|switch|sizeof$/) {
339 } elsif($called_name =~ /^ERR|FIXME|MSG|TRACE|WARN$/) {
340 if($first_debug_message && $called_name =~ /^FIXME|TRACE$/) {
341 $first_debug_message = 0;
342 if($called_arguments =~ /^\"\((.*?)\)(.*?)\"\s*,\s*(.*?)$/) {
350 while($formating && ($formating =~ s/^([^,]*),?//, $format = $1, $format =~ s/^\s*(.*?)\s*$/$1/) &&
351 $arguments && ($arguments =~ s/^([^,]*),?//, $argument = $1, $argument =~ s/^\s*(.*?)\s*$/$1/))
353 my $type = @{$function->argument_types}[$n];
354 my $name = @{$function->argument_names}[$n];
358 if(!defined($type)) { last; }
360 $format =~ s/^\w+\s*[:=]?\s*//;
361 $format =~ s/\s*\{[^\{\}]*\}$//;
362 $format =~ s/\s*\[[^\[\]]*\]$//;
363 $format =~ s/^\'(.*?)\'$/$1/;
364 $format =~ s/^\\\"(.*?)\\\"$/$1/;
366 if($options->debug_messages) {
367 if($argument !~ /$name/) {
368 $output->write("$called_name: argument $n is wrong ($name != '$argument')\n");
369 } elsif(!$winapi->is_allowed_type_format($module, $type, $format)) {
370 $output->write("$called_name: argument $n ($type $name) has illegal format ($format)\n");
375 if($options->debug_messages) {
376 my $count = $#{$function->argument_types} + 1;
378 $output->write("$called_name: argument count mismatch ($n != $count)\n");
383 } elsif($options->cross_call) {
384 # $output->write("$internal_name: called $called_name\n");
385 $$functions{$internal_name}->function_called($called_name);
386 if(!defined($$functions{$called_name})) {
387 my $called_function = 'winapi_function'->new;
389 $called_function->internal_name($called_name);
391 $$functions{$called_name} = $called_function;
393 $$functions{$called_name}->function_called_by($internal_name);
403 my $functions = shift;
405 if($options->cross_call) {
406 my @names = sort(keys(%$functions));
407 for my $name (@names) {
408 my $function = $$functions{$name};
410 my @called_names = $function->called_function_names;
411 my @called_by_names = $function->called_by_function_names;
412 my $module = $function->module;
414 if($options->cross_call_win32_win16) {
415 my $module16 = $function->module16;
416 my $module32 = $function->module32;
418 if($#called_names >= 0 && (defined($module16) || defined($module32)) ) {
419 for my $called_name (@called_names) {
420 my $called_function = $$functions{$called_name};
422 my $called_module16 = $called_function->module16;
423 my $called_module32 = $called_function->module32;
424 if(defined($module32) &&
425 defined($called_module16) && !defined($called_module32) &&
426 $name ne $called_name)
428 $output->write("$file: $module: $name: illegal call to $called_name (Win32 -> Win16)\n");
434 if($options->cross_call_unicode_ascii) {
435 if($name =~ /(?<!A)W$/) {
436 for my $called_name (@called_names) {
437 if($called_name =~ /A$/) {
438 $output->write("$file: $module: $name: illegal call to $called_name (Unicode -> ASCII)\n");