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

   1 #!/usr/bin/perl -w
   2
   3 # Copyright 2001 Patrik Stridvall
   4
   5 use strict;
   6
   7 BEGIN {
   8     $0 =~ m%^(.*?/?tools)/winapi/winapi_fixup$%;
   9     require "$1/winapi/setup.pm";
  10 }
  11
  12 use config qw(
  13     &file_type &files_filter
  14     &file_skip &files_skip
  15     &file_normalize
  16     &get_spec_files
  17     &translate_calling_convention16 &translate_calling_convention32
  18     $current_dir $wine_dir $winapi_dir $winapi_check_dir
  19 );
  20 use output;
  21 use options;
  22 use modules;
  23 use util;
  24 use winapi;
  25 use winapi_parser;
  26
  27 my $output = output->new;
  28
  29 my %options_long = (
  30     "debug" => { default => 0, description => "debug mode" },
  31     "help" => { default => 0, description => "help mode" },
  32     "verbose" => { default => 0, description => "verbose mode" },
  33
  34     "progress" => { default => 1, description => "show progress" },
  35
  36     "win16" => { default => 1, description => "Win16 fixup" },
  37     "win32" => { default => 1, description => "Win32 fixup" },
  38
  39     "local" =>  { default => 1, description => "local fixup" },
  40     "documentation" => { default => 1, parent => "local", description => "documentation fixup" },
  41     "documentation-ordinal" => { default => 0, parent => "documentation", description => "documentation ordinal fixup" },
  42     "documentation-missing" => { default => 0, parent => "documentation", description => "documentation missing fixup" },
  43     "documentation-name" => { default => 1, parent => "documentation", description => "documentation name fixup" },
  44     "stub" => { default => 0, parent => "local", description => "stub fixup" },
  45
  46     "global" => { default => 1, description => "global fixup" },
  47
  48     "modify" => { default => 0, description => "actually perform the fixups" },
  49 );
  50
  51 my %options_short = (
  52     "d" => "debug",
  53     "?" => "help",
  54     "v" => "verbose"
  55 );
  56
  57 my $options_usage = "usage: winapi_fixup [--help] [<files>]\n";
  58
  59 my $options = options->new(\%options_long, \%options_short, $options_usage);
  60
  61 my $modules = modules->new($options, $output, $wine_dir, $current_dir, \&file_type, "$winapi_check_dir/modules.dat");
  62
  63 my $win16api = winapi->new($options, $output, "win16", "$winapi_check_dir/win16");
  64 my $win32api = winapi->new($options, $output, "win32", "$winapi_check_dir/win32");
  65 my @winapis = ($win16api, $win32api);
  66
  67 if($wine_dir eq ".") {
  68     winapi->read_all_spec_files($modules, $wine_dir, $current_dir, \&file_type, $win16api, $win32api);
  69 } else {
  70     my @spec_files = $modules->allowed_spec_files($wine_dir, $current_dir);
  71     winapi->read_spec_files($modules, $wine_dir, $current_dir, \@spec_files, $win16api, $win32api);
  72 }
  73
  74 sub get_all_module_internal_ordinal {
  75     my $internal_name = shift;
  76
  77     my @entries = ();
  78     foreach my $winapi (@winapis) {
  79         my @module = (); {
  80             my $module = $winapi->function_internal_module($internal_name);
  81             if(defined($module)) {
  82                 @module = split(/ & /, $module);
  83             }
  84         }
  85         my @ordinal = (); {
  86             my $ordinal = $winapi->function_internal_ordinal($internal_name);
  87             if(defined($ordinal)) {
  88                 @ordinal = split(/ & /, $ordinal);
  89             }
  90         }
  91
  92         my $module;
  93         my $ordinal;
  94         while(defined($module = shift @module) && defined($ordinal = shift @ordinal)) {
  95             push @entries, [$module, $ordinal];
  96         }
  97     }
  98
  99     return @entries;
 100 }
 101
 102 sub get_all_module_external_ordinal {
 103     my $external_name = shift;
 104
 105     my @entries = ();
 106     foreach my $winapi (@winapis) {
 107         my @name = (); {
 108             my $name = $winapi->function_external_name($external_name);
 109             if(defined($name)) {
 110                 @name = split(/ & /, $name);
 111             }
 112         }
 113         my @module = (); {
 114             my $module = $winapi->function_external_module($external_name);
 115             if(defined($module)) {
 116                 @module = split(/ & /, $module);
 117             }
 118         }
 119         my @ordinal = (); {
 120             my $ordinal = $winapi->function_external_ordinal($external_name);
 121             if(defined($ordinal)) {
 122                 @ordinal = split(/ & /, $ordinal);
 123             }
 124         }
 125
 126         my $name;
 127         my $module;
 128         my $ordinal;
 129         while(# defined($name = shift @name) &&
 130               defined($module = shift @module) &&
 131               defined($ordinal = shift @ordinal))
 132         {
 133             push @entries, [$name, $module, $ordinal];
 134         }
 135     }
 136
 137     return @entries;
 138 }
 139
 140 sub normalize_set {
 141     local $_ = shift;
 142
 143     if(!defined($_)) {
 144         return undef;
 145     }
 146
 147     my %hash = ();
 148     foreach my $key (split(/\s*&\s*/)) {
 149         $hash{$key}++;
 150     }
 151
 152     return join(" & ", sort(keys(%hash)));
 153 }
 154
 155 my @c_files = options->c_files;
 156 @c_files = files_skip(@c_files);
 157 @c_files = files_filter("winelib", @c_files);
 158
 159 my $progress_output;
 160 my $progress_current = 0;
 161 my $progress_max = scalar(@c_files);
 162
 163 foreach my $file (@c_files) {
 164     my %substitute_line;
 165     my %insert_line;
 166
 167     my %spec_file;
 168
 169     $progress_current++;
 170     if(options->progress) {
 171         output->progress("$file: file $progress_current of $progress_max");
 172     }
 173
 174     my $found_function = sub {
 175         my $line = shift;
 176         my $refdebug_channels = shift;
 177         my @debug_channels = @$refdebug_channels;
 178         my $documentation = shift;
 179         my $linkage = shift;
 180         my $return_type = shift;
 181         my $calling_convention = shift;
 182         my $internal_name = shift;
 183         my $refargument_types = shift;
 184         my @argument_types = @$refargument_types;
 185         my $refargument_names = shift;
 186         my @argument_names = @$refargument_names;
 187         my $refargument_documentations = shift;
 188         my @argument_documentations = @$refargument_documentations;
 189         my $statements = shift;
 190
 191         if($linkage eq "static" || $linkage eq "extern") {
 192             return;
 193         }
 194
 195         my $module16 = $win16api->function_internal_module($internal_name);
 196         my $module32 = $win32api->function_internal_module($internal_name);
 197
 198         my $prefix = "";
 199         $prefix .= "$file: ";
 200         if(defined($module16) && !defined($module32)) {
 201             $prefix .= normalize_set($module16) . ": ";
 202         } elsif(!defined($module16) && defined($module32)) {
 203             $prefix .= normalize_set($module32) . ": ";
 204         } elsif(defined($module16) && defined($module32)) {
 205             $prefix .= normalize_set($module16) . " & " . normalize_set($module32) . ": ";
 206         } else {
 207             $prefix .= "<>: ";
 208         }
 209         $prefix .= "$return_type ";
 210         $prefix .= "$calling_convention " if $calling_convention;
 211         $prefix .= "$internal_name(" . join(",", @argument_types) . "): ";
 212         $output->prefix($prefix);
 213
 214         my $calling_convention16 = translate_calling_convention16($calling_convention);
 215         my $calling_convention32 = translate_calling_convention32($calling_convention);
 216
 217         my @external_names = ();
 218         foreach my $winapi (@winapis) {
 219             my $external_names = $winapi->function_external_name($internal_name);
 220             if(defined($external_names)) {
 221                 push @external_names, split(/\s*&\s*/, $external_names);
 222             }
 223         }
 224
 225         if(options->documentation_ordinal && $documentation) {
 226             local $_;
 227             foreach (split(/\n/, $documentation)) {
 228                 if(/^(\s*\*\s*(\w+)\s*)(\s*(?:[\(\[]\s*\w+(?:\s*\.\s*\S*\s*)?[\)\]])+)(.*?)$/m) {
 229                     my $part1 = $1;
 230                     my $external_name = $2;
 231                     my $part3 = $3;
 232                     my $part4 = $4;
 233
 234                     $part4 =~ s/\s*$//;
 235
 236                     my @entries = ();
 237                     while($part3 =~ s/^\s*([\(\[]\s*(\w+)(?:\s*\.\s*(\S*)\s*)?[\)\]])//) {
 238                         push @entries, [$1, lc($2), $3];
 239                     }
 240
 241                     my $replaced = 0;
 242                     my $replace = "";
 243                     foreach my $entry (@entries) {
 244                         (my $part, my $module, my $ordinal) = @$entry;
 245                         foreach my $entry2 (get_all_module_external_ordinal($external_name)) {
 246                             (my $external_name2, my $module2, my $ordinal2) = @$entry2;
 247
 248                             if(defined($module2) && $module eq $module2 &&
 249                                (!defined($ordinal) || (defined($ordinal2) && $ordinal ne $ordinal2)))
 250                             {
 251                                 if(defined($ordinal)) {
 252                                     if($part =~ s/\U$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/) {
 253                                         $replaced++;
 254                                     }
 255                                 } else {
 256                                     if($part =~ s/\U$module\E/\U$module2\E.$ordinal2/) {
 257                                         $replaced++;
 258                                     }
 259                                 }
 260                             }
 261                         }
 262                         if($replace) { $replace .= "\n"; }
 263                         $replace .= "$part1$part$part4";
 264                     }
 265
 266                     if($replaced > 0) {
 267                         $substitute_line{$_}{search} = "^\Q$_\E\$";
 268                         $substitute_line{$_}{replace} = "$replace";
 269                     }
 270                 } elsif(/^(\s*\*\s*)(\w+)\s*$/m) {
 271                     my $part1 = $1;
 272                     my $external_name = $2;
 273                     if($internal_name eq $external_name) {
 274                         foreach my $entry (get_all_module_external_ordinal($external_name)) {
 275                             (my $external_name2, my $module, my $ordinal) = @$entry;
 276
 277                             # FIXME: Not correct
 278                             $substitute_line{$_}{search} = "^\Q$_\E\$";
 279                             $substitute_line{$_}{replace} = "$part1$external_name (\U$module\E.$ordinal)";
 280                         }
 281                     }
 282                 }
 283             }
 284         }
 285
 286         if(options->documentation_name && $documentation) {
 287             local $_;
 288
 289             my @entries = ();
 290             foreach (split(/\n/, $documentation)) {
 291                 if(/^(\s*\*\s*(\w+)\s*)(\s*(?:[\(\[]\s*\w+(?:\s*\.\s*\S+\s*)?[\)\]])+)(.*?)$/m) {
 292                     my $part1 = $1;
 293                     my $external_name2 = $2;
 294                     my $part3 = $3;
 295                     my $part4 = $4;
 296
 297                     $part4 =~ s/\s*$//;
 298
 299                     push @entries, [$part1, $external_name2, $part3, $part4];
 300                 }
 301             }
 302
 303             my @missing_external_names = ();
 304             foreach my $external_name (@external_names) {
 305                 my $found = 0;
 306                 foreach my $entry (@entries) {
 307                     my $part1 = $entry->[0];
 308                     my $external_name2 = $entry->[1];
 309                     my $part3 = $entry->[2];
 310                     my $part4 = $entry->[3];
 311
 312                     if($external_name eq $external_name2) {
 313                         $found = 1;
 314                     }
 315                 }
 316                 if(!$found) {
 317                     push @missing_external_names, $external_name;
 318                 }
 319             }
 320
 321             foreach my $external_name (@missing_external_names) {
 322                 my $internal_name2 = $internal_name;
 323                 my $external_name2 = $external_name;
 324
 325                 if($internal_name =~ /^(.*?)$external_name(.*?)$/) {
 326                     my $prefix = $1;
 327                     my $suffix = $2;
 328
 329                     my $part1;
 330                     my $part3;
 331                     my $external_name2;
 332                     my $part4;
 333
 334                     foreach my $entry (@entries) {
 335                         $part1 = $entry->[0];
 336                         $external_name2 = $entry->[1];
 337                         $part3 = $entry->[2];
 338                         $part4 = $entry->[3];
 339
 340                         if($internal_name =~ /^(.*?)$external_name(.*?)$/) {
 341                             last;
 342                         }
 343                     }
 344
 345                     foreach (split(/\n/, $documentation)) {
 346                         if(/\Q$external_name\E/) {
 347                             if($suffix =~ /^16$/) {
 348                                 $substitute_line{$_}{search} = "\Q$internal_name\E";
 349                                 $substitute_line{$_}{replace} = "$external_name";
 350                                 last;
 351                             } elsif($suffix =~ /^[AW]$/) {
 352                                 $substitute_line{$_}{search} = "^\Q$_\E\$";
 353
 354                                 # FIXME: Not correct
 355                                 my $replace  = "";
 356
 357                                 $part3 =~ /^\s*[\(\[]\s*(\w+)(?:\s*\.\s*(\S*)\s*)?[\)\]]/;
 358                                 my $module = lc($1);
 359                                 my $ordinal = $2;
 360
 361                                 foreach my $entry2 (get_all_module_external_ordinal($external_name)) {
 362                                     (my $external_name2, my $module2, my $ordinal2) = @$entry2;
 363
 364                                     my $part12 = $part1;
 365                                     $part12 =~ s/[AW](\s*)$/ $1/;
 366
 367                                     my $part32 = $part3;
 368
 369                                     if($module ne $module2 || $ordinal ne $ordinal2) {
 370                                         $part32 =~ s/\U$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/;
 371                                         $replace = "$part12$part32$part4";
 372                                     }
 373                                 }
 374
 375                                 if($replace) {
 376                                     $replace .= "\n$part1$part3$part4";
 377                                     $substitute_line{$_}{replace} = $replace;
 378                                     last;
 379                                 }
 380                             }
 381
 382                         }
 383
 384                     }
 385                 } else {
 386                     output->write("$external_name missing\n");
 387                 }
 388             }
 389         }
 390
 391         if(options->documentation_missing && !$documentation) {
 392             # FIXME: Not correct
 393
 394             my $external_name;
 395             my $module;
 396             my $ordinal;
 397             foreach my $winapi (@winapis) {
 398                 $external_name = ($winapi->function_external_name($internal_name) || $external_name);
 399                 $module = ($winapi->function_internal_module($internal_name) || $module);
 400                 $ordinal = ($winapi->function_internal_ordinal($internal_name) || $ordinal);
 401                 if(defined($external_name) || defined($module) || defined($ordinal)) { last; }
 402             }
 403
 404             if(defined($external_name) && defined($module) && defined($ordinal)) {
 405                 $insert_line{$line} =
 406                     "/" . "*" x 71 . "\n" .
 407                     " *\t\t$external_name (\U$module\E.$ordinal)\n" .
 408                     " */\n";
 409             }
 410         }
 411
 412         if(options->stub) {
 413             # FIXME: Not correct
 414             foreach my $winapi (@winapis) {
 415                 if($winapi->function_stub($internal_name)) {
 416                     my $module = $winapi->function_internal_module($internal_name);
 417                     my $ordinal = $winapi->function_internal_ordinal($internal_name);
 418
 419                     my $external_name = $internal_name;
 420                     if($winapi->name eq "win16") {
 421                         $external_name =~ s/(?:_)?16([AW]?)$//;
 422                         if(defined($1)) {
 423                             $external_name .= $1;
 424                         }
 425                     }
 426
 427                     my $abort = 0;
 428                     my $n;
 429                     my @argument_kinds = map {
 430                         my $type = $_;
 431                         my $kind = "unknown";
 432                         $winapi->type_used_in_module($type, $module);
 433                         if(!defined($kind = $winapi->translate_argument($type))) {
 434                             output->write("no translation defined: " . $type . "\n");
 435                         }
 436
 437                         # FIXME: Kludge
 438                         if(defined($kind) && $kind eq "longlong") {
 439                             $n += 2;
 440                             ("long", "long");
 441                         } elsif(defined($kind)) {
 442                             $n++;
 443                             $kind;
 444                         } else {
 445                             $abort = 1;
 446                             $n++;
 447                             "undef";
 448                         }
 449                     } @argument_types;
 450
 451                     my $substitute = {};
 452                     $substitute->{search} = "^\\s*$ordinal\\s+stub\\s+$external_name\\s*(?:#.*?)?\$";
 453
 454                     if($winapi->name eq "win16") {
 455                         $substitute->{replace} = "$ordinal $calling_convention16 $external_name(@argument_kinds) $internal_name";
 456                     } else {
 457                         $substitute->{replace} = "$ordinal $calling_convention32 $external_name(@argument_kinds) $internal_name";
 458                     }
 459
 460                     if(!defined($spec_file{$module})) {
 461                         $spec_file{$module} = [];
 462                     }
 463
 464                     if(!$abort) {
 465                         push @{$spec_file{$module}}, $substitute;
 466                     }
 467                 }
 468             }
 469         }
 470         $output->prefix("");
 471     };
 472
 473     my $found_preprocessor = sub {
 474         my $directive = shift;
 475         my $argument = shift;
 476     };
 477
 478     winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
 479
 480     my $editor = sub {
 481         local *IN = shift;
 482         local *OUT = shift;
 483
 484         my $modified = 0;
 485         while(<IN>) {
 486             chomp;
 487
 488             my $line = $insert_line{$.};
 489             if(defined($line)) {
 490                 if(options->modify) {
 491                     $_ = "$line$_";
 492                     $modified = 1;
 493                 } else {
 494                     output->write("$file: $.: insert : '$line'\n");
 495                 }
 496             }
 497
 498             my $search = $substitute_line{$_}{search};
 499             my $replace = $substitute_line{$_}{replace};
 500
 501             if(defined($search) && defined($replace)) {
 502                 my $modified2 = 0;
 503                 if(options->modify) {
 504                     if(s/$search/$replace/) {
 505                         $modified = 1;
 506                         $modified2 = 1;
 507                     }
 508                 }
 509
 510                 if(!options->modify || !$modified2) {
 511                     my $search2;
 512                     my $replace2;
 513                     if(options->modify && !$modified2) {
 514                         $search2 = "unmatched search";
 515                         $replace2 = "unmatched replace";
 516                     } else {
 517                         $search2 = "search";
 518                         $replace2 = "replace";
 519                     }
 520                     output->write("$file: $.: $search2 : '$search'\n");
 521
 522                     my @replace2 = split(/\n/, $replace);
 523                     if($#replace2 > 0) {
 524                         output->write("$file: $.: $replace2: \\\n");
 525                         foreach my $replace2 (@replace2) {
 526                             output->write("'$replace2'\n");
 527                         }
 528                     } else {
 529                         output->write("$file: $.: $replace2: '$replace'\n");
 530                     }
 531                 }
 532             }
 533             print OUT "$_\n";
 534         }
 535
 536         return $modified;
 537     };
 538
 539     my $n = 0; while(defined(each %substitute_line)) { $n++; }
 540     if($n > 0) {
 541         edit_file($file, $editor);
 542     }
 543
 544     foreach my $module (sort(keys(%spec_file))) {
 545         my $file;
 546         foreach my $winapi (@winapis) {
 547             $file = ($winapi->module_file($module) || $file);
 548         }
 549
 550         if(defined($file)) {
 551             $file = file_normalize($file);
 552         }
 553
 554         my @substitutes = @{$spec_file{$module}};
 555
 556         my $editor = sub {
 557             local *IN = shift;
 558             local *OUT = shift;
 559
 560             my $modified = 0;
 561             while(<IN>) {
 562                 chomp;
 563
 564                 my @substitutes2 = ();
 565                 foreach my $substitute (@substitutes) {
 566                     my $search = $substitute->{search};
 567                     my $replace = $substitute->{replace};
 568
 569                     if(s/$search/$replace/) {
 570                         if(options->modify) {
 571                             $modified = 1;
 572                         } else {
 573                             output->write("$file: search : '$search'\n");
 574                             output->write("$file: replace: '$replace'\n");
 575                         }
 576                         next;
 577                     } else {
 578                         push @substitutes2, $substitute;
 579                     }
 580                 }
 581                 @substitutes = @substitutes2;
 582
 583                 print OUT "$_\n";
 584             }
 585
 586             return $modified;
 587         };
 588
 589         if(defined($file)) {
 590             edit_file($file, $editor);
 591         } else {
 592             output->write("$module: doesn't have any spec file\n");
 593         }
 594
 595         if($#substitutes >= 0) {
 596             foreach my $substitute (@substitutes) {
 597                 my $search = $substitute->{search};
 598                 my $replace = $substitute->{replace};
 599
 600                 output->write("$file: unmatched search : '$search'\n");
 601                 output->write("$file: unmatched replace: '$replace'\n");
 602             }
 603         }
 604
 605     }
 606 }
 607
 608 output->hide_progress;
 609
 610