tools/winapi/winapi_extract

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