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