git.oblomov.eu Git - wine/blob - tools/winapi_check/winapi.pm

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