tools/winapi/winapi_extract

   1 #!/usr/bin/perl
   2
   3 # Copyright 2002 Patrik Stridvall
   4 #
   5 # This library is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU Lesser General Public
   7 # License as published by the Free Software Foundation; either
   8 # version 2.1 of the License, or (at your option) any later version.
   9 #
  10 # This library is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # Lesser General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU Lesser General Public
  16 # License along with this library; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  18 #
  19
  20 use strict;
  21 use warnings 'all';
  22
  23 BEGIN {
  24     $0 =~ m%^(.*?/?tools)/winapi/winapi_extract$%;
  25     require "$1/winapi/setup.pm";
  26 }
  27
  28 use config qw(
  29     files_skip files_filter get_spec_files
  30     $current_dir $wine_dir $winapi_dir
  31 );
  32 use output qw($output);
  33 use winapi_extract_options qw($options);
  34
  35 if($options->progress) {
  36     $output->enable_progress;
  37 } else {
  38     $output->disable_progress;
  39 }
  40
  41 use c_parser;
  42 use function;
  43 use type;
  44
  45 use winapi_function;
  46
  47 use vars qw($win16api $win32api @winapis);
  48 if ($options->implemented || $options->stub_statistics || $options->winetest) {
  49     require winapi;
  50     import winapi qw($win16api $win32api @winapis);
  51 }
  52
  53 my %module2entries;
  54 my %module2spec_file;
  55 if($options->winetest) {
  56     local $_;
  57
  58     foreach my $spec_file (get_spec_files("winelib")) {
  59         my $entries = [];
  60
  61         my $module = $spec_file;
  62         $module =~ s/^.*?([^\/]*)\.spec$/$1/;
  63
  64         my $type = "win32";
  65
  66         open(IN, "< $wine_dir/$spec_file") || die "Error: Can't open $wine_dir/$spec_file: $!\n";
  67
  68         my $header = 1;
  69         my $lookahead = 0;
  70         while($lookahead || defined($_ = <IN>)) {
  71             $lookahead = 0;
  72
  73             s/^\s*?(.*?)\s*$/$1/; # remove whitespace at beginning and end of line
  74             s/^(.*?)\s*#.*$/$1/;  # remove comments
  75             /^$/ && next;         # skip empty lines
  76
  77             if($header)  {
  78                 if(/^(?:\d+|@)/) {
  79                     $header = 0;
  80                     $lookahead = 1;
  81                 }
  82                 next;
  83             }
  84
  85             if(/^(\d+|@)\s+stdcall\s+(\w+)\s*\(\s*([^\)]*)\s*\)/) {
  86                 my $ordinal = $1;
  87                 my $name = $2;
  88                 my @args = split(/\s+/, $3);
  89
  90                 push @$entries, [$name, "undef", \@args];
  91             }
  92         }
  93         close(IN);
  94
  95         $module2spec_file{$module} = $spec_file;
  96         $module2entries{$module} = $entries;
  97     }
  98 }
  99
 100 my %specifications;
 101
 102 sub documentation_specifications($) {
 103     my $function = shift;
 104
 105     my @debug_channels = @{$function->debug_channels};
 106     my $documentation = $function->documentation;
 107     my $documentation_line = $function->documentation_line;
 108     my $return_type = $function->return_type;
 109     my $linkage = $function->linkage;
 110     my $internal_name = $function->internal_name;
 111
 112     if($linkage eq "static") {
 113         return;
 114     }
 115
 116     local $_;
 117     foreach (split(/\n/, $documentation)) {
 118         if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*(\S+)\s*[\)\]]/) {
 119             my $external_name = $1;
 120             my $module = lc($2);
 121             my $ordinal = $3;
 122
 123             if($ordinal eq "@") {
 124                 if(1 || !exists($specifications{$module}{unfixed}{$external_name})) {
 125                     $specifications{$module}{unfixed}{$external_name}{ordinal} = $ordinal;
 126                     $specifications{$module}{unfixed}{$external_name}{external_name} = $external_name;
 127                     $specifications{$module}{unfixed}{$external_name}{function} = $function;
 128                 } else {
 129                     $output->write("$external_name ($module.$ordinal) already exists\n");
 130                 }
 131             } elsif($ordinal =~ /^\d+$/) {
 132                 if(1 || !exists($specifications{$module}{fixed}{$ordinal})) {
 133                     $specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
 134                     $specifications{$module}{fixed}{$ordinal}{external_name} = $external_name;
 135                     $specifications{$module}{fixed}{$ordinal}{function} = $function;
 136                     } else {
 137                         $output->write("$external_name ($module.$ordinal) already exists\n");
 138                     }
 139             } elsif($ordinal eq "init") {
 140                 if(!exists($specifications{$module}{init})) {
 141                     $specifications{$module}{init}{function} = $function;
 142                 } else {
 143                     $output->write("$external_name ($module.$ordinal) already exists\n");
 144                 }
 145             } else {
 146                 if(!exists($specifications{$module}{unknown}{$external_name})) {
 147                     $specifications{$module}{unknown}{$external_name}{ordinal} = $ordinal;
 148                     $specifications{$module}{unknown}{$external_name}{external_name} = $external_name;
 149                     $specifications{$module}{unknown}{$external_name}{function} = $function;
 150                 } else {
 151                     $output->write("$external_name ($module.$ordinal) already exists\n");
 152                 }
 153             }
 154
 155             if($options->debug) {
 156                 $output->write("$external_name ($module.$ordinal)\n");
 157             }
 158         }
 159     }
 160 }
 161
 162 my %module_pseudo_stub;
 163
 164 sub statements_pseudo_stub($) {
 165     my $function = shift;
 166
 167     my $pseudo_stub = 0;
 168     my $statements = $function->statements;
 169     if(defined($statements) && $statements =~ /FIXME[^;]*stub/s) {
 170         if($options->win16) {
 171             my $external_name16 = $function->external_name16;
 172             foreach my $module16 ($function->modules16) {
 173                 $module_pseudo_stub{$module16}{$external_name16}++;
 174                 $pseudo_stub = 1;
 175             }
 176         }
 177         if($options->win32) {
 178             my $external_name32 = $function->external_name32;
 179             foreach my $module32 ($function->modules32) {
 180                 $module_pseudo_stub{$module32}{$external_name32}++;
 181                 $pseudo_stub = 1;
 182             }
 183         }
 184     }
 185
 186     return $pseudo_stub;
 187 }
 188
 189 my @h_files = ();
 190 if($options->headers) {
 191     @h_files = $options->h_files;
 192     @h_files = files_skip(@h_files);
 193     @h_files = files_filter("winelib", @h_files);
 194 }
 195
 196 my @c_files = ();
 197 if($options->pseudo_implemented || $options->pseudo_stub_statistics) {
 198     @c_files = $options->c_files;
 199     @c_files = files_skip(@c_files);
 200     @c_files = files_filter("winelib", @c_files);
 201 }
 202
 203 my $progress_output;
 204 my $progress_current = 0;
 205 my $progress_max = scalar(@h_files) + scalar(@c_files);
 206
 207 foreach my $file (@h_files, @c_files) {
 208     my %functions;
 209
 210     $progress_current++;
 211
 212     {
 213         open(IN, "< $file") || die "Error: Can't open $file: $!\n";
 214         local $/ = undef;
 215         $_ = <IN>;
 216         close(IN);
 217     }
 218
 219     my $max_line = 0;
 220     {
 221       local $_ = $_;
 222       while(s/^.*?\n//) { $max_line++; }
 223       if($_) { $max_line++; }
 224     }
 225
 226     my $parser = new c_parser($file);
 227
 228     my $function;
 229     my $line;
 230
 231     my $update_output = sub {
 232         my $progress = "";
 233         my $prefix = "";
 234
 235         $progress .= "$file (file $progress_current of $progress_max)";
 236         $prefix .= "$file:";
 237
 238         if(defined($function)) {
 239             my $name = $function->name;
 240             my $begin_line = $function->begin_line;
 241             my $begin_column = $function->begin_column;
 242
 243             $progress .= ": function $name";
 244             $prefix .= "$begin_line.$begin_column: function $name: ";
 245         } else {
 246             $prefix .= " ";
 247         }
 248
 249         if(defined($line)) {
 250             $progress .= ": line $line of $max_line";
 251         }
 252
 253         $output->progress($progress);
 254         $output->prefix($prefix);
 255     };
 256
 257     &$update_output();
 258
 259     my $found_function = sub {
 260         $function = shift;
 261
 262         my $name = $function->name;
 263         $functions{$name} = $function;
 264
 265         if ($function->statements) {
 266             &$update_output();
 267         }
 268
 269         my $old_function;
 270         if($options->implemented || $options->stub_statistics) {
 271             $old_function = 'winapi_function'->new;
 272         } else {
 273             $old_function = 'function'->new;
 274         }
 275
 276         $old_function->file($function->file);
 277         $old_function->debug_channels([]); # FIXME: Not complete
 278
 279         $old_function->documentation_line(0); # FIXME: Not complete
 280         $old_function->documentation(""); # FIXME: Not complete
 281
 282         $old_function->function_line($function->begin_line());
 283         $old_function->linkage($function->linkage);
 284         $old_function->return_type($function->return_type);
 285         $old_function->calling_convention($function->calling_convention);
 286         $old_function->internal_name($function->name);
 287         if (defined($function->argument_types)) {
 288             $old_function->argument_types([@{$function->argument_types}]);
 289         }
 290         if (defined($function->argument_names)) {
 291             $old_function->argument_names([@{$function->argument_names}]);
 292         }
 293         $old_function->argument_documentations([]); # FIXME: Not complete
 294         $old_function->statements_line($function->statements_line);
 295         $old_function->statements($function->statements);
 296
 297         if($options->winetest) {
 298             documentation_specifications($old_function);
 299         }
 300
 301         if ($function->statements) {
 302             $function = undef;
 303             &$update_output();
 304         } else {
 305             $function = undef;
 306         }
 307
 308         my $pseudo_stub = 0;
 309         if ($options->pseudo_implemented || $options->pseudo_stub_statistics) {
 310             $pseudo_stub = statements_pseudo_stub($old_function);
 311         }
 312
 313         my $module = $old_function->module;
 314         my $external_name = $old_function->external_name;
 315         my $statements = $old_function->statements;
 316         if ($options->pseudo_implemented && $module && $external_name && $statements) {
 317             my @external_names = split(/\s*&\s*/, $external_name);
 318             my @modules = split(/\s*&\s*/, $module);
 319
 320             my @external_names2;
 321             while(defined(my $external_name = shift @external_names) &&
 322                   defined(my $module = shift @modules))
 323             {
 324                 if ($pseudo_stub) {
 325                     $output->write("$module.$external_name: pseudo implemented\n");
 326                 } else {
 327                     $output->write("$module.$external_name: implemented\n");
 328                 }
 329             }
 330         }
 331     };
 332     $parser->set_found_function_callback($found_function);
 333
 334     my $found_line = sub {
 335         $line = shift;
 336
 337         &$update_output;
 338     };
 339     $parser->set_found_line_callback($found_line);
 340
 341     my $found_type = sub {
 342         my $type = shift;
 343
 344         &$update_output();
 345
 346         my $kind = $type->kind;
 347         my $_name = $type->_name;
 348         my $name = $type->name;
 349
 350         foreach my $field ($type->fields) {
 351             my $field_type_name = $field->type_name;
 352             my $field_name = $field->name;
 353
 354             if ($options->struct && $kind =~ /^(?:struct|union)$/) {
 355                 if ($name) {
 356                     $output->write("$name:$field_type_name:$field_name\n");
 357                 } else {
 358                     $output->write("$kind $_name:$field_type_name:$field_name\n");
 359                 }
 360             }
 361         }
 362
 363         return 1;
 364     };
 365     $parser->set_found_type_callback($found_type);
 366
 367     {
 368         my $line = 1;
 369         my $column = 0;
 370         if(!$parser->parse_c_file(\$_, \$line, \$column)) {
 371             $output->write("can't parse file\n");
 372         }
 373     }
 374
 375     $output->prefix("");
 376 }
 377
 378
 379 if($options->implemented && !$options->pseudo_implemented) {
 380     foreach my $winapi (@winapis) {
 381         my $type = $winapi->name;
 382
 383         if($type eq "win16" && !$options->win16) { next; }
 384         if($type eq "win32" && !$options->win32) { next; }
 385
 386         foreach my $module ($winapi->all_modules) {
 387             foreach my $external_name ($winapi->all_functions_in_module($module)) {
 388                  my $external_calling_convention =
 389                      $winapi->function_external_calling_convention_in_module($module, $external_name);
 390
 391                  if($external_calling_convention eq "forward") {
 392                      (my $forward_module, my $forward_external_name) =
 393                          $winapi->function_forward_final_destination($module, $external_name);
 394
 395                      my $forward_external_calling_convention =
 396                          $winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
 397
 398                      if(!defined($forward_external_calling_convention)) {
 399                          next;
 400                      }
 401
 402                      $external_calling_convention = $forward_external_calling_convention;
 403                  }
 404
 405                  if ($external_calling_convention ne "stub") {
 406                      $output->write("*.spec: $module.$external_name: implemented\n");
 407                  }
 408             }
 409         }
 410     }
 411 }
 412
 413 sub output_function($$$$$) {
 414     local *OUT = shift;
 415     my $type = shift;
 416     my $ordinal = shift;
 417     my $external_name = shift;
 418     my $function = shift;
 419
 420     my $internal_name = $function->internal_name;
 421
 422     my $return_kind;
 423     my $calling_convention;
 424     my $refargument_kinds;
 425     if($type eq "win16") {
 426         $return_kind = $function->return_kind16 || "undef";
 427         $calling_convention = $function->calling_convention16 || "undef";
 428         $refargument_kinds = $function->argument_kinds16;
 429     } elsif($type eq "win32") {
 430         $return_kind = $function->return_kind32 || "undef";
 431         $calling_convention = $function->calling_convention32 || "undef";
 432         $refargument_kinds = $function->argument_kinds32;
 433     }
 434
 435     if(defined($refargument_kinds)) {
 436         my @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
 437         print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
 438     } else {
 439         print OUT "$ordinal $calling_convention $external_name() $internal_name # FIXME: arguments undefined\n";
 440     }
 441 }
 442
 443 if($options->stub_statistics) {
 444     foreach my $winapi (@winapis) {
 445         my $type = $winapi->name;
 446
 447         if($type eq "win16" && !$options->win16) { next; }
 448         if($type eq "win32" && !$options->win32) { next; }
 449
 450         my %module_counts;
 451          foreach my $module ($winapi->all_modules) {
 452              foreach my $external_name ($winapi->all_functions_in_module($module)) {
 453                  my $external_calling_convention =
 454                      $winapi->function_external_calling_convention_in_module($module, $external_name);
 455                  if($external_calling_convention !~ /^(?:forward|stub)$/) {
 456                      if($module_pseudo_stub{$module}{$external_name}) {
 457                          $external_calling_convention = "pseudo_stub";
 458                      }
 459                  } elsif($external_calling_convention eq "forward") {
 460                      (my $forward_module, my $forward_external_name) =
 461                          $winapi->function_forward_final_destination($module, $external_name);
 462
 463                      my $forward_external_calling_convention =
 464                          $winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
 465
 466                      if(!defined($forward_external_calling_convention)) {
 467                          next;
 468                      }
 469
 470                      if($forward_external_calling_convention ne "stub" &&
 471                         $module_pseudo_stub{$forward_module}{$forward_external_name})
 472                      {
 473                          $forward_external_calling_convention = "pseudo_stub";
 474                      }
 475
 476                      $external_calling_convention = "forward_$forward_external_calling_convention";
 477                  }
 478
 479                  $module_counts{$module}{$external_calling_convention}++;
 480              }
 481          }
 482
 483         foreach my $module ($winapi->all_modules) {
 484             my $pseudo_stubs = $module_counts{$module}{pseudo_stub} || 0;
 485             my $real_stubs = $module_counts{$module}{stub} || 0;
 486             my $forward_pseudo_stubs = $module_counts{$module}{forward_pseudo_stub} || 0;
 487             my $forward_real_stubs = $module_counts{$module}{forward_stub} || 0;
 488
 489             my $forwards = 0;
 490             my $total = 0;
 491             foreach my $calling_convention (keys(%{$module_counts{$module}})) {
 492                 my $count = $module_counts{$module}{$calling_convention};
 493                 if($calling_convention =~ /^forward/) {
 494                     $forwards += $count;
 495                 }
 496                 $total += $count;
 497             }
 498
 499             if($total > 0) {
 500                 my $stubs = $real_stubs + $pseudo_stubs;
 501
 502                 $output->write("*.c: $module: ");
 503                 $output->write("$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo) " .
 504                                "and $forwards are forwards\n");
 505             }
 506
 507             if($forwards > 0) {
 508                 my $forward_stubs = $forward_real_stubs + $forward_pseudo_stubs;
 509
 510                 $output->write("*.c: $module: ");
 511                 $output->write("$forward_stubs of $forwards forwarded functions are stubs " .
 512                                "($forward_real_stubs real, $forward_pseudo_stubs pseudo)\n");
 513             }
 514         }
 515     }
 516 }
 517
 518 if($options->winetest) {
 519     foreach my $module ($win32api->all_modules) {
 520         my $type = "win32";
 521
 522         my $package = $module;
 523         $package =~ s/\.dll$//;
 524         $package =~ s/\./_/g;
 525
 526         my @entries;
 527
 528         foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
 529             my $entry = $specifications{$module}{unknown}{$external_name};
 530             push @entries, $entry;
 531         }
 532
 533         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 534             my $entry = $specifications{$module}{fixed}{$ordinal};
 535             push @entries, $entry;
 536         }
 537
 538         foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 539             my $entry = $specifications{$module}{unfixed}{$external_name};
 540             push @entries, $entry;
 541         }
 542
 543         my $n = 0;
 544         foreach my $entry (@entries) {
 545             my $external_name = $entry->{external_name};
 546             my $ordinal = $entry->{ordinal};
 547             my $function = $entry->{function};
 548
 549             my $return_kind = $function->return_kind32 || "undef";
 550             my $calling_convention = $function->calling_convention32 || "undef";
 551             my $refargument_kinds = $function->argument_kinds32;
 552
 553             my @argument_kinds;
 554             if(defined($refargument_kinds)) {
 555                 @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
 556             }
 557
 558             next if $calling_convention ne "stdcall";
 559             next if $external_name eq "\@";
 560
 561             if($n == 0) {
 562                 open(OUT, "> $wine_dir/programs/winetest/include/${package}.pm") || die "Error: Can't open $wine_dir/programs/winetest/include/${package}.pm: $!\n";
 563
 564                 print OUT "package ${package};\n";
 565                 print OUT "\n";
 566
 567                 print OUT "use strict;\n";
 568                 print OUT "\n";
 569
 570                 print OUT "require Exporter;\n";
 571                 print OUT "\n";
 572
 573                 print OUT "use wine;\n";
 574                 print OUT "use vars qw(\@ISA \@EXPORT \@EXPORT_OK);\n";
 575                 print OUT "\n";
 576
 577                 print OUT "\@ISA = qw(Exporter);\n";
 578                 print OUT "\@EXPORT = qw();\n";
 579                 print OUT "\@EXPORT_OK = qw();\n";
 580                 print OUT "\n";
 581
 582                 print OUT "my \$module_declarations = {\n";
 583             } elsif($n > 0) {
 584                 print OUT ",\n";
 585             }
 586
 587             print OUT "    \"\Q$external_name\E\" => [\"$return_kind\",  [";
 588             my $m = 0;
 589             foreach my $argument_kind (@argument_kinds) {
 590                 if($m > 0) {
 591                     print OUT ", ";
 592                 }
 593                 print OUT "\"$argument_kind\"";
 594                 $m++;
 595             }
 596             print OUT "]]";
 597             $n++;
 598         }
 599
 600         if($n > 0) {
 601             print OUT "\n";
 602             print OUT "};\n";
 603             print OUT "\n";
 604             print OUT "&wine::declare(\"$module\",\%\$module_declarations);\n";
 605             print OUT "push \@EXPORT, map { \"&\" . \$_; } sort(keys(\%\$module_declarations));\n";
 606             print OUT "1;\n";
 607             close(OUT);
 608         }
 609     }
 610 }