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