git.oblomov.eu Git - wine/blob - tools/winapi/winapi_extract

   1 #!/usr/bin/perl -w
   2
   3 # Copyright 2001 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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     &file_type &files_skip &files_filter &get_spec_files
  29     $current_dir $wine_dir $winapi_dir $winapi_check_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_c_parser;
  45 use winapi_function;
  46
  47 use vars qw($win16api $win32api @winapis);
  48 if ($options->spec_files || $options->winetest) {
  49     require winapi;
  50     import winapi qw($win16api $win32api @winapis);
  51 }
  52
  53 my %module2entries;
  54 my %module2spec_file;
  55 if($options->spec_files || $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");
  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 begining 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_stub {
 165     my $function = shift;
 166
 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             }
 174         }
 175         if($options->win32) {
 176             my $external_name32 = $function->external_name32;
 177             foreach my $module32 ($function->modules32) {
 178                 $module_pseudo_stub{$module32}{$external_name32}++;
 179             }
 180         }
 181     }
 182 }
 183
 184 my @h_files = ();
 185 if($options->headers) {
 186     @h_files = $options->h_files;
 187     @h_files = files_skip(@h_files);
 188     @h_files = files_filter("winelib", @h_files);
 189 }
 190
 191 my @c_files = ();
 192 if(1 || $options->spec_files || $options->pseudo_stub_statistics) {
 193     @c_files = $options->c_files;
 194     @c_files = files_skip(@c_files);
 195     @c_files = files_filter("winelib", @c_files);
 196 }
 197
 198 my $progress_output;
 199 my $progress_current = 0;
 200 my $progress_max = scalar(@h_files) + scalar(@c_files);
 201
 202 foreach my $file (@h_files, @c_files) {
 203     my %functions;
 204
 205     $progress_current++;
 206
 207     {
 208         open(IN, "< $file");
 209         local $/ = undef;
 210         $_ = <IN>;
 211         close(IN);
 212     }
 213
 214     my $max_line = 0;
 215     {
 216       local $_ = $_;
 217       while(s/^.*?\n//) { $max_line++; }
 218       if($_) { $max_line++; }
 219     }
 220
 221     my $parser;
 222     if (!$options->old) {
 223         $parser = new c_parser($file);
 224     } else {
 225         $parser = new winapi_c_parser($file);
 226     }
 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->stub_statistics) {
 271             $old_function = 'winapi_function'->new;
 272         } else {
 273             $old_function = 'function'->new;
 274         }
 275
 276         $function->file($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->spec_files || $options->winetest) {
 298             documentation_specifications($old_function);
 299         }
 300
 301         if($options->stub_statistics) {
 302             statements_stub($old_function);
 303         }
 304
 305         if ($function->statements) {
 306             $function = undef;
 307             &$update_output();
 308         } else {
 309             $function = undef;
 310         }
 311     };
 312     $parser->set_found_function_callback($found_function);
 313
 314     my $found_line = sub {
 315         $line = shift;
 316
 317         &$update_output;
 318     };
 319     $parser->set_found_line_callback($found_line);
 320
 321     my $found_type = sub {
 322         my $type = shift;
 323
 324         &$update_output();
 325
 326         my $kind = $type->kind;
 327         my $_name = $type->_name;
 328         my $name = $type->name;
 329
 330         foreach my $field ($type->fields) {
 331             my $field_type_name = $field->type_name;
 332             my $field_name = $field->name;
 333
 334             if ($options->struct) {
 335                 if ($name) {
 336                     $output->write("$name:$field_type_name:$field_name\n");
 337                 } else {
 338                     $output->write("$kind $_name:$field_type_name:$field_name\n");
 339                 }
 340             }
 341         }
 342
 343         return 1;
 344     };
 345     $parser->set_found_type_callback($found_type);
 346
 347     {
 348         my $line = 1;
 349         my $column = 0;
 350         if(!$parser->parse_c_file(\$_, \$line, \$column)) {
 351             $output->write("can't parse file\n");
 352         }
 353     }
 354
 355     $output->prefix("");
 356 }
 357
 358 sub output_function {
 359     local *OUT = shift;
 360     my $type = shift;
 361     my $ordinal = shift;
 362     my $external_name = shift;
 363     my $function = shift;
 364
 365     my $internal_name = $function->internal_name;
 366
 367     my $return_kind;
 368     my $calling_convention;
 369     my $refargument_kinds;
 370     if($type eq "win16") {
 371         $return_kind = $function->return_kind16 || "undef";
 372         $calling_convention = $function->calling_convention16 || "undef";
 373         $refargument_kinds = $function->argument_kinds16;
 374     } elsif($type eq "win32") {
 375         $return_kind = $function->return_kind32 || "undef";
 376         $calling_convention = $function->calling_convention32 || "undef";
 377         $refargument_kinds = $function->argument_kinds32;
 378     }
 379
 380     if(defined($refargument_kinds)) {
 381         my @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
 382         print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
 383     } else {
 384         print OUT "$ordinal $calling_convention $external_name() $internal_name # FIXME: arguments undefined\n";
 385     }
 386 }
 387
 388 if($options->spec_files) {
 389     foreach my $winapi (@winapis) {
 390         my $type = $winapi->name;
 391
 392         if($type eq "win16" && !$options->win16) { next; }
 393         if($type eq "win32" && !$options->win32) { next; }
 394
 395         foreach my $module ($winapi->all_modules) {
 396             my $spec_file = $module2spec_file{$module};
 397
 398             if(!defined($spec_file) || !defined($type)) {
 399                 $output->write("$module: doesn't exist\n");
 400                 next;
 401             }
 402
 403             $spec_file .= "2";
 404
 405             $output->progress("$spec_file");
 406             open(OUT, "> $wine_dir/$spec_file");
 407
 408             if(exists($specifications{$module}{init})) {
 409                 my $function = $specifications{$module}{init}{function};
 410                 print OUT "init " . $function->internal_name . "\n";
 411             }
 412             print OUT "\n";
 413
 414             my %debug_channels;
 415             if(exists($specifications{$module}{init})) {
 416                 my $function = $specifications{$module}{init}{function};
 417                 foreach my $debug_channel (@{$function->debug_channels}) {
 418                     $debug_channels{$debug_channel}++;
 419                 }
 420             }
 421             foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 422                 my $function = $specifications{$module}{fixed}{$ordinal}{function};
 423                 foreach my $debug_channel (@{$function->debug_channels}) {
 424                     $debug_channels{$debug_channel}++;
 425                 }
 426             }
 427             foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 428                 my $function = $specifications{$module}{unfixed}{$name}{function};
 429                 foreach my $debug_channel (@{$function->debug_channels}) {
 430                     $debug_channels{$debug_channel}++;
 431                 }
 432             }
 433             foreach my $name (sort(keys(%{$specifications{$module}{unknown}}))) {
 434                 my $function = $specifications{$module}{unknown}{$name}{function};
 435                 foreach my $debug_channel (@{$function->debug_channels}) {
 436                     $debug_channels{$debug_channel}++;
 437                 }
 438             }
 439
 440             my @debug_channels = sort(keys(%debug_channels));
 441             if($#debug_channels >= 0) {
 442                 print OUT "debug_channels (" .  join(" ", @debug_channels) . ")\n";
 443                 print OUT "\n";
 444             }
 445
 446             my $empty = 1;
 447
 448             if(!$empty) {
 449                 print OUT "\n";
 450                 $empty = 1;
 451             }
 452             foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
 453                 my $entry = $specifications{$module}{unknown}{$external_name};
 454                 my $ordinal = $entry->{ordinal};
 455                 my $function = $entry->{function};
 456                 print OUT "# ";
 457                 output_function(\*OUT, $type, $ordinal, $external_name, $function);
 458                 $empty = 0;
 459             }
 460
 461             if(!$empty) {
 462                 print OUT "\n";
 463                 $empty = 1;
 464             }
 465             foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 466                 my $entry = $specifications{$module}{fixed}{$ordinal};
 467                 my $external_name = $entry->{external_name};
 468                 my $function = $entry->{function};
 469                 output_function(\*OUT, $type, $ordinal, $external_name, $function);
 470                 $empty = 0;
 471             }
 472
 473             if(!$empty) {
 474                 print OUT "\n";
 475                 $empty = 1;
 476             }
 477             foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 478                 my $entry = $specifications{$module}{unfixed}{$external_name};
 479                 my $ordinal = $entry->{ordinal};
 480                 my $function = $entry->{function};
 481                 output_function(\*OUT, $type, $ordinal, $external_name, $function);
 482                 $empty = 0;
 483             }
 484
 485             close(OUT);
 486         }
 487     }
 488 }
 489
 490 if($options->stub_statistics) {
 491     foreach my $winapi (@winapis) {
 492         my $type = $winapi->name;
 493
 494         if($type eq "win16" && !$options->win16) { next; }
 495         if($type eq "win32" && !$options->win32) { next; }
 496
 497         my %module_counts;
 498          foreach my $module ($winapi->all_modules) {
 499              foreach my $external_name ($winapi->all_functions_in_module($module)) {
 500                  my $external_calling_convention =
 501                      $winapi->function_external_calling_convention_in_module($module, $external_name);
 502                  if($external_calling_convention !~ /^forward|stub$/) {
 503                      if($module_pseudo_stub{$module}{$external_name}) {
 504                          $external_calling_convention = "pseudo_stub";
 505                      }
 506                  } elsif($external_calling_convention eq "forward") {
 507                      (my $forward_module, my $forward_external_name) =
 508                          $winapi->function_forward_final_destination($module, $external_name);
 509
 510                      my $forward_external_calling_convention =
 511                          $winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
 512
 513                      if(!defined($forward_external_calling_convention)) {
 514                          next;
 515                      }
 516
 517                      if($forward_external_calling_convention ne "stub" &&
 518                         $module_pseudo_stub{$forward_module}{$forward_external_name})
 519                      {
 520                          $forward_external_calling_convention = "pseudo_stub";
 521                      }
 522
 523                      $external_calling_convention = "forward_$forward_external_calling_convention";
 524                  }
 525
 526                  $module_counts{$module}{$external_calling_convention}++;
 527              }
 528          }
 529
 530         foreach my $module ($winapi->all_modules) {
 531             my $pseudo_stubs = $module_counts{$module}{pseudo_stub} || 0;
 532             my $real_stubs = $module_counts{$module}{stub} || 0;
 533             my $forward_pseudo_stubs = $module_counts{$module}{forward_pseudo_stub} || 0;
 534             my $forward_real_stubs = $module_counts{$module}{forward_stub} || 0;
 535
 536             my $forwards = 0;
 537             my $total = 0;
 538             foreach my $calling_convention (keys(%{$module_counts{$module}})) {
 539                 my $count = $module_counts{$module}{$calling_convention};
 540                 if($calling_convention =~ /^forward/) {
 541                     $forwards += $count;
 542                 }
 543                 $total += $count;
 544             }
 545
 546             if($total > 0) {
 547                 my $stubs = $real_stubs + $pseudo_stubs;
 548
 549                 $output->write("*.c: $module: ");
 550                 $output->write("$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo) " .
 551                                "and $forwards are forwards\n");
 552             }
 553
 554             if($forwards > 0) {
 555                 my $forward_stubs = $forward_real_stubs + $forward_pseudo_stubs;
 556
 557                 $output->write("*.c: $module: ");
 558                 $output->write("$forward_stubs of $forwards forwarded functions are stubs " .
 559                                "($forward_real_stubs real, $forward_pseudo_stubs pseudo)\n");
 560             }
 561         }
 562     }
 563 }
 564
 565 if($options->winetest) {
 566     foreach my $module ($win32api->all_modules) {
 567         my $type = "win32";
 568
 569         my $package = $module;
 570         $package =~ s/\.dll$//;
 571         $package =~ s/\./_/g;
 572
 573         my @entries;
 574
 575         foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
 576             my $entry = $specifications{$module}{unknown}{$external_name};
 577             push @entries, $entry;
 578         }
 579
 580         foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
 581             my $entry = $specifications{$module}{fixed}{$ordinal};
 582             push @entries, $entry;
 583         }
 584
 585         foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
 586             my $entry = $specifications{$module}{unfixed}{$external_name};
 587             push @entries, $entry;
 588         }
 589
 590         my $n = 0;
 591         foreach my $entry (@entries) {
 592             my $external_name = $entry->{external_name};
 593             my $ordinal = $entry->{ordinal};
 594             my $function = $entry->{function};
 595
 596             my $return_kind = $function->return_kind32 || "undef";
 597             my $calling_convention = $function->calling_convention32 || "undef";
 598             my $refargument_kinds = $function->argument_kinds32;
 599
 600             my @argument_kinds;
 601             if(defined($refargument_kinds)) {
 602                 @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
 603             }
 604
 605             next if $calling_convention ne "stdcall";
 606             next if $external_name eq "\@";
 607
 608             if($n == 0) {
 609                 open(OUT, "> $wine_dir/programs/winetest/include/${package}.pm");
 610
 611                 print OUT "package ${package};\n";
 612                 print OUT "\n";
 613
 614                 print OUT "use strict;\n";
 615                 print OUT "\n";
 616
 617                 print OUT "require Exporter;\n";
 618                 print OUT "\n";
 619
 620                 print OUT "use wine;\n";
 621                 print OUT "use vars qw(\@ISA \@EXPORT \@EXPORT_OK);\n";
 622                 print OUT "\n";
 623
 624                 print OUT "\@ISA = qw(Exporter);\n";
 625                 print OUT "\@EXPORT = qw();\n";
 626                 print OUT "\@EXPORT_OK = qw();\n";
 627                 print OUT "\n";
 628
 629                 print OUT "my \$module_declarations = {\n";
 630             } elsif($n > 0) {
 631                 print OUT ",\n";
 632             }
 633
 634             print OUT "    \"\Q$external_name\E\" => [\"$return_kind\",  [";
 635             my $m = 0;
 636             foreach my $argument_kind (@argument_kinds) {
 637                 if($m > 0) {
 638                     print OUT ", ";
 639                 }
 640                 print OUT "\"$argument_kind\"";
 641                 $m++;
 642             }
 643             print OUT "]]";
 644             $n++;
 645         }
 646
 647         if($n > 0) {
 648             print OUT "\n";
 649             print OUT "};\n";
 650             print OUT "\n";
 651             print OUT "&wine::declare(\"$module\",\%\$module_declarations);\n";
 652             print OUT "push \@EXPORT, map { \"&\" . \$_; } sort(keys(\%\$module_declarations));\n";
 653             print OUT "1;\n";
 654             close(OUT);
 655         }
 656     }
 657 }