tools/winapi/winapi.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   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.
   8 #
   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.
  13 #
  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
  17 #
  18
  19 package winapi;
  20
  21 use strict;
  22
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw();
  28 @EXPORT_OK = qw($win16api $win32api @winapis);
  29
  30 use vars qw($win16api $win32api @winapis);
  31
  32 use config qw($current_dir $wine_dir $winapi_dir);
  33 use options qw($options);
  34 use output qw($output);
  35
  36 use vars qw($modules);
  37
  38 sub found_shared_internal_function($$);
  39 sub function_external_calling_convention_in_module($$$);
  40 sub function_internal_module($$);
  41 sub is_function_stub_in_module($$$);
  42 sub new($$$);
  43 sub parse_api_file($$);
  44 sub parse_spec_file($$);
  45
  46 sub import(@) {
  47     $Exporter::ExportLevel++;
  48     Exporter::import(@_);
  49     $Exporter::ExportLevel--;
  50
  51     if (defined($modules) && defined($win16api) && defined($win32api)) {
  52         return;
  53     }
  54
  55     require modules;
  56     import modules qw($modules);
  57
  58     my @spec_files16 = $modules->allowed_spec_files16;
  59     $win16api = 'winapi'->new("win16", \@spec_files16);
  60
  61     my @spec_files32 = $modules->allowed_spec_files32;
  62     $win32api = 'winapi'->new("win32", \@spec_files32);
  63
  64     @winapis = ($win16api, $win32api);
  65
  66     for my $internal_name ($win32api->all_internal_functions) {
  67         my $module16 = $win16api->function_internal_module($internal_name);
  68         my $module32 = $win16api->function_internal_module($internal_name);
  69         if(defined($module16) &&
  70            !$win16api->is_function_stub_in_module($module16, $internal_name) &&
  71            !$win32api->is_function_stub_in_module($module32, $internal_name))
  72         {
  73             $win16api->found_shared_internal_function($internal_name);
  74             $win32api->found_shared_internal_function($internal_name);
  75         }
  76     }
  77 }
  78
  79
  80 sub new($$$) {
  81     my $proto = shift;
  82     my $class = ref($proto) || $proto;
  83     my $self  = {};
  84     bless ($self, $class);
  85
  86     my $name = \${$self->{NAME}};
  87     my $function_forward = \%{$self->{FUNCTION_FORWARD}};
  88     my $function_internal_name = \%{$self->{FUNCTION_INTERNAL_NAME}};
  89     my $function_module = \%{$self->{FUNCTION_MODULE}};
  90
  91     $$name = shift;
  92     my $refspec_files = shift;
  93
  94     foreach my $file (@$refspec_files) {
  95         $self->parse_spec_file("$wine_dir/$file");
  96     }
  97
  98     $self->parse_api_file("$$name.api");
  99
 100     foreach my $module (sort(keys(%$function_forward))) {
 101         foreach my $external_name (sort(keys(%{$$function_forward{$module}}))) {
 102             (my $forward_module, my $forward_external_name) = @{$$function_forward{$module}{$external_name}};
 103             my $forward_internal_name = $$function_internal_name{$forward_external_name};
 104             if(defined($forward_internal_name)) {
 105                 $$function_module{$forward_internal_name} .= " & $module";
 106             }
 107         }
 108     }
 109
 110     return $self;
 111 }
 112
 113 sub win16api() {
 114     return $win16api;
 115 }
 116
 117 sub win32api() {
 118     return $win32api;
 119 }
 120
 121 sub parse_api_file($$) {
 122     my $self = shift;
 123
 124     my $allowed_kind = \%{$self->{ALLOWED_KIND}};
 125     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 126     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
 127     my $allowed_modules_unlimited = \%{$self->{ALLOWED_MODULES_UNLIMITED}};
 128     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 129     my $type_format = \%{$self->{TYPE_FORMAT}};
 130
 131     my $file = shift;
 132
 133     my $module;
 134     my $kind;
 135     my $format;
 136     my $forbidden = 0;
 137
 138     $output->lazy_progress("$file");
 139
 140     open(IN, "< $winapi_dir/$file") || die "$winapi_dir/$file: $!\n";
 141     $/ = "\n";
 142     while(<IN>) {
 143         s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begin and end of line
 144         s/^(.*?)\s*#.*$/$1/;  # remove comments
 145         /^$/ && next;         # skip empty lines
 146
 147         if(/^%%(\S+)$/) {
 148             $module = $1;
 149             $module =~ s/\.dll$//; # FIXME: Kludge
 150         } elsif(!$modules->is_allowed_module($module)) {
 151             # Nothing
 152         } elsif(s/^%(\S+)\s*//) {
 153             $kind = $1;
 154             $format = undef;
 155             $forbidden = 0;
 156
 157             $$allowed_kind{$kind} = 1;
 158             if(/^--forbidden/) {
 159                 $forbidden = 1;
 160             } elsif(/^--format=(\".*?\"|\S*)/) {
 161                 $format = $1;
 162                 $format =~ s/^\"(.*?)\"$/$1/;
 163             }
 164
 165             if(!defined($format)) {
 166                 if($kind eq "long") {
 167                     $format  = "%d|%u|%x|%X|";
 168                     $format .= "%hd|%hu|%hx|%hX|";
 169                     $format .= "%ld|%lu|%lx|%lX|";
 170                     $format .= "%04x|%04X|0x%04x|0x%04X|";
 171                     $format .= "%08x|%08X|0x%08x|0x%08X|";
 172                     $format .= "%08lx|%08lX|0x%08lx|0x%08lX";
 173                 } elsif($kind eq "longlong") {
 174                     $format = "%lld";
 175                 } elsif($kind eq "ptr") {
 176                     $format = "%p";
 177                 } elsif($kind eq "segptr") {
 178                     $format = "%p";
 179                 } elsif($kind eq "str") {
 180                     $format = "%p|%s";
 181                 } elsif($kind eq "wstr") {
 182                     $format = "%p|%s";
 183                 } elsif($kind eq "word") {
 184                     $format  = "%d|%u|%x|%X|";
 185                     $format .= "%hd|%hu|%hx|%hX|";
 186                     $format .= "%04x|%04X|0x%04x|0x%04X";
 187                 } else {
 188                     $format = "<unknown>";
 189                 }
 190             }
 191         } elsif(defined($kind)) {
 192             my $type = $_;
 193             if(!$forbidden) {
 194                 if(defined($module)) {
 195                     if($$allowed_modules_unlimited{$type}) {
 196                         $output->write("$file: type ($type) already specified as an unlimited type\n");
 197                     } elsif(!$$allowed_modules{$type}{$module}) {
 198                         $$allowed_modules{$type}{$module} = 1;
 199                         $$allowed_modules_limited{$type} = 1;
 200                     } else {
 201                         $output->write("$file: type ($type) already specified\n");
 202                     }
 203                 } else {
 204                     $$allowed_modules_unlimited{$type} = 1;
 205                 }
 206             } else {
 207                 $$allowed_modules_limited{$type} = 1;
 208             }
 209             if(defined($$translate_argument{$type}) && $$translate_argument{$type} ne $kind) {
 210                 $output->write("$file: type ($type) respecified as different kind ($kind != $$translate_argument{$type})\n");
 211             } else {
 212                 $$translate_argument{$type} = $kind;
 213             }
 214
 215             $$type_format{$module}{$type} = $format;
 216         } else {
 217             $output->write("$file: file must begin with %<type> statement\n");
 218             exit 1;
 219         }
 220     }
 221     close(IN);
 222 }
 223
 224 sub parse_spec_file($$) {
 225     my $self = shift;
 226
 227     my $function_internal_arguments = \%{$self->{FUNCTION_INTERNAL_ARGUMENTS}};
 228     my $function_external_arguments = \%{$self->{FUNCTION_EXTERNAL_ARGUMENTS}};
 229     my $function_internal_ordinal = \%{$self->{FUNCTION_INTERNAL_ORDINAL}};
 230     my $function_external_ordinal = \%{$self->{FUNCTION_EXTERNAL_ORDINAL}};
 231     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 232     my $function_external_calling_convention = \%{$self->{FUNCTION_EXTERNAL_CALLING_CONVENTION}};
 233     my $function_internal_name = \%{$self->{FUNCTION_INTERNAL_NAME}};
 234     my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
 235     my $function_forward = \%{$self->{FUNCTION_FORWARD}};
 236     my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
 237     my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};
 238     my $function_wine_extension = \%{$self->{FUNCTION_WINE_EXTENSION}};
 239     my $modules = \%{$self->{MODULES}};
 240     my $module_files = \%{$self->{MODULE_FILES}};
 241     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 242
 243     my $file = shift;
 244     $file =~ s%^\./%%;
 245
 246     my %ordinals;
 247     my $module;
 248     my $wine_extension = 0;
 249
 250     $output->lazy_progress("$file");
 251
 252     $module = $file;
 253     $module =~ s/^.*?([^\/]*)\.spec$/$1/;
 254
 255     open(IN, "< $file") || die "$file: $!\n";
 256     $/ = "\n";
 257     my $header = 1;
 258     my $lookahead = 0;
 259     while($lookahead || defined($_ = <IN>)) {
 260         $lookahead = 0;
 261         s/^\s*(.*?)\s*$/$1/;
 262         if(s/^(.*?)\s*\#\s*(.*)\s*$/$1/) {
 263             my $comment = $2;
 264             if ($comment =~ /^Wine/i) { # FIXME: Kludge
 265                 $wine_extension = 1;
 266             }
 267         }
 268         /^$/ && next;
 269
 270         if($header)  {
 271             if(/^\d+|@/) { $header = 0; $lookahead = 1; }
 272             next;
 273         }
 274
 275         my $ordinal;
 276         if(/^(\d+|@)\s+
 277            (pascal|stdcall|cdecl|varargs)\s+
 278            ((?:(?:-noname|-norelay|-i386|-ret16|-ret64|-register|-interrupt|-private)\s+)*)(\S+)\s*\(\s*(.*?)\s*\)\s*(\S*)$/x)
 279         {
 280             my $calling_convention = $2;
 281             my $flags = $3;
 282             my $external_name = $4;
 283             my $arguments = $5;
 284             my $internal_name = $6;
 285
 286             $ordinal = $1;
 287
 288             $flags =~ s/\s+/ /g;
 289
 290             $internal_name = $external_name if !$internal_name;
 291
 292             if($flags =~ /-noname/) {
 293                 # $external_name = "@";
 294             }
 295
 296             if($flags =~ /(?:-register|-interrupt)/) {
 297                 if($arguments) { $arguments .= " "; }
 298                 $arguments .= "ptr";
 299                 $calling_convention .= " -register";
 300             }
 301
 302             if ($internal_name =~ /^(.*?)\.(.*?)$/) {
 303                 my $forward_module = lc($1);
 304                 my $forward_name = $2;
 305
 306                 if (0) {
 307                     $calling_convention .= " -forward";
 308                 } else {
 309                     $calling_convention = "forward";
 310                 }
 311
 312                 $$function_forward{$module}{$external_name} = [$forward_module, $forward_name];
 313             }
 314
 315             if($external_name ne "@") {
 316                 $$module_external_calling_convention{$module}{$external_name} = $calling_convention;
 317             } else {
 318                 $$module_external_calling_convention{$module}{"\@$ordinal"} = $calling_convention;
 319             }
 320             if(!$$function_internal_name{$external_name}) {
 321                 $$function_internal_name{$external_name} = $internal_name;
 322             } else {
 323                 $$function_internal_name{$external_name} .= " & $internal_name";
 324             }
 325             if(!$$function_external_name{$internal_name}) {
 326                 $$function_external_name{$internal_name} = $external_name;
 327             } else {
 328                 $$function_external_name{$internal_name} .= " & $external_name";
 329             }
 330             $$function_internal_arguments{$internal_name} = $arguments;
 331             $$function_external_arguments{$external_name} = $arguments;
 332             if(!$$function_internal_ordinal{$internal_name}) {
 333                 $$function_internal_ordinal{$internal_name} = $ordinal;
 334             } else {
 335                 $$function_internal_ordinal{$internal_name} .= " & $ordinal";
 336             }
 337             if(!$$function_external_ordinal{$external_name}) {
 338                 $$function_external_ordinal{$external_name} = $ordinal;
 339             } else {
 340                 $$function_external_ordinal{$external_name} .= " & $ordinal";
 341             }
 342             $$function_internal_calling_convention{$internal_name} = $calling_convention;
 343             $$function_external_calling_convention{$external_name} = $calling_convention;
 344             if(!$$function_internal_module{$internal_name}) {
 345                 $$function_internal_module{$internal_name} = "$module";
 346             } else {
 347                 $$function_internal_module{$internal_name} .= " & $module";
 348             }
 349             if(!$$function_external_module{$external_name}) {
 350                 $$function_external_module{$external_name} = "$module";
 351             } else {
 352                 $$function_external_module{$external_name} .= " & $module";
 353             }
 354             $$function_wine_extension{$module}{$external_name} = $wine_extension;
 355
 356             if(0 && $options->spec_mismatch) {
 357                 if($external_name eq "@") {
 358                     if($internal_name !~ /^\U$module\E_$ordinal$/) {
 359                         $output->write("$file: $external_name: the internal name ($internal_name) mismatch\n");
 360                     }
 361                 } else {
 362                     my $name = $external_name;
 363
 364                     my $name1 = $name;
 365                     $name1 =~ s/^Zw/Nt/;
 366
 367                     my $name2 = $name;
 368                     $name2 =~ s/^(?:_|Rtl|k32|K32)//;
 369
 370                     my $name3 = $name;
 371                     $name3 =~ s/^INT_Int[0-9a-f]{2}Handler$/BUILTIN_DefaultIntHandler/;
 372
 373                     my $name4 = $name;
 374                     $name4 =~ s/^(VxDCall)\d$/$1/;
 375
 376                     # FIXME: This special case is becuase of a very ugly kludge that should be fixed IMHO
 377                     my $name5 = $name;
 378                     $name5 =~ s/^(.*?16)_(.*?)$/$1_fn$2/;
 379
 380                     if(uc($internal_name) ne uc($external_name) &&
 381                        $internal_name !~ /(\Q$name\E|\Q$name1\E|\Q$name2\E|\Q$name3\E|\Q$name4\E|\Q$name5\E)/)
 382                     {
 383                         $output->write("$file: $external_name: internal name ($internal_name) mismatch\n");
 384                     }
 385                 }
 386             }
 387         } elsif(/^(\d+|@)\s+stub(?:\s+(-noname|-norelay|-i386|-ret16|-ret64|-private))?\s+(\S+)$/) {
 388             $ordinal = $1;
 389
 390             my $flags = $2;
 391             my $external_name = $3;
 392
 393             $flags = "" if !defined($flags);
 394
 395             if($flags =~ /-noname/) {
 396                 # $external_name = "@";
 397             }
 398
 399             my $internal_name = $external_name;
 400
 401             if ($external_name ne "@") {
 402                 $$module_external_calling_convention{$module}{$external_name} = "stub";
 403             } else {
 404                 $$module_external_calling_convention{$module}{"\@$ordinal"} = "stub";
 405             }
 406             if(!$$function_internal_name{$external_name}) {
 407                 $$function_internal_name{$external_name} = $internal_name;
 408             } else {
 409                 $$function_internal_name{$external_name} .= " & $internal_name";
 410             }
 411             if(!$$function_external_name{$internal_name}) {
 412                 $$function_external_name{$internal_name} = $external_name;
 413             } else {
 414                 $$function_external_name{$internal_name} .= " & $external_name";
 415             }
 416             if(!$$function_internal_ordinal{$internal_name}) {
 417                 $$function_internal_ordinal{$internal_name} = $ordinal;
 418             } else {
 419                 $$function_internal_ordinal{$internal_name} .= " & $ordinal";
 420             }
 421             if(!$$function_external_ordinal{$external_name}) {
 422                 $$function_external_ordinal{$external_name} = $ordinal;
 423             } else {
 424                 $$function_external_ordinal{$external_name} .= " & $ordinal";
 425             }
 426             if(!$$function_internal_module{$internal_name}) {
 427                 $$function_internal_module{$internal_name} = "$module";
 428             } else { # if($$function_internal_module{$internal_name} !~ /$module/) {
 429                 $$function_internal_module{$internal_name} .= " & $module";
 430             }
 431             if(!$$function_external_module{$external_name}) {
 432                 $$function_external_module{$external_name} = "$module";
 433             } else { # if($$function_external_module{$external_name} !~ /$module/) {
 434                 $$function_external_module{$external_name} .= " & $module";
 435             }
 436         } elsif(/^(\d+|@)\s+extern(?:\s+(?:-norelay|-i386|-ret16|-ret64))?\s+(\S+)\s*(\S*)$/) {
 437             $ordinal = $1;
 438
 439             my $external_name = $2;
 440             my $internal_name = $3;
 441
 442             $internal_name = $external_name if !$internal_name;
 443
 444             if ($external_name ne "@") {
 445                 $$module_external_calling_convention{$module}{$external_name} = "extern";
 446             } else {
 447                 $$module_external_calling_convention{$module}{"\@$ordinal"} = "extern";
 448             }
 449         } elsif(/^(?:\d+|@)\s+(?:equate|variable)/) {
 450             # ignore
 451         } else {
 452             my $next_line = <IN>;
 453             if(!defined($next_line) || $next_line =~ /^\s*\d|@/) {
 454                 die "$file: $.: syntax error: '$_'\n";
 455             } else {
 456                 $_ .= $next_line;
 457                 $lookahead = 1;
 458             }
 459         }
 460
 461         if(defined($ordinal)) {
 462             if($ordinal ne "@" && $ordinals{$ordinal}) {
 463                 $output->write("$file: ordinal redefined: $_\n");
 464             }
 465             $ordinals{$ordinal}++;
 466         }
 467     }
 468     close(IN);
 469
 470     $$modules{$module}++;
 471
 472     $$module_files{$module} = $file;
 473 }
 474
 475 sub name($) {
 476     my $self = shift;
 477     my $name = \${$self->{NAME}};
 478
 479     return $$name;
 480 }
 481
 482 sub is_allowed_kind($$) {
 483     my $self = shift;
 484     my $allowed_kind = \%{$self->{ALLOWED_KIND}};
 485
 486     my $kind = shift;
 487     if(defined($kind)) {
 488         return $$allowed_kind{$kind};
 489     } else {
 490         return 0;
 491     }
 492
 493 }
 494
 495 sub allow_kind($$) {
 496     my $self = shift;
 497     my $allowed_kind = \%{$self->{ALLOWED_KIND}};
 498
 499     my $kind = shift;
 500
 501     $$allowed_kind{$kind}++;
 502 }
 503
 504 sub is_limited_type($$) {
 505     my $self = shift;
 506     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
 507
 508     my $type = shift;
 509
 510     return $$allowed_modules_limited{$type};
 511 }
 512
 513 sub is_allowed_type_in_module($$) {
 514     my $self = shift;
 515     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 516     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
 517
 518     my $type = shift;
 519     my @modules = split(/ \& /, shift);
 520
 521     if(!$$allowed_modules_limited{$type}) { return 1; }
 522
 523     foreach my $module (@modules) {
 524         if($$allowed_modules{$type}{$module}) { return 1; }
 525     }
 526
 527     return 0;
 528 }
 529
 530 sub allow_type_in_module($$) {
 531     my $self = shift;
 532     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 533
 534     my $type = shift;
 535     my @modules = split(/ \& /, shift);
 536
 537     foreach my $module (@modules) {
 538         $$allowed_modules{$type}{$module}++;
 539     }
 540 }
 541
 542 sub type_used_in_module($$) {
 543     my $self = shift;
 544     my $used_modules = \%{$self->{USED_MODULES}};
 545
 546     my $type = shift;
 547     my @modules = split(/ \& /, shift);
 548
 549     foreach my $module (@modules) {
 550         $$used_modules{$type}{$module} = 1;
 551     }
 552
 553     return ();
 554 }
 555
 556 sub types_not_used($) {
 557     my $self = shift;
 558     my $used_modules = \%{$self->{USED_MODULES}};
 559     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 560
 561     my $not_used;
 562     foreach my $type (sort(keys(%$allowed_modules))) {
 563         foreach my $module (sort(keys(%{$$allowed_modules{$type}}))) {
 564             if(!$$used_modules{$type}{$module}) {
 565                 $$not_used{$module}{$type} = 1;
 566             }
 567         }
 568     }
 569     return $not_used;
 570 }
 571
 572 sub types_unlimited_used_in_modules($) {
 573     my $self = shift;
 574
 575     my $used_modules = \%{$self->{USED_MODULES}};
 576     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 577     my $allowed_modules_unlimited = \%{$self->{ALLOWED_MODULES_UNLIMITED}};
 578
 579     my $used_types;
 580     foreach my $type (sort(keys(%$allowed_modules_unlimited))) {
 581         my $count = 0;
 582         my @modules = ();
 583         foreach my $module (sort(keys(%{$$used_modules{$type}}))) {
 584             $count++;
 585             push @modules, $module;
 586         }
 587         if($count) {
 588             foreach my $module (@modules) {
 589               $$used_types{$type}{$module} = 1;
 590             }
 591         }
 592     }
 593     return $used_types;
 594 }
 595
 596 sub translate_argument($$) {
 597     my $self = shift;
 598     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 599
 600     my $type = shift;
 601
 602     return $$translate_argument{$type};
 603 }
 604
 605 sub declare_argument($$$) {
 606     my $self = shift;
 607     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 608
 609     my $type = shift;
 610     my $kind = shift;
 611
 612     $$translate_argument{$type} = $kind;
 613 }
 614
 615 sub all_declared_types($) {
 616     my $self = shift;
 617     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 618
 619     return sort(keys(%$translate_argument));
 620 }
 621
 622 sub is_allowed_type_format($$$$) {
 623     my $self = shift;
 624     my $type_format = \%{$self->{TYPE_FORMAT}};
 625
 626     my $module = shift;
 627     my $type = shift;
 628     my $format = shift;
 629
 630     my $formats;
 631
 632     if(defined($module) && defined($type)) {
 633         local $_;
 634         foreach (split(/ & /, $module)) {
 635             if(defined($formats)) {
 636                 $formats .= "|";
 637             } else {
 638                 $formats = "";
 639             }
 640             if(defined($$type_format{$_}{$type})) {
 641                 $formats .= $$type_format{$_}{$type};
 642             }
 643         }
 644     }
 645
 646     if(defined($formats)) {
 647         local $_;
 648         foreach (split(/\|/, $formats)) {
 649             if($_ eq $format) {
 650                 return 1;
 651             }
 652         }
 653     }
 654
 655     return 0;
 656 }
 657
 658 sub all_modules($) {
 659     my $self = shift;
 660     my $modules = \%{$self->{MODULES}};
 661
 662     return sort(keys(%$modules));
 663 }
 664
 665 sub is_module($$) {
 666     my $self = shift;
 667     my $modules = \%{$self->{MODULES}};
 668
 669     my $name = shift;
 670
 671     return $$modules{$name};
 672 }
 673
 674 sub module_file($$) {
 675     my $self = shift;
 676
 677     my $module = shift;
 678
 679     my $module_files = \%{$self->{MODULE_FILES}};
 680
 681     return $$module_files{$module};
 682 }
 683
 684 sub all_internal_functions($) {
 685     my $self = shift;
 686     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 687
 688     return sort(keys(%$function_internal_calling_convention));
 689 }
 690
 691 sub all_internal_functions_in_module($$) {
 692     my $self = shift;
 693     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 694     my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
 695
 696     my $module = shift;
 697
 698     my @names;
 699     foreach my $name (keys(%$function_internal_calling_convention)) {
 700         if($$function_internal_module{$name} eq $module) {
 701             push @names, $name;
 702         }
 703     }
 704
 705     return sort(@names);
 706 }
 707
 708 sub all_external_functions($) {
 709     my $self = shift;
 710     my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
 711
 712     return sort(keys(%$function_external_name));
 713 }
 714
 715 sub all_external_functions_in_module($$) {
 716     my $self = shift;
 717     my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
 718     my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};
 719
 720     my $module = shift;
 721
 722     my @names;
 723     foreach my $name (keys(%$function_external_name)) {
 724         if($$function_external_module{$name} eq $module) {
 725             push @names, $name;
 726         }
 727     }
 728
 729     return sort(@names);
 730 }
 731
 732 sub all_functions_in_module($$) {
 733     my $self = shift;
 734     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 735
 736     my $module = shift;
 737
 738     return sort(keys(%{$$module_external_calling_convention{$module}}));
 739 }
 740
 741 sub all_broken_forwards($) {
 742     my $self = shift;
 743     my $function_forward = \%{$self->{FUNCTION_FORWARD}};
 744
 745     my @broken_forwards = ();
 746     foreach my $module (sort(keys(%$function_forward))) {
 747         foreach my $external_name (sort(keys(%{$$function_forward{$module}}))) {
 748             (my $forward_module, my $forward_external_name) = @{$$function_forward{$module}{$external_name}};
 749
 750             my $forward_external_calling_convention =
 751                 $self->function_external_calling_convention_in_module($forward_module, $forward_external_name);
 752
 753             if(!defined($forward_external_calling_convention)) {
 754                 push @broken_forwards, [$module, $external_name, $forward_module, $forward_external_name];
 755             }
 756         }
 757     }
 758     return @broken_forwards;
 759 }
 760
 761
 762 sub function_internal_ordinal($$) {
 763     my $self = shift;
 764     my $function_internal_ordinal = \%{$self->{FUNCTION_INTERNAL_ORDINAL}};
 765
 766     my $name = shift;
 767
 768     return $$function_internal_ordinal{$name};
 769 }
 770
 771 sub function_external_ordinal($$) {
 772     my $self = shift;
 773     my $function_external_ordinal = \%{$self->{FUNCTION_EXTERNAL_ORDINAL}};
 774
 775     my $name = shift;
 776
 777     return $$function_external_ordinal{$name};
 778 }
 779
 780 sub function_internal_calling_convention($$) {
 781     my $self = shift;
 782     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 783
 784     my $name = shift;
 785
 786     return $$function_internal_calling_convention{$name};
 787 }
 788
 789 sub function_external_calling_convention($$) {
 790     my $self = shift;
 791     my $function_external_calling_convention = \%{$self->{FUNCTION_EXTERNAL_CALLING_CONVENTION}};
 792
 793     my $name = shift;
 794
 795     return $$function_external_calling_convention{$name};
 796 }
 797
 798 sub function_external_calling_convention_in_module($$$) {
 799     my $self = shift;
 800     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 801
 802     my $module = shift;
 803     my $name = shift;
 804
 805     return $$module_external_calling_convention{$module}{$name};
 806 }
 807
 808 sub function_internal_name($$) {
 809     my $self = shift;
 810     my $function_internal_name = \%{$self->{FUNCTION_INTERNAL_NAME}};
 811
 812     my $name = shift;
 813
 814     return $$function_internal_name{$name};
 815 }
 816
 817 sub function_external_name($$) {
 818     my $self = shift;
 819     my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
 820
 821     my $name = shift;
 822
 823     return $$function_external_name{$name};
 824 }
 825
 826 sub function_forward_final_destination($$$) {
 827     my $self = shift;
 828
 829     my $function_forward = \%{$self->{FUNCTION_FORWARD}};
 830
 831     my $module = shift;
 832     my $name = shift;
 833
 834     my $forward_module = $module;
 835     my $forward_name = $name;
 836     while(defined(my $forward = $$function_forward{$forward_module}{$forward_name})) {
 837         ($forward_module, $forward_name) = @$forward;
 838     }
 839
 840     return ($forward_module, $forward_name);
 841 }
 842
 843 sub is_function($$) {
 844     my $self = shift;
 845     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 846
 847     my $name = shift;
 848
 849     return $$function_internal_calling_convention{$name};
 850 }
 851
 852 sub all_shared_internal_functions($$) {
 853     my $self = shift;
 854     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 855
 856     return sort(keys(%$function_shared));
 857 }
 858
 859 sub is_shared_internal_function($$) {
 860     my $self = shift;
 861     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 862
 863     my $name = shift;
 864
 865     return $$function_shared{$name};
 866 }
 867
 868 sub found_shared_internal_function($$) {
 869     my $self = shift;
 870     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 871
 872     my $name = shift;
 873
 874     $$function_shared{$name} = 1;
 875 }
 876
 877 sub function_internal_arguments($$) {
 878     my $self = shift;
 879     my $function_internal_arguments = \%{$self->{FUNCTION_INTERNAL_ARGUMENTS}};
 880
 881     my $name = shift;
 882
 883     return $$function_internal_arguments{$name};
 884 }
 885
 886 sub function_external_arguments($$) {
 887     my $self = shift;
 888     my $function_external_arguments = \%{$self->{FUNCTION_EXTERNAL_ARGUMENTS}};
 889
 890     my $name = shift;
 891
 892     return $$function_external_arguments{$name};
 893 }
 894
 895 sub function_internal_module($$) {
 896     my $self = shift;
 897     my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
 898
 899     my $name = shift;
 900
 901     return $$function_internal_module{$name};
 902 }
 903
 904 sub function_external_module($$) {
 905     my $self = shift;
 906     my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};
 907
 908     my $name = shift;
 909
 910     return $$function_external_module{$name};
 911 }
 912
 913 sub function_wine_extension($$$) {
 914     my $self = shift;
 915     my $function_wine_extension = \%{$self->{FUNCTION_WINE_EXTENSION}};
 916
 917     my $module = shift;
 918     my $name = shift;
 919
 920     return $$function_wine_extension{$module}{$name};
 921 }
 922
 923 sub is_function_stub($$$) {
 924     my $self = shift;
 925     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 926
 927     my $module = shift;
 928     my $name = shift;
 929
 930     if($$module_external_calling_convention{$module}{$name} eq "stub") {
 931         return 1;
 932     }
 933     return 0;
 934 }
 935
 936 sub is_function_stub_in_module($$$) {
 937     my $self = shift;
 938     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 939
 940     my $module = shift;
 941     my $name = shift;
 942
 943     if(!defined($$module_external_calling_convention{$module}{$name})) {
 944         return 0;
 945     }
 946     return $$module_external_calling_convention{$module}{$name} eq "stub";
 947 }
 948
 949 ########################################################################
 950 # class methods
 951 #
 952
 953 sub _get_all_module_internal_ordinal($$) {
 954     my $winapi = shift;
 955     my $internal_name = shift;
 956
 957     my @entries = ();
 958
 959     my @name = (); {
 960         my $name = $winapi->function_external_name($internal_name);
 961         if(defined($name)) {
 962             @name = split(/ & /, $name);
 963         }
 964     }
 965
 966     my @module = (); {
 967         my $module = $winapi->function_internal_module($internal_name);
 968         if(defined($module)) {
 969             @module = split(/ & /, $module);
 970         }
 971     }
 972
 973     my @ordinal = (); {
 974         my $ordinal = $winapi->function_internal_ordinal($internal_name);
 975         if(defined($ordinal)) {
 976             @ordinal = split(/ & /, $ordinal);
 977         }
 978     }
 979
 980     my $name;
 981     my $module;
 982     my $ordinal;
 983     while(defined($name = shift @name) &&
 984           defined($module = shift @module) &&
 985           defined($ordinal = shift @ordinal))
 986     {
 987         push @entries, [$name, $module, $ordinal];
 988     }
 989
 990     return @entries;
 991 }
 992
 993 sub get_all_module_internal_ordinal16($) {
 994     return _get_all_module_internal_ordinal($win16api, $_[0]);
 995 }
 996
 997 sub get_all_module_internal_ordinal32($) {
 998     return _get_all_module_internal_ordinal($win32api, $_[0]);
 999 }
1000
1001 sub get_all_module_internal_ordinal($) {
1002     my @entries = ();
1003     foreach my $winapi (@winapis) {
1004         push @entries, _get_all_module_internal_ordinal($winapi, $_[0]);
1005     }
1006
1007     return @entries;
1008 }
1009
1010 sub _get_all_module_external_ordinal($$) {
1011     my $winapi = shift;
1012     my $external_name = shift;
1013
1014     my @entries = ();
1015
1016     my @name = (); {
1017         my $name = $winapi->function_internal_name($external_name);
1018         if(defined($name)) {
1019             @name = split(/ & /, $name);
1020         }
1021     }
1022
1023     my @module = (); {
1024         my $module = $winapi->function_external_module($external_name);
1025         if(defined($module)) {
1026             @module = split(/ & /, $module);
1027         }
1028     }
1029
1030     my @ordinal = (); {
1031         my $ordinal = $winapi->function_external_ordinal($external_name);
1032         if(defined($ordinal)) {
1033             @ordinal = split(/ & /, $ordinal);
1034         }
1035     }
1036
1037     my $name;
1038     my $module;
1039     my $ordinal;
1040     while(defined($name = shift @name) &&
1041           defined($module = shift @module) &&
1042           defined($ordinal = shift @ordinal))
1043     {
1044         push @entries, [$name, $module, $ordinal];
1045     }
1046
1047     return @entries;
1048 }
1049
1050 sub get_all_module_external_ordinal16($) {
1051     return _get_all_module_external_ordinal($win16api, $_[0]);
1052 }
1053
1054 sub get_all_module_external_ordinal32($) {
1055     return _get_all_module_external_ordinal($win32api, $_[0]);
1056 }
1057
1058 sub get_all_module_external_ordinal($) {
1059     my @entries = ();
1060     foreach my $winapi (@winapis) {
1061         push @entries, _get_all_module_external_ordinal($winapi, $_[0]);
1062     }
1063
1064     return @entries;
1065 }
1066
1067 1;