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

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