winapi.pm 28.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
16
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17 18
#

19 20 21
package winapi;

use strict;
22
use warnings 'all';
23

24 25 26 27 28 29 30 31
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw($win16api $win32api @winapis);

use vars qw($win16api $win32api @winapis);
32

33
use config qw($current_dir $wine_dir $winapi_dir);
34 35 36
use options qw($options);
use output qw($output);

37
use vars qw($modules);
38

39 40 41 42 43 44 45 46 47
sub found_shared_internal_function($$);
sub function_external_calling_convention_in_module($$$);
sub function_internal_module($$);
sub is_function_stub_in_module($$$);
sub new($$$);
sub parse_api_file($$);
sub parse_spec_file($$);

sub import(@) {
48
    $Exporter::ExportLevel++;
49
    Exporter::import(@_);
50
    $Exporter::ExportLevel--;
Patrik Stridvall's avatar
Patrik Stridvall committed
51

Patrik Stridvall's avatar
Patrik Stridvall committed
52 53 54 55
    if (defined($modules) && defined($win16api) && defined($win32api)) {
	return;
    }

56 57
    require modules;
    import modules qw($modules);
58

59 60
    my @spec_files16 = $modules->allowed_spec_files16;
    $win16api = 'winapi'->new("win16", \@spec_files16);
61

62 63
    my @spec_files32 = $modules->allowed_spec_files32;
    $win32api = 'winapi'->new("win32", \@spec_files32);
64

65 66 67 68 69 70 71 72 73 74 75 76
    @winapis = ($win16api, $win32api);

    for my $internal_name ($win32api->all_internal_functions) {
	my $module16 = $win16api->function_internal_module($internal_name);
	my $module32 = $win16api->function_internal_module($internal_name);
	if(defined($module16) &&
	   !$win16api->is_function_stub_in_module($module16, $internal_name) &&
	   !$win32api->is_function_stub_in_module($module32, $internal_name))
	{
	    $win16api->found_shared_internal_function($internal_name);
	    $win32api->found_shared_internal_function($internal_name);
	}
Patrik Stridvall's avatar
Patrik Stridvall committed
77
    }
78 79
}

80

81
sub new($$$) {
82 83 84 85 86
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

87
    my $name = \${$self->{NAME}};
Patrik Stridvall's avatar
Patrik Stridvall committed
88 89 90
    my $function_forward = \%{$self->{FUNCTION_FORWARD}};
    my $function_internal_name = \%{$self->{FUNCTION_INTERNAL_NAME}};
    my $function_module = \%{$self->{FUNCTION_MODULE}};
91 92

    $$name = shift;
Patrik Stridvall's avatar
Patrik Stridvall committed
93 94 95 96 97
    my $refspec_files = shift;

    foreach my $file (@$refspec_files) {
	$self->parse_spec_file("$wine_dir/$file");
    }
98

99
    $self->parse_api_file("$$name.api");
100

101 102 103 104 105 106 107
    foreach my $module (sort(keys(%$function_forward))) {
	foreach my $external_name (sort(keys(%{$$function_forward{$module}}))) {
	    (my $forward_module, my $forward_external_name) = @{$$function_forward{$module}{$external_name}};
	    my $forward_internal_name = $$function_internal_name{$forward_external_name};
	    if(defined($forward_internal_name)) {
		$$function_module{$forward_internal_name} .= " & $module";
	    }
Patrik Stridvall's avatar
Patrik Stridvall committed
108 109
	}
    }
110 111 112 113

    return $self;
}

114
sub win16api() {
115 116 117
    return $win16api;
}

118
sub win32api() {
119 120 121
    return $win32api;
}

122
sub parse_api_file($$) {
123
    my $self = shift;
Patrik Stridvall's avatar
Patrik Stridvall committed
124

125 126 127
    my $allowed_kind = \%{$self->{ALLOWED_KIND}};
    my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
    my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
128
    my $allowed_modules_unlimited = \%{$self->{ALLOWED_MODULES_UNLIMITED}};
129
    my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
130
    my $type_format = \%{$self->{TYPE_FORMAT}};
131 132 133

    my $file = shift;

134
    my $module;
135
    my $kind;
136
    my $format;
137 138
    my $forbidden = 0;

139
    $output->lazy_progress("$file");
140

141
    open(IN, "< $winapi_dir/$file") || die "$winapi_dir/$file: $!\n";
142
    $/ = "\n";
143
    my $linenum=0;
144
    while(<IN>) {
145
        $linenum++;
146 147 148 149
	s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begin and end of line
	s/^(.*?)\s*#.*$/$1/;  # remove comments
	/^$/ && next;         # skip empty lines

150 151 152 153 154 155
	if(/^%%(\S+)$/) {
	    $module = $1;
	    $module =~ s/\.dll$//; # FIXME: Kludge
	} elsif(!$modules->is_allowed_module($module)) {
	    # Nothing
	} elsif(s/^%(\S+)\s*//) {
156
	    $kind = $1;
157
	    $format = undef;
158 159 160
	    $forbidden = 0;

	    $$allowed_kind{$kind} = 1;
161
	    if(/^--forbidden/) {
162
		$forbidden = 1;
163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
	    } elsif(/^--format=(\".*?\"|\S*)/) {
		$format = $1;
		$format =~ s/^\"(.*?)\"$/$1/;
	    }

	    if(!defined($format)) {
		if($kind eq "long") {
		    $format  = "%d|%u|%x|%X|";
		    $format .= "%hd|%hu|%hx|%hX|";
		    $format .= "%ld|%lu|%lx|%lX|";
		    $format .= "%04x|%04X|0x%04x|0x%04X|";
		    $format .= "%08x|%08X|0x%08x|0x%08X|";
                    $format .= "%08lx|%08lX|0x%08lx|0x%08lX";
		} elsif($kind eq "longlong") {
		    $format = "%lld";
		} elsif($kind eq "ptr") {
		    $format = "%p";
		} elsif($kind eq "segptr") {
		    $format = "%p";
		} elsif($kind eq "str") {
		    $format = "%p|%s";
		} elsif($kind eq "wstr") {
		    $format = "%p|%s";
		} elsif($kind eq "word") {
		    $format  = "%d|%u|%x|%X|";
		    $format .= "%hd|%hu|%hx|%hX|";
		    $format .= "%04x|%04X|0x%04x|0x%04X";
		} else {
		    $format = "<unknown>";
		}
193 194 195
	    }
	} elsif(defined($kind)) {
	    my $type = $_;
196
            if ($type =~ /\blong\b/)
197 198 199
            {
                $output->write("$file:$linenum: type ($type) is not Win64 compatible\n");
            }
200
	    if(!$forbidden) {
201 202
		if(defined($module)) {
		    if($$allowed_modules_unlimited{$type}) {
203
			$output->write("$file:$linenum: type ($type) already specified as an unlimited type\n");
204 205 206 207
		    } elsif(!$$allowed_modules{$type}{$module}) {
			$$allowed_modules{$type}{$module} = 1;
			$$allowed_modules_limited{$type} = 1;
		    } else {
208
			$output->write("$file:$linenum: type ($type) already specified\n");
209 210 211
		    }
		} else {
		    $$allowed_modules_unlimited{$type} = 1;
212 213 214 215
		}
	    } else {
		$$allowed_modules_limited{$type} = 1;
	    }
216
	    if(defined($$translate_argument{$type}) && $$translate_argument{$type} ne $kind) {
217
		$output->write("$file:$linenum: type ($type) respecified as different kind ($kind != $$translate_argument{$type})\n");
218 219 220
	    } else {
		$$translate_argument{$type} = $kind;
	    }
221

222
	    $$type_format{$module}{$type} = $format;
223
	} else {
224
	    $output->write("$file:$linenum: file must begin with %<type> statement\n");
225 226 227 228 229 230
	    exit 1;
	}
    }
    close(IN);
}

231
sub parse_spec_file($$) {
232
    my $self = shift;
233

234 235 236 237 238 239
    my $function_internal_arguments = \%{$self->{FUNCTION_INTERNAL_ARGUMENTS}};
    my $function_external_arguments = \%{$self->{FUNCTION_EXTERNAL_ARGUMENTS}};
    my $function_internal_ordinal = \%{$self->{FUNCTION_INTERNAL_ORDINAL}};
    my $function_external_ordinal = \%{$self->{FUNCTION_EXTERNAL_ORDINAL}};
    my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
    my $function_external_calling_convention = \%{$self->{FUNCTION_EXTERNAL_CALLING_CONVENTION}};
240
    my $function_internal_name = \%{$self->{FUNCTION_INTERNAL_NAME}};
Patrik Stridvall's avatar
Patrik Stridvall committed
241
    my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
242
    my $function_forward = \%{$self->{FUNCTION_FORWARD}};
243 244
    my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
    my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};
245
    my $function_wine_extension = \%{$self->{FUNCTION_WINE_EXTENSION}};
Patrik Stridvall's avatar
Patrik Stridvall committed
246
    my $modules = \%{$self->{MODULES}};
247
    my $module_files = \%{$self->{MODULE_FILES}};
248
    my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
249 250

    my $file = shift;
251
    $file =~ s%^\./%%;
252 253

    my %ordinals;
254
    my $module;
255
    my $wine_extension = 0;
256

257
    $output->lazy_progress("$file");
258

259 260 261
    $module = $file;
    $module =~ s/^.*?([^\/]*)\.spec$/$1/;

262 263 264 265 266 267 268
    open(IN, "< $file") || die "$file: $!\n";
    $/ = "\n";
    my $header = 1;
    my $lookahead = 0;
    while($lookahead || defined($_ = <IN>)) {
	$lookahead = 0;
	s/^\s*(.*?)\s*$/$1/;
269 270
	if(s/^(.*?)\s*\#\s*(.*)\s*$/$1/) {
	    my $comment = $2;
Patrik Stridvall's avatar
Patrik Stridvall committed
271
	    if ($comment =~ /^Wine/i) { # FIXME: Kludge
272 273 274
		$wine_extension = 1;
	    }
	}
275 276 277
	/^$/ && next;

	if($header)  {
Patrik Stridvall's avatar
Patrik Stridvall committed
278
	    if(/^\d+|@/) { $header = 0; $lookahead = 1; }
279
	    next;
280
	}
281

282
	my $ordinal;
283
	my $ARCHES="arm|arm64|i386|powerpc|win32|win64|x86_64";
284
	if(/^(\d+|@)\s+
285
	   (cdecl|pascal|stdcall|varargs|thiscall)\s+
286
	   ((?:(?:-arch=!?(?:$ARCHES)(?:,(?:$ARCHES))*|-import|-noname|-norelay|-ordinal|-i386|-ret16|-ret64|-fastcall|-register|-interrupt|-private)\s+)*)(\S+)\s*\(\s*(.*?)\s*\)\s*(\S*)$/x)
287
	{
288
	    my $calling_convention = $2;
Patrik Stridvall's avatar
Patrik Stridvall committed
289 290 291 292 293
	    my $flags = $3;
	    my $external_name = $4;
	    my $arguments = $5;
	    my $internal_name = $6;

294
	    $ordinal = $1;
295

Patrik Stridvall's avatar
Patrik Stridvall committed
296 297
	    $flags =~ s/\s+/ /g;

298 299 300 301
            if (!$internal_name)
            {
                $internal_name = ($flags =~ /-register/ ? "__regs_" : "") . $external_name;
            }
Patrik Stridvall's avatar
Patrik Stridvall committed
302

Patrik Stridvall's avatar
Patrik Stridvall committed
303 304 305 306
	    if($flags =~ /-noname/) {
		# $external_name = "@";
	    }

Patrik Stridvall's avatar
Patrik Stridvall committed
307 308 309
	    if($flags =~ /(?:-register|-interrupt)/) {
		if($arguments) { $arguments .= " "; }
		$arguments .= "ptr";
Patrik Stridvall's avatar
Patrik Stridvall committed
310
		$calling_convention .= " -register";
Patrik Stridvall's avatar
Patrik Stridvall committed
311
	    }
312 313 314
	    if($flags =~ /(?:-i386)/) {
		$calling_convention .= " -i386";
	    }
Patrik Stridvall's avatar
Patrik Stridvall committed
315

Patrik Stridvall's avatar
Patrik Stridvall committed
316
	    if ($internal_name =~ /^(.*?)\.(.*?)$/) {
Patrik Stridvall's avatar
Patrik Stridvall committed
317
		my $forward_module = lc($1);
Patrik Stridvall's avatar
Patrik Stridvall committed
318
		my $forward_name = $2;
319
		$calling_convention = "forward";
Patrik Stridvall's avatar
Patrik Stridvall committed
320 321 322
		$$function_forward{$module}{$external_name} = [$forward_module, $forward_name];
	    }

323 324 325 326 327
            if($external_name ne "@") {
                $$module_external_calling_convention{$module}{$external_name} = $calling_convention;
            } else {
                $$module_external_calling_convention{$module}{"\@$ordinal"} = $calling_convention;
            }
328 329 330 331 332 333 334 335 336 337
	    if(!$$function_internal_name{$external_name}) {
		$$function_internal_name{$external_name} = $internal_name;
	    } else {
		$$function_internal_name{$external_name} .= " & $internal_name";
	    }
	    if(!$$function_external_name{$internal_name}) {
		$$function_external_name{$internal_name} = $external_name;
	    } else {
		$$function_external_name{$internal_name} .= " & $external_name";
	    }
338 339
	    $$function_internal_arguments{$internal_name} = $arguments;
	    $$function_external_arguments{$external_name} = $arguments;
340 341 342 343 344 345 346 347 348 349
	    if(!$$function_internal_ordinal{$internal_name}) {
		$$function_internal_ordinal{$internal_name} = $ordinal;
	    } else {
		$$function_internal_ordinal{$internal_name} .= " & $ordinal";
	    }
	    if(!$$function_external_ordinal{$external_name}) {
		$$function_external_ordinal{$external_name} = $ordinal;
	    } else {
		$$function_external_ordinal{$external_name} .= " & $ordinal";
	    }
350 351 352 353
	    $$function_internal_calling_convention{$internal_name} = $calling_convention;
	    $$function_external_calling_convention{$external_name} = $calling_convention;
	    if(!$$function_internal_module{$internal_name}) {
		$$function_internal_module{$internal_name} = "$module";
354
	    } else {
355 356 357 358
		$$function_internal_module{$internal_name} .= " & $module";
	    }
	    if(!$$function_external_module{$external_name}) {
		$$function_external_module{$external_name} = "$module";
359
	    } else {
360
		$$function_external_module{$external_name} .= " & $module";
361
	    }
362
	    $$function_wine_extension{$module}{$external_name} = $wine_extension;
363

364
	    if(0 && $options->spec_mismatch) {
365 366
		if($external_name eq "@") {
		    if($internal_name !~ /^\U$module\E_$ordinal$/) {
367
			$output->write("$file: $external_name: the internal name ($internal_name) mismatch\n");
368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
		    }
		} else {
		    my $name = $external_name;

		    my $name1 = $name;
		    $name1 =~ s/^Zw/Nt/;

		    my $name2 = $name;
		    $name2 =~ s/^(?:_|Rtl|k32|K32)//;

		    my $name3 = $name;
		    $name3 =~ s/^INT_Int[0-9a-f]{2}Handler$/BUILTIN_DefaultIntHandler/;

		    my $name4 = $name;
		    $name4 =~ s/^(VxDCall)\d$/$1/;

384
		    # FIXME: This special case is because of a very ugly kludge that should be fixed IMHO
385 386 387 388 389 390
		    my $name5 = $name;
		    $name5 =~ s/^(.*?16)_(.*?)$/$1_fn$2/;

		    if(uc($internal_name) ne uc($external_name) &&
		       $internal_name !~ /(\Q$name\E|\Q$name1\E|\Q$name2\E|\Q$name3\E|\Q$name4\E|\Q$name5\E)/)
		    {
391
			$output->write("$file: $external_name: internal name ($internal_name) mismatch\n");
392 393 394
		    }
		}
	    }
395
	} elsif(/^(\d+|@)\s+stub(?:\s+(-arch=(?:$ARCHES)(?:,(?:$ARCHES))*|-noname|-norelay|-ordinal|-i386|-ret16|-ret64|-private))*\s+(\S+?)\s*(\(\s*(.*?)\s*\))?$/) {
396 397
	    $ordinal = $1;

Patrik Stridvall's avatar
Patrik Stridvall committed
398 399 400 401 402 403 404 405 406
	    my $flags = $2;
	    my $external_name = $3;

	    $flags = "" if !defined($flags);

	    if($flags =~ /-noname/) {
		# $external_name = "@";
	    }

407
	    my $internal_name = $external_name;
408

409 410 411 412 413
            if ($external_name ne "@") {
                $$module_external_calling_convention{$module}{$external_name} = "stub";
            } else {
                $$module_external_calling_convention{$module}{"\@$ordinal"} = "stub";
            }
414 415 416 417 418 419 420 421 422 423
	    if(!$$function_internal_name{$external_name}) {
		$$function_internal_name{$external_name} = $internal_name;
	    } else {
		$$function_internal_name{$external_name} .= " & $internal_name";
	    }
	    if(!$$function_external_name{$internal_name}) {
		$$function_external_name{$internal_name} = $external_name;
	    } else {
		$$function_external_name{$internal_name} .= " & $external_name";
	    }
424 425 426 427 428 429 430 431 432 433
	    if(!$$function_internal_ordinal{$internal_name}) {
		$$function_internal_ordinal{$internal_name} = $ordinal;
	    } else {
		$$function_internal_ordinal{$internal_name} .= " & $ordinal";
	    }
	    if(!$$function_external_ordinal{$external_name}) {
		$$function_external_ordinal{$external_name} = $ordinal;
	    } else {
		$$function_external_ordinal{$external_name} .= " & $ordinal";
	    }
434 435
	    if(!$$function_internal_module{$internal_name}) {
		$$function_internal_module{$internal_name} = "$module";
436
	    } else { # if($$function_internal_module{$internal_name} !~ /$module/) {
437 438 439 440
		$$function_internal_module{$internal_name} .= " & $module";
	    }
	    if(!$$function_external_module{$external_name}) {
		$$function_external_module{$external_name} = "$module";
441
	    } else { # if($$function_external_module{$external_name} !~ /$module/) {
442
		$$function_external_module{$external_name} .= " & $module";
443
	    }
444
	} elsif(/^(\d+|@)\s+extern(?:\s+(?:-arch=(?:$ARCHES)(?:,(?:$ARCHES))*|-noname|-norelay|-ordinal|-i386|-ret16|-ret64))*\s+(\S+)\s*(\S*)$/) {
445 446 447 448 449
	    $ordinal = $1;

	    my $external_name = $2;
	    my $internal_name = $3;

Patrik Stridvall's avatar
Patrik Stridvall committed
450 451
	    $internal_name = $external_name if !$internal_name;

452 453 454 455 456
            if ($external_name ne "@") {
                $$module_external_calling_convention{$module}{$external_name} = "extern";
            } else {
                $$module_external_calling_convention{$module}{"\@$ordinal"} = "extern";
            }
457
	} elsif(/^(?:\d+|@)\s+(?:equate|variable)/) {
458 459 460
	    # ignore
	} else {
	    my $next_line = <IN>;
Patrik Stridvall's avatar
Patrik Stridvall committed
461
	    if(!defined($next_line) || $next_line =~ /^\s*\d|@/) {
462 463 464 465 466 467
		die "$file: $.: syntax error: '$_'\n";
	    } else {
		$_ .= $next_line;
		$lookahead = 1;
	    }
	}
468

469
	if(defined($ordinal)) {
470
	    if($ordinal ne "@" && $ordinals{$ordinal}) {
471
		$output->write("$file: ordinal redefined: $_\n");
472 473 474
	    }
	    $ordinals{$ordinal}++;
	}
475 476
    }
    close(IN);
Patrik Stridvall's avatar
Patrik Stridvall committed
477 478

    $$modules{$module}++;
479 480

    $$module_files{$module} = $file;
481 482
}

483
sub name($) {
484
    my $self = shift;
485 486 487
    my $name = \${$self->{NAME}};

    return $$name;
488 489
}

490
sub is_allowed_kind($$) {
491 492 493 494 495 496 497 498 499
    my $self = shift;
    my $allowed_kind = \%{$self->{ALLOWED_KIND}};

    my $kind = shift;
    if(defined($kind)) {
	return $$allowed_kind{$kind};
    } else {
	return 0;
    }
Patrik Stridvall's avatar
Patrik Stridvall committed
500 501 502

}

503
sub allow_kind($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
504 505 506 507 508 509
    my $self = shift;
    my $allowed_kind = \%{$self->{ALLOWED_KIND}};

    my $kind = shift;

    $$allowed_kind{$kind}++;
510 511
}

512
sub is_limited_type($$) {
513 514 515 516 517 518 519 520
    my $self = shift;
    my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};

    my $type = shift;

    return $$allowed_modules_limited{$type};
}

521
sub is_allowed_type_in_module($$) {
522 523 524 525 526
    my $self = shift;
    my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
    my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};

    my $type = shift;
Patrik Stridvall's avatar
Patrik Stridvall committed
527 528 529
    my @modules = split(/ \& /, shift);

    if(!$$allowed_modules_limited{$type}) { return 1; }
530

Patrik Stridvall's avatar
Patrik Stridvall committed
531 532 533 534 535
    foreach my $module (@modules) {
	if($$allowed_modules{$type}{$module}) { return 1; }
    }

    return 0;
536 537
}

538
sub allow_type_in_module($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
539 540 541 542 543 544 545 546 547 548 549
    my $self = shift;
    my $allowed_modules = \%{$self->{ALLOWED_MODULES}};

    my $type = shift;
    my @modules = split(/ \& /, shift);

    foreach my $module (@modules) {
	$$allowed_modules{$type}{$module}++;
    }
}

550
sub type_used_in_module($$) {
551 552 553 554
    my $self = shift;
    my $used_modules = \%{$self->{USED_MODULES}};

    my $type = shift;
Patrik Stridvall's avatar
Patrik Stridvall committed
555 556 557 558 559
    my @modules = split(/ \& /, shift);

    foreach my $module (@modules) {
	$$used_modules{$type}{$module} = 1;
    }
560 561 562 563

    return ();
}

564
sub types_not_used($) {
565 566 567 568 569 570 571 572 573 574 575 576 577 578 579
    my $self = shift;
    my $used_modules = \%{$self->{USED_MODULES}};
    my $allowed_modules = \%{$self->{ALLOWED_MODULES}};

    my $not_used;
    foreach my $type (sort(keys(%$allowed_modules))) {
	foreach my $module (sort(keys(%{$$allowed_modules{$type}}))) {
	    if(!$$used_modules{$type}{$module}) {
		$$not_used{$module}{$type} = 1;
	    }
	}
    }
    return $not_used;
}

580
sub types_unlimited_used_in_modules($) {
Patrik Stridvall's avatar
Patrik Stridvall committed
581 582 583 584 585 586 587 588 589 590 591 592 593 594
    my $self = shift;

    my $used_modules = \%{$self->{USED_MODULES}};
    my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
    my $allowed_modules_unlimited = \%{$self->{ALLOWED_MODULES_UNLIMITED}};

    my $used_types;
    foreach my $type (sort(keys(%$allowed_modules_unlimited))) {
	my $count = 0;
	my @modules = ();
	foreach my $module (sort(keys(%{$$used_modules{$type}}))) {
	    $count++;
	    push @modules, $module;
	}
595
        if($count) {
Patrik Stridvall's avatar
Patrik Stridvall committed
596 597 598 599 600 601 602 603
	    foreach my $module (@modules) {
	      $$used_types{$type}{$module} = 1;
	    }
	}
    }
    return $used_types;
}

604
sub translate_argument($$) {
605 606 607
    my $self = shift;
    my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};

Patrik Stridvall's avatar
Patrik Stridvall committed
608 609 610 611 612
    my $type = shift;

    return $$translate_argument{$type};
}

613
sub declare_argument($$$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
614 615 616 617 618
    my $self = shift;
    my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};

    my $type = shift;
    my $kind = shift;
619

Patrik Stridvall's avatar
Patrik Stridvall committed
620
    $$translate_argument{$type} = $kind;
621 622
}

623
sub all_declared_types($) {
624 625 626 627 628 629
    my $self = shift;
    my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};

    return sort(keys(%$translate_argument));
}

630
sub is_allowed_type_format($$$$) {
631 632 633 634 635 636 637 638 639 640 641 642
    my $self = shift;
    my $type_format = \%{$self->{TYPE_FORMAT}};

    my $module = shift;
    my $type = shift;
    my $format = shift;

    my $formats;

    if(defined($module) && defined($type)) {
	local $_;
	foreach (split(/ & /, $module)) {
643 644
	    if(defined($formats)) {
		$formats .= "|";
645 646
	    } else {
		$formats = "";
647
	    }
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665
	    if(defined($$type_format{$_}{$type})) {
		$formats .= $$type_format{$_}{$type};
	    }
	}
    }

    if(defined($formats)) {
	local $_;
	foreach (split(/\|/, $formats)) {
	    if($_ eq $format) {
		return 1;
	    }
	}
    }

    return 0;
}

666
sub all_modules($) {
Patrik Stridvall's avatar
Patrik Stridvall committed
667 668 669 670 671 672
    my $self = shift;
    my $modules = \%{$self->{MODULES}};

    return sort(keys(%$modules));
}

673
sub is_module($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
674 675 676 677 678 679 680 681
    my $self = shift;
    my $modules = \%{$self->{MODULES}};

    my $name = shift;

    return $$modules{$name};
}

682
sub module_file($$) {
683 684 685 686 687 688 689 690 691
    my $self = shift;

    my $module = shift;

    my $module_files = \%{$self->{MODULE_FILES}};

    return $$module_files{$module};
}

692
sub all_internal_functions($) {
693
    my $self = shift;
694
    my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
695

696
    return sort(keys(%$function_internal_calling_convention));
697 698
}

699
sub all_internal_functions_in_module($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
700
    my $self = shift;
701 702
    my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
    my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
Patrik Stridvall's avatar
Patrik Stridvall committed
703 704 705 706

    my $module = shift;

    my @names;
707 708
    foreach my $name (keys(%$function_internal_calling_convention)) {
	if($$function_internal_module{$name} eq $module) {
Patrik Stridvall's avatar
Patrik Stridvall committed
709 710 711 712 713 714 715
	    push @names, $name;
	}
    }

    return sort(@names);
}

716
sub all_external_functions($) {
717
    my $self = shift;
718
    my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
719

720
    return sort(keys(%$function_external_name));
721 722
}

723
sub all_external_functions_in_module($$) {
724
    my $self = shift;
725
    my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
726 727 728 729 730
    my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};

    my $module = shift;

    my @names;
731
    foreach my $name (keys(%$function_external_name)) {
732 733 734 735 736 737 738 739
	if($$function_external_module{$name} eq $module) {
	    push @names, $name;
	}
    }

    return sort(@names);
}

740
sub all_functions_in_module($$) {
741
    my $self = shift;
742
    my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
743

744 745 746
    my $module = shift;

    return sort(keys(%{$$module_external_calling_convention{$module}}));
747 748
}

749
sub all_broken_forwards($) {
750
    my $self = shift;
751
    my $function_forward = \%{$self->{FUNCTION_FORWARD}};
752

753 754 755 756
    my @broken_forwards = ();
    foreach my $module (sort(keys(%$function_forward))) {
	foreach my $external_name (sort(keys(%{$$function_forward{$module}}))) {
	    (my $forward_module, my $forward_external_name) = @{$$function_forward{$module}{$external_name}};
757

758 759 760 761 762 763 764 765 766
	    my $forward_external_calling_convention =
		$self->function_external_calling_convention_in_module($forward_module, $forward_external_name);

	    if(!defined($forward_external_calling_convention)) {
		push @broken_forwards, [$module, $external_name, $forward_module, $forward_external_name];
	    }
	}
    }
    return @broken_forwards;
767 768
}

769

770
sub function_internal_ordinal($$) {
771 772 773 774 775 776 777 778
    my $self = shift;
    my $function_internal_ordinal = \%{$self->{FUNCTION_INTERNAL_ORDINAL}};

    my $name = shift;

    return $$function_internal_ordinal{$name};
}

779
sub function_external_ordinal($$) {
780 781 782 783 784 785 786 787
    my $self = shift;
    my $function_external_ordinal = \%{$self->{FUNCTION_EXTERNAL_ORDINAL}};

    my $name = shift;

    return $$function_external_ordinal{$name};
}

788
sub function_internal_calling_convention($$) {
789
    my $self = shift;
790
    my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
791 792 793

    my $name = shift;

794
    return $$function_internal_calling_convention{$name};
795 796
}

797
sub function_external_calling_convention($$) {
798
    my $self = shift;
799
    my $function_external_calling_convention = \%{$self->{FUNCTION_EXTERNAL_CALLING_CONVENTION}};
800 801 802

    my $name = shift;

803
    return $$function_external_calling_convention{$name};
804 805
}

806
sub function_external_calling_convention_in_module($$$) {
807 808 809 810 811 812 813 814 815
    my $self = shift;
    my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};

    my $module = shift;
    my $name = shift;

    return $$module_external_calling_convention{$module}{$name};
}

816
sub function_internal_name($$) {
817 818 819 820 821 822 823 824
    my $self = shift;
    my $function_internal_name = \%{$self->{FUNCTION_INTERNAL_NAME}};

    my $name = shift;

    return $$function_internal_name{$name};
}

825
sub function_external_name($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
826 827 828 829 830 831 832 833
    my $self = shift;
    my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};

    my $name = shift;

    return $$function_external_name{$name};
}

834
sub function_forward_final_destination($$$) {
835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850
    my $self = shift;

    my $function_forward = \%{$self->{FUNCTION_FORWARD}};

    my $module = shift;
    my $name = shift;

    my $forward_module = $module;
    my $forward_name = $name;
    while(defined(my $forward = $$function_forward{$forward_module}{$forward_name})) {
	($forward_module, $forward_name) = @$forward;
    }

    return ($forward_module, $forward_name);
}

851
sub is_function($$) {
852
    my $self = shift;
853
    my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
854 855 856

    my $name = shift;

857
    return $$function_internal_calling_convention{$name};
858 859
}

860
sub all_shared_internal_functions($$) {
861 862 863 864 865 866
    my $self = shift;
    my $function_shared = \%{$self->{FUNCTION_SHARED}};

    return sort(keys(%$function_shared));
}

867
sub is_shared_internal_function($$) {
868 869 870 871 872 873 874 875
    my $self = shift;
    my $function_shared = \%{$self->{FUNCTION_SHARED}};

    my $name = shift;

    return $$function_shared{$name};
}

876
sub found_shared_internal_function($$) {
877 878 879 880 881 882 883 884
    my $self = shift;
    my $function_shared = \%{$self->{FUNCTION_SHARED}};

    my $name = shift;

    $$function_shared{$name} = 1;
}

885
sub function_internal_arguments($$) {
886 887 888 889 890 891 892 893
    my $self = shift;
    my $function_internal_arguments = \%{$self->{FUNCTION_INTERNAL_ARGUMENTS}};

    my $name = shift;

    return $$function_internal_arguments{$name};
}

894
sub function_external_arguments($$) {
895 896 897 898 899 900 901 902
    my $self = shift;
    my $function_external_arguments = \%{$self->{FUNCTION_EXTERNAL_ARGUMENTS}};

    my $name = shift;

    return $$function_external_arguments{$name};
}

903
sub function_internal_module($$) {
904
    my $self = shift;
905
    my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
906 907 908

    my $name = shift;

909
    return $$function_internal_module{$name};
910 911
}

912
sub function_external_module($$) {
913
    my $self = shift;
914
    my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};
915 916 917

    my $name = shift;

918
    return $$function_external_module{$name};
919 920
}

921
sub function_wine_extension($$$) {
922 923 924 925 926 927 928 929 930
    my $self = shift;
    my $function_wine_extension = \%{$self->{FUNCTION_WINE_EXTENSION}};

    my $module = shift;
    my $name = shift;

    return $$function_wine_extension{$module}{$name};
}

931
sub is_function_stub($$$) {
932
    my $self = shift;
933
    my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
934 935 936 937

    my $module = shift;
    my $name = shift;

Patrik Stridvall's avatar
Patrik Stridvall committed
938 939
    if($$module_external_calling_convention{$module}{$name} eq "stub") {
	return 1;
940 941 942 943
    }
    return 0;
}

944
sub is_function_stub_in_module($$$) {
945
    my $self = shift;
946
    my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
947

948
    my $module = shift;
949 950
    my $name = shift;

951 952 953 954
    if(!defined($$module_external_calling_convention{$module}{$name})) {
	return 0;
    }
    return $$module_external_calling_convention{$module}{$name} eq "stub";
955 956
}

957 958 959 960
########################################################################
# class methods
#

961
sub _get_all_module_internal_ordinal($$) {
962
    my $winapi = shift;
963 964 965
    my $internal_name = shift;

    my @entries = ();
966 967 968 969 970

    my @name = (); {
	my $name = $winapi->function_external_name($internal_name);
	if(defined($name)) {
	    @name = split(/ & /, $name);
971
	}
972 973 974 975 976 977
    }

    my @module = (); {
	my $module = $winapi->function_internal_module($internal_name);
	if(defined($module)) {
	    @module = split(/ & /, $module);
978
	}
979
    }
980

981 982 983 984
    my @ordinal = (); {
	my $ordinal = $winapi->function_internal_ordinal($internal_name);
	if(defined($ordinal)) {
	    @ordinal = split(/ & /, $ordinal);
985 986 987
	}
    }

988 989 990 991 992
    my $name;
    my $module;
    my $ordinal;
    while(defined($name = shift @name) &&
	  defined($module = shift @module) &&
993
	  defined($ordinal = shift @ordinal))
994 995 996 997
    {
	push @entries, [$name, $module, $ordinal];
    }

998 999 1000
    return @entries;
}

1001 1002
sub get_all_module_internal_ordinal16($) {
    return _get_all_module_internal_ordinal($win16api, $_[0]);
1003
}
1004

1005 1006
sub get_all_module_internal_ordinal32($) {
    return _get_all_module_internal_ordinal($win32api, $_[0]);
1007 1008
}

1009
sub get_all_module_internal_ordinal($) {
1010 1011
    my @entries = ();
    foreach my $winapi (@winapis) {
1012
	push @entries, _get_all_module_internal_ordinal($winapi, $_[0]);
1013 1014 1015 1016 1017
    }

    return @entries;
}

1018
sub _get_all_module_external_ordinal($$) {
1019 1020 1021 1022 1023 1024 1025 1026 1027
    my $winapi = shift;
    my $external_name = shift;

    my @entries = ();

    my @name = (); {
	my $name = $winapi->function_internal_name($external_name);
	if(defined($name)) {
	    @name = split(/ & /, $name);
1028
	}
1029 1030 1031 1032 1033 1034
    }

    my @module = (); {
	my $module = $winapi->function_external_module($external_name);
	if(defined($module)) {
	    @module = split(/ & /, $module);
1035
	}
1036
    }
1037

1038 1039 1040 1041
    my @ordinal = (); {
	my $ordinal = $winapi->function_external_ordinal($external_name);
	if(defined($ordinal)) {
	    @ordinal = split(/ & /, $ordinal);
1042 1043
	}
    }
1044

1045 1046 1047 1048 1049
    my $name;
    my $module;
    my $ordinal;
    while(defined($name = shift @name) &&
	  defined($module = shift @module) &&
1050
	  defined($ordinal = shift @ordinal))
1051 1052 1053
    {
	push @entries, [$name, $module, $ordinal];
    }
1054

1055 1056 1057
    return @entries;
}

1058 1059
sub get_all_module_external_ordinal16($) {
    return _get_all_module_external_ordinal($win16api, $_[0]);
1060 1061
}

1062 1063
sub get_all_module_external_ordinal32($) {
    return _get_all_module_external_ordinal($win32api, $_[0]);
1064 1065
}

1066
sub get_all_module_external_ordinal($) {
1067 1068
    my @entries = ();
    foreach my $winapi (@winapis) {
1069
	push @entries, _get_all_module_external_ordinal($winapi, $_[0]);
1070
    }
1071 1072 1073 1074

    return @entries;
}

1075
1;