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