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