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