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