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