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