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