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