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