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