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|-noname|-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 =~ /-noname/) {
 266                 # $external_name = "@";
 267             }
 268
 269             if($flags =~ /(?:-register|-interrupt)/) {
 270                 if($arguments) { $arguments .= " "; }
 271                 $arguments .= "ptr";
 272             }
 273
 274             if($external_name ne "@") {
 275                 $$module_external_calling_convention{$module}{$external_name} = $calling_convention;
 276             } else {
 277                 $$module_external_calling_convention{$module}{"\@$ordinal"} = $calling_convention;
 278             }
 279             if(!$$function_internal_name{$external_name}) {
 280                 $$function_internal_name{$external_name} = $internal_name;
 281             } else {
 282                 $$function_internal_name{$external_name} .= " & $internal_name";
 283             }
 284             if(!$$function_external_name{$internal_name}) {
 285                 $$function_external_name{$internal_name} = $external_name;
 286             } else {
 287                 $$function_external_name{$internal_name} .= " & $external_name";
 288             }
 289             $$function_internal_arguments{$internal_name} = $arguments;
 290             $$function_external_arguments{$external_name} = $arguments;
 291             if(!$$function_internal_ordinal{$internal_name}) {
 292                 $$function_internal_ordinal{$internal_name} = $ordinal;
 293             } else {
 294                 $$function_internal_ordinal{$internal_name} .= " & $ordinal";
 295             }
 296             if(!$$function_external_ordinal{$external_name}) {
 297                 $$function_external_ordinal{$external_name} = $ordinal;
 298             } else {
 299                 $$function_external_ordinal{$external_name} .= " & $ordinal";
 300             }
 301             $$function_internal_calling_convention{$internal_name} = $calling_convention;
 302             $$function_external_calling_convention{$external_name} = $calling_convention;
 303             if(!$$function_internal_module{$internal_name}) {
 304                 $$function_internal_module{$internal_name} = "$module";
 305             } else {
 306                 $$function_internal_module{$internal_name} .= " & $module";
 307             }
 308             if(!$$function_external_module{$external_name}) {
 309                 $$function_external_module{$external_name} = "$module";
 310             } else {
 311                 $$function_external_module{$external_name} .= " & $module";
 312             }
 313
 314             if(0 && $options->spec_mismatch) {
 315                 if($external_name eq "@") {
 316                     if($internal_name !~ /^\U$module\E_$ordinal$/) {
 317                         $output->write("$file: $external_name: the internal name ($internal_name) mismatch\n");
 318                     }
 319                 } else {
 320                     my $name = $external_name;
 321
 322                     my $name1 = $name;
 323                     $name1 =~ s/^Zw/Nt/;
 324
 325                     my $name2 = $name;
 326                     $name2 =~ s/^(?:_|Rtl|k32|K32)//;
 327
 328                     my $name3 = $name;
 329                     $name3 =~ s/^INT_Int[0-9a-f]{2}Handler$/BUILTIN_DefaultIntHandler/;
 330
 331                     my $name4 = $name;
 332                     $name4 =~ s/^(VxDCall)\d$/$1/;
 333
 334                     # FIXME: This special case is becuase of a very ugly kludge that should be fixed IMHO
 335                     my $name5 = $name;
 336                     $name5 =~ s/^(.*?16)_(.*?)$/$1_fn$2/;
 337
 338                     if(uc($internal_name) ne uc($external_name) &&
 339                        $internal_name !~ /(\Q$name\E|\Q$name1\E|\Q$name2\E|\Q$name3\E|\Q$name4\E|\Q$name5\E)/)
 340                     {
 341                         $output->write("$file: $external_name: internal name ($internal_name) mismatch\n");
 342                     }
 343                 }
 344             }
 345         } elsif(/^(\d+|@)\s+stub(?:\s+(-noimport|-noname|-norelay|-i386|-ret64))?\s+(\S+)$/) {
 346             $ordinal = $1;
 347
 348             my $flags = $2;
 349             my $external_name = $3;
 350
 351             $flags = "" if !defined($flags);
 352
 353             if($flags =~ /-noname/) {
 354                 # $external_name = "@";
 355             }
 356
 357             my $internal_name = $external_name;
 358
 359             if ($external_name ne "@") {
 360                 $$module_external_calling_convention{$module}{$external_name} = "stub";
 361             } else {
 362                 $$module_external_calling_convention{$module}{"\@$ordinal"} = "stub";
 363             }
 364             if(!$$function_internal_name{$external_name}) {
 365                 $$function_internal_name{$external_name} = $internal_name;
 366             } else {
 367                 $$function_internal_name{$external_name} .= " & $internal_name";
 368             }
 369             if(!$$function_external_name{$internal_name}) {
 370                 $$function_external_name{$internal_name} = $external_name;
 371             } else {
 372                 $$function_external_name{$internal_name} .= " & $external_name";
 373             }
 374             if(!$$function_internal_ordinal{$internal_name}) {
 375                 $$function_internal_ordinal{$internal_name} = $ordinal;
 376             } else {
 377                 $$function_internal_ordinal{$internal_name} .= " & $ordinal";
 378             }
 379             if(!$$function_external_ordinal{$external_name}) {
 380                 $$function_external_ordinal{$external_name} = $ordinal;
 381             } else {
 382                 $$function_external_ordinal{$external_name} .= " & $ordinal";
 383             }
 384             if(!$$function_internal_module{$internal_name}) {
 385                 $$function_internal_module{$internal_name} = "$module";
 386             } else { # if($$function_internal_module{$internal_name} !~ /$module/) {
 387                 $$function_internal_module{$internal_name} .= " & $module";
 388             }
 389             if(!$$function_external_module{$external_name}) {
 390                 $$function_external_module{$external_name} = "$module";
 391             } else { # if($$function_external_module{$external_name} !~ /$module/) {
 392                 $$function_external_module{$external_name} .= " & $module";
 393             }
 394         } elsif(/^(\d+|@)\s+forward(?:\s+(?:-noimport|-norelay|-i386|-ret64))?\s+(\S+)\s+(\S+)\.(\S+)$/) {
 395             $ordinal = $1;
 396
 397             my $external_name = $2;
 398             my $forward_module = lc($3);
 399             my $forward_name = $4;
 400
 401             if ($external_name ne "@") {
 402                 $$module_external_calling_convention{$module}{$external_name} = "forward";
 403             } else {
 404                 $$module_external_calling_convention{$module}{"\@$ordinal"} = "forward";
 405             }
 406             $$function_forward{$module}{$external_name} = [$forward_module, $forward_name];
 407         } elsif(/^(\d+|@)\s+extern\s+(\S+)\s+(\S+)$/) {
 408             $ordinal = $1;
 409
 410             my $external_name = $2;
 411             my $internal_name = $3;
 412
 413             if ($external_name ne "@") {
 414                 $$module_external_calling_convention{$module}{$external_name} = "extern";
 415             } else {
 416                 $$module_external_calling_convention{$module}{"\@$ordinal"} = "extern";
 417             }
 418         } elsif(/^(\d+|@)\s+(equate|variable)/) {
 419             # ignore
 420         } else {
 421             my $next_line = <IN>;
 422             if(!defined($next_line) || $next_line =~ /^\s*\d|@/) {
 423                 die "$file: $.: syntax error: '$_'\n";
 424             } else {
 425                 $_ .= $next_line;
 426                 $lookahead = 1;
 427             }
 428         }
 429
 430         if(defined($ordinal)) {
 431             if($ordinal ne "@" && $ordinals{$ordinal}) {
 432                 $output->write("$file: ordinal redefined: $_\n");
 433             }
 434             $ordinals{$ordinal}++;
 435         }
 436     }
 437     close(IN);
 438
 439     $$modules{$module}++;
 440
 441     $$module_files{$module} = $file;
 442 }
 443
 444 sub name {
 445     my $self = shift;
 446     my $name = \${$self->{NAME}};
 447
 448     return $$name;
 449 }
 450
 451 sub is_allowed_kind {
 452     my $self = shift;
 453     my $allowed_kind = \%{$self->{ALLOWED_KIND}};
 454
 455     my $kind = shift;
 456     if(defined($kind)) {
 457         return $$allowed_kind{$kind};
 458     } else {
 459         return 0;
 460     }
 461
 462 }
 463
 464 sub allow_kind {
 465     my $self = shift;
 466     my $allowed_kind = \%{$self->{ALLOWED_KIND}};
 467
 468     my $kind = shift;
 469
 470     $$allowed_kind{$kind}++;
 471 }
 472
 473 sub is_limited_type {
 474     my $self = shift;
 475     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
 476
 477     my $type = shift;
 478
 479     return $$allowed_modules_limited{$type};
 480 }
 481
 482 sub is_allowed_type_in_module {
 483     my $self = shift;
 484     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 485     my $allowed_modules_limited = \%{$self->{ALLOWED_MODULES_LIMITED}};
 486
 487     my $type = shift;
 488     my @modules = split(/ \& /, shift);
 489
 490     if(!$$allowed_modules_limited{$type}) { return 1; }
 491
 492     foreach my $module (@modules) {
 493         if($$allowed_modules{$type}{$module}) { return 1; }
 494     }
 495
 496     return 0;
 497 }
 498
 499 sub allow_type_in_module {
 500     my $self = shift;
 501     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 502
 503     my $type = shift;
 504     my @modules = split(/ \& /, shift);
 505
 506     foreach my $module (@modules) {
 507         $$allowed_modules{$type}{$module}++;
 508     }
 509 }
 510
 511 sub type_used_in_module {
 512     my $self = shift;
 513     my $used_modules = \%{$self->{USED_MODULES}};
 514
 515     my $type = shift;
 516     my @modules = split(/ \& /, shift);
 517
 518     foreach my $module (@modules) {
 519         $$used_modules{$type}{$module} = 1;
 520     }
 521
 522     return ();
 523 }
 524
 525 sub types_not_used {
 526     my $self = shift;
 527     my $used_modules = \%{$self->{USED_MODULES}};
 528     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 529
 530     my $not_used;
 531     foreach my $type (sort(keys(%$allowed_modules))) {
 532         foreach my $module (sort(keys(%{$$allowed_modules{$type}}))) {
 533             if(!$$used_modules{$type}{$module}) {
 534                 $$not_used{$module}{$type} = 1;
 535             }
 536         }
 537     }
 538     return $not_used;
 539 }
 540
 541 sub types_unlimited_used_in_modules {
 542     my $self = shift;
 543
 544     my $used_modules = \%{$self->{USED_MODULES}};
 545     my $allowed_modules = \%{$self->{ALLOWED_MODULES}};
 546     my $allowed_modules_unlimited = \%{$self->{ALLOWED_MODULES_UNLIMITED}};
 547
 548     my $used_types;
 549     foreach my $type (sort(keys(%$allowed_modules_unlimited))) {
 550         my $count = 0;
 551         my @modules = ();
 552         foreach my $module (sort(keys(%{$$used_modules{$type}}))) {
 553             $count++;
 554             push @modules, $module;
 555         }
 556         if($count) {
 557             foreach my $module (@modules) {
 558               $$used_types{$type}{$module} = 1;
 559             }
 560         }
 561     }
 562     return $used_types;
 563 }
 564
 565 sub translate_argument {
 566     my $self = shift;
 567     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 568
 569     my $type = shift;
 570
 571     return $$translate_argument{$type};
 572 }
 573
 574 sub declare_argument {
 575     my $self = shift;
 576     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 577
 578     my $type = shift;
 579     my $kind = shift;
 580
 581     $$translate_argument{$type} = $kind;
 582 }
 583
 584 sub all_declared_types {
 585     my $self = shift;
 586     my $translate_argument = \%{$self->{TRANSLATE_ARGUMENT}};
 587
 588     return sort(keys(%$translate_argument));
 589 }
 590
 591 sub is_allowed_type_format {
 592     my $self = shift;
 593     my $type_format = \%{$self->{TYPE_FORMAT}};
 594
 595     my $module = shift;
 596     my $type = shift;
 597     my $format = shift;
 598
 599     my $formats;
 600
 601     if(defined($module) && defined($type)) {
 602         local $_;
 603         foreach (split(/ & /, $module)) {
 604             if(defined($formats)) {
 605                 $formats .= "|";
 606             } else {
 607                 $formats = "";
 608             }
 609             if(defined($$type_format{$_}{$type})) {
 610                 $formats .= $$type_format{$_}{$type};
 611             }
 612         }
 613     }
 614
 615     if(defined($formats)) {
 616         local $_;
 617         foreach (split(/\|/, $formats)) {
 618             if($_ eq $format) {
 619                 return 1;
 620             }
 621         }
 622     }
 623
 624     return 0;
 625 }
 626
 627 sub all_modules {
 628     my $self = shift;
 629     my $modules = \%{$self->{MODULES}};
 630
 631     return sort(keys(%$modules));
 632 }
 633
 634 sub is_module {
 635     my $self = shift;
 636     my $modules = \%{$self->{MODULES}};
 637
 638     my $name = shift;
 639
 640     return $$modules{$name};
 641 }
 642
 643 sub module_file {
 644     my $self = shift;
 645
 646     my $module = shift;
 647
 648     my $module_files = \%{$self->{MODULE_FILES}};
 649
 650     return $$module_files{$module};
 651 }
 652
 653 sub all_internal_functions {
 654     my $self = shift;
 655     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 656
 657     return sort(keys(%$function_internal_calling_convention));
 658 }
 659
 660 sub all_internal_functions_in_module {
 661     my $self = shift;
 662     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 663     my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
 664
 665     my $module = shift;
 666
 667     my @names;
 668     foreach my $name (keys(%$function_internal_calling_convention)) {
 669         if($$function_internal_module{$name} eq $module) {
 670             push @names, $name;
 671         }
 672     }
 673
 674     return sort(@names);
 675 }
 676
 677 sub all_external_functions {
 678     my $self = shift;
 679     my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
 680
 681     return sort(keys(%$function_external_name));
 682 }
 683
 684 sub all_external_functions_in_module {
 685     my $self = shift;
 686     my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
 687     my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};
 688
 689     my $module = shift;
 690
 691     my @names;
 692     foreach my $name (keys(%$function_external_name)) {
 693         if($$function_external_module{$name} eq $module) {
 694             push @names, $name;
 695         }
 696     }
 697
 698     return sort(@names);
 699 }
 700
 701 sub all_functions_in_module {
 702     my $self = shift;
 703     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 704
 705     my $module = shift;
 706
 707     return sort(keys(%{$$module_external_calling_convention{$module}}));
 708 }
 709
 710 sub all_broken_forwards {
 711     my $self = shift;
 712     my $function_forward = \%{$self->{FUNCTION_FORWARD}};
 713
 714     my @broken_forwards = ();
 715     foreach my $module (sort(keys(%$function_forward))) {
 716         foreach my $external_name (sort(keys(%{$$function_forward{$module}}))) {
 717             (my $forward_module, my $forward_external_name) = @{$$function_forward{$module}{$external_name}};
 718
 719             my $forward_external_calling_convention =
 720                 $self->function_external_calling_convention_in_module($forward_module, $forward_external_name);
 721
 722             if(!defined($forward_external_calling_convention)) {
 723                 push @broken_forwards, [$module, $external_name, $forward_module, $forward_external_name];
 724             }
 725         }
 726     }
 727     return @broken_forwards;
 728 }
 729
 730
 731 sub function_internal_ordinal {
 732     my $self = shift;
 733     my $function_internal_ordinal = \%{$self->{FUNCTION_INTERNAL_ORDINAL}};
 734
 735     my $name = shift;
 736
 737     return $$function_internal_ordinal{$name};
 738 }
 739
 740 sub function_external_ordinal {
 741     my $self = shift;
 742     my $function_external_ordinal = \%{$self->{FUNCTION_EXTERNAL_ORDINAL}};
 743
 744     my $name = shift;
 745
 746     return $$function_external_ordinal{$name};
 747 }
 748
 749 sub function_internal_calling_convention {
 750     my $self = shift;
 751     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 752
 753     my $name = shift;
 754
 755     return $$function_internal_calling_convention{$name};
 756 }
 757
 758 sub function_external_calling_convention {
 759     my $self = shift;
 760     my $function_external_calling_convention = \%{$self->{FUNCTION_EXTERNAL_CALLING_CONVENTION}};
 761
 762     my $name = shift;
 763
 764     return $$function_external_calling_convention{$name};
 765 }
 766
 767 sub function_external_calling_convention_in_module {
 768     my $self = shift;
 769     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 770
 771     my $module = shift;
 772     my $name = shift;
 773
 774     return $$module_external_calling_convention{$module}{$name};
 775 }
 776
 777 sub function_internal_name {
 778     my $self = shift;
 779     my $function_internal_name = \%{$self->{FUNCTION_INTERNAL_NAME}};
 780
 781     my $name = shift;
 782
 783     return $$function_internal_name{$name};
 784 }
 785
 786 sub function_external_name {
 787     my $self = shift;
 788     my $function_external_name = \%{$self->{FUNCTION_EXTERNAL_NAME}};
 789
 790     my $name = shift;
 791
 792     return $$function_external_name{$name};
 793 }
 794
 795 sub function_forward_final_destination {
 796     my $self = shift;
 797
 798     my $function_forward = \%{$self->{FUNCTION_FORWARD}};
 799
 800     my $module = shift;
 801     my $name = shift;
 802
 803     my $forward_module = $module;
 804     my $forward_name = $name;
 805     while(defined(my $forward = $$function_forward{$forward_module}{$forward_name})) {
 806         ($forward_module, $forward_name) = @$forward;
 807     }
 808
 809     return ($forward_module, $forward_name);
 810 }
 811
 812 sub is_function {
 813     my $self = shift;
 814     my $function_internal_calling_convention = \%{$self->{FUNCTION_INTERNAL_CALLING_CONVENTION}};
 815
 816     my $name = shift;
 817
 818     return $$function_internal_calling_convention{$name};
 819 }
 820
 821 sub all_shared_internal_functions {
 822     my $self = shift;
 823     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 824
 825     return sort(keys(%$function_shared));
 826 }
 827
 828 sub is_shared_internal_function {
 829     my $self = shift;
 830     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 831
 832     my $name = shift;
 833
 834     return $$function_shared{$name};
 835 }
 836
 837 sub found_shared_internal_function {
 838     my $self = shift;
 839     my $function_shared = \%{$self->{FUNCTION_SHARED}};
 840
 841     my $name = shift;
 842
 843     $$function_shared{$name} = 1;
 844 }
 845
 846 sub function_internal_arguments {
 847     my $self = shift;
 848     my $function_internal_arguments = \%{$self->{FUNCTION_INTERNAL_ARGUMENTS}};
 849
 850     my $name = shift;
 851
 852     return $$function_internal_arguments{$name};
 853 }
 854
 855 sub function_external_arguments {
 856     my $self = shift;
 857     my $function_external_arguments = \%{$self->{FUNCTION_EXTERNAL_ARGUMENTS}};
 858
 859     my $name = shift;
 860
 861     return $$function_external_arguments{$name};
 862 }
 863
 864 sub function_internal_module {
 865     my $self = shift;
 866     my $function_internal_module = \%{$self->{FUNCTION_INTERNAL_MODULE}};
 867
 868     my $name = shift;
 869
 870     return $$function_internal_module{$name};
 871 }
 872
 873 sub function_external_module {
 874     my $self = shift;
 875     my $function_external_module = \%{$self->{FUNCTION_EXTERNAL_MODULE}};
 876
 877     my $name = shift;
 878
 879     return $$function_external_module{$name};
 880 }
 881
 882 sub is_function_stub {
 883     my $self = shift;
 884     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 885     my $modules = \%{$self->{MODULES}};
 886
 887     my $module = shift;
 888     my $name = shift;
 889
 890     foreach my $module (keys(%$modules)) {
 891         if($$module_external_calling_convention{$module}{$name} eq "stub") {
 892             return 1;
 893         }
 894     }
 895
 896     return 0;
 897 }
 898
 899 sub is_function_stub_in_module {
 900     my $self = shift;
 901     my $module_external_calling_convention = \%{$self->{MODULE_EXTERNAL_CALLING_CONVENTION}};
 902
 903     my $module = shift;
 904     my $name = shift;
 905
 906     if(!defined($$module_external_calling_convention{$module}{$name})) {
 907         return 0;
 908     }
 909     return $$module_external_calling_convention{$module}{$name} eq "stub";
 910 }
 911
 912 ########################################################################
 913 # class methods
 914 #
 915
 916 sub _get_all_module_internal_ordinal {
 917     my $winapi = shift;
 918     my $internal_name = shift;
 919
 920     my @entries = ();
 921
 922     my @name = (); {
 923         my $name = $winapi->function_external_name($internal_name);
 924         if(defined($name)) {
 925             @name = split(/ & /, $name);
 926         }
 927     }
 928
 929     my @module = (); {
 930         my $module = $winapi->function_internal_module($internal_name);
 931         if(defined($module)) {
 932             @module = split(/ & /, $module);
 933         }
 934     }
 935
 936     my @ordinal = (); {
 937         my $ordinal = $winapi->function_internal_ordinal($internal_name);
 938         if(defined($ordinal)) {
 939             @ordinal = split(/ & /, $ordinal);
 940         }
 941     }
 942
 943     my $name;
 944     my $module;
 945     my $ordinal;
 946     while(defined($name = shift @name) &&
 947           defined($module = shift @module) &&
 948           defined($ordinal = shift @ordinal))
 949     {
 950         push @entries, [$name, $module, $ordinal];
 951     }
 952
 953     return @entries;
 954 }
 955
 956 sub get_all_module_internal_ordinal16 {
 957     return _get_all_module_internal_ordinal($win16api, @_);
 958 }
 959
 960 sub get_all_module_internal_ordinal32 {
 961     return _get_all_module_internal_ordinal($win32api, @_);
 962 }
 963
 964 sub get_all_module_internal_ordinal {
 965     my @entries = ();
 966     foreach my $winapi (@winapis) {
 967         push @entries, _get_all_module_internal_ordinal($winapi, @_);
 968     }
 969
 970     return @entries;
 971 }
 972
 973 sub _get_all_module_external_ordinal {
 974     my $winapi = shift;
 975     my $external_name = shift;
 976
 977     my @entries = ();
 978
 979     my @name = (); {
 980         my $name = $winapi->function_internal_name($external_name);
 981         if(defined($name)) {
 982             @name = split(/ & /, $name);
 983         }
 984     }
 985
 986     my @module = (); {
 987         my $module = $winapi->function_external_module($external_name);
 988         if(defined($module)) {
 989             @module = split(/ & /, $module);
 990         }
 991     }
 992
 993     my @ordinal = (); {
 994         my $ordinal = $winapi->function_external_ordinal($external_name);
 995         if(defined($ordinal)) {
 996             @ordinal = split(/ & /, $ordinal);
 997         }
 998     }
 999
1000     my $name;
1001     my $module;
1002     my $ordinal;
1003     while(defined($name = shift @name) &&
1004           defined($module = shift @module) &&
1005           defined($ordinal = shift @ordinal))
1006     {
1007         push @entries, [$name, $module, $ordinal];
1008     }
1009
1010     return @entries;
1011 }
1012
1013 sub get_all_module_external_ordinal16 {
1014     return _get_all_module_external_ordinal($win16api, @_);
1015 }
1016
1017 sub get_all_module_external_ordinal32 {
1018     return _get_all_module_external_ordinal($win32api, @_);
1019 }
1020
1021 sub get_all_module_external_ordinal {
1022     my @entries = ();
1023     foreach my $winapi (@winapis) {
1024         push @entries, _get_all_module_external_ordinal($winapi, @_);
1025     }
1026
1027     return @entries;
1028 }
1029
1030 1;