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