Sweden-Number/tools/winapi/winapi_fixup

582 lines
15 KiB
Perl
Executable File

#!/usr/bin/perl -w
# Copyright 2001 Patrik Stridvall
use strict;
BEGIN {
$0 =~ m%^(.*?/?tools)/winapi/winapi_fixup$%;
require "$1/winapi/setup.pm";
}
use config qw(
&file_type &files_filter
&file_skip &files_skip
&file_normalize
&get_spec_files
&translate_calling_convention16 &translate_calling_convention32
$current_dir $wine_dir $winapi_dir $winapi_check_dir
);
use output;
use options;
use modules;
use util;
use winapi;
use winapi_parser;
my $output = output->new;
my %options_long = (
"debug" => { default => 0, description => "debug mode" },
"help" => { default => 0, description => "help mode" },
"verbose" => { default => 0, description => "verbose mode" },
"progress" => { default => 1, description => "show progress" },
"win16" => { default => 1, description => "Win16 fixup" },
"win32" => { default => 1, description => "Win32 fixup" },
"local" => { default => 1, description => "local fixup" },
"documentation" => { default => 1, parent => "local", description => "documentation fixup" },
"documentation-ordinal" => { default => 1, parent => "documentation", description => "documentation ordinal fixup" },
"documentation-missing" => { default => 0, parent => "documentation", description => "documentation missing fixup" },
"documentation-name" => { default => 1, parent => "documentation", description => "documentation name fixup" },
"stub" => { default => 0, parent => "local", description => "stub fixup" },
"global" => { default => 1, description => "global fixup" },
"modify" => { default => 0, description => "actually perform the fixups" },
);
my %options_short = (
"d" => "debug",
"?" => "help",
"v" => "verbose"
);
my $options_usage = "usage: winapi_fixup [--help] [<files>]\n";
my $options = options->new(\%options_long, \%options_short, $options_usage);
my $modules = modules->new($options, $output, $wine_dir, $current_dir, \&file_type, "$winapi_check_dir/modules.dat");
my $win16api = winapi->new($options, $output, "win16", "$winapi_check_dir/win16");
my $win32api = winapi->new($options, $output, "win32", "$winapi_check_dir/win32");
my @winapis = ($win16api, $win32api);
if($wine_dir eq ".") {
winapi->read_all_spec_files($modules, $wine_dir, $current_dir, \&file_type, $win16api, $win32api);
} else {
my @spec_files = $modules->allowed_spec_files($wine_dir, $current_dir);
winapi->read_spec_files($modules, $wine_dir, $current_dir, \@spec_files, $win16api, $win32api);
}
sub get_all_module_internal_ordinal {
my $internal_name = shift;
my @entries = ();
foreach my $winapi (@winapis) {
my @name = (); {
my $name = $winapi->function_external_name($internal_name);
if(defined($name)) {
@name = split(/ & /, $name);
}
}
my @module = (); {
my $module = $winapi->function_internal_module($internal_name);
if(defined($module)) {
@module = split(/ & /, $module);
}
}
my @ordinal = (); {
my $ordinal = $winapi->function_internal_ordinal($internal_name);
if(defined($ordinal)) {
@ordinal = split(/ & /, $ordinal);
}
}
my $name;
my $module;
my $ordinal;
while(defined($name = shift @name) &&
defined($module = shift @module) &&
defined($ordinal = shift @ordinal))
{
push @entries, [$name, $module, $ordinal];
}
}
return @entries;
}
sub get_all_module_external_ordinal {
my $external_name = shift;
my @entries = ();
foreach my $winapi (@winapis) {
my @name = (); {
my $name = $winapi->function_internal_name($external_name);
if(defined($name)) {
@name = split(/ & /, $name);
}
}
my @module = (); {
my $module = $winapi->function_external_module($external_name);
if(defined($module)) {
@module = split(/ & /, $module);
}
}
my @ordinal = (); {
my $ordinal = $winapi->function_external_ordinal($external_name);
if(defined($ordinal)) {
@ordinal = split(/ & /, $ordinal);
}
}
my $name;
my $module;
my $ordinal;
while(defined($name = shift @name) &&
defined($module = shift @module) &&
defined($ordinal = shift @ordinal))
{
push @entries, [$name, $module, $ordinal];
}
}
return @entries;
}
sub normalize_set {
local $_ = shift;
if(!defined($_)) {
return undef;
}
my %hash = ();
foreach my $key (split(/\s*&\s*/)) {
$hash{$key}++;
}
return join(" & ", sort(keys(%hash)));
}
my @c_files = options->c_files;
@c_files = files_skip(@c_files);
@c_files = files_filter("winelib", @c_files);
my $progress_output;
my $progress_current = 0;
my $progress_max = scalar(@c_files);
foreach my $file (@c_files) {
my %substitute_line;
my %insert_line;
my %spec_file;
$progress_current++;
if(options->progress) {
output->progress("$file: file $progress_current of $progress_max");
}
my $found_function = sub {
my $line = shift;
my $refdebug_channels = shift;
my @debug_channels = @$refdebug_channels;
my $documentation = shift;
my $linkage = shift;
my $return_type = shift;
my $calling_convention = shift;
my $internal_name = shift;
my $refargument_types = shift;
my @argument_types = @$refargument_types;
my $refargument_names = shift;
my @argument_names = @$refargument_names;
my $refargument_documentations = shift;
my @argument_documentations = @$refargument_documentations;
my $statements = shift;
if($linkage eq "static" || $linkage eq "extern" || !defined($statements)) {
return;
}
my @external_names = ();
foreach my $winapi (@winapis) {
my $external_names = $winapi->function_external_name($internal_name);
if(defined($external_names)) {
push @external_names, split(/\s*&\s*/, $external_names);
}
}
if($#external_names < 0) {
return;
}
my $module16 = $win16api->function_internal_module($internal_name);
my $module32 = $win32api->function_internal_module($internal_name);
my $prefix = "";
$prefix .= "$file: ";
if(defined($module16) && !defined($module32)) {
$prefix .= normalize_set($module16) . ": ";
} elsif(!defined($module16) && defined($module32)) {
$prefix .= normalize_set($module32) . ": ";
} elsif(defined($module16) && defined($module32)) {
$prefix .= normalize_set($module16) . " & " . normalize_set($module32) . ": ";
} else {
$prefix .= "<>: ";
}
$prefix .= "$return_type ";
$prefix .= "$calling_convention " if $calling_convention;
$prefix .= "$internal_name(" . join(",", @argument_types) . "): ";
$output->prefix($prefix);
my $calling_convention16 = translate_calling_convention16($calling_convention);
my $calling_convention32 = translate_calling_convention32($calling_convention);
my $documention_modified = 0;
if(($documentation && !$documention_modified) &&
(options->documentation_name || options->documentation_ordinal))
{
local $_;
my %found_external_names;
foreach my $external_name (@external_names) {
$found_external_names{$external_name} = 0;
}
my $line3;
my $search;
my $replace;
my $count = 0;
my $line2 = $line - 1;
foreach (split(/\n/, $documentation)) {
$line2++;
if(/^(\s*\*\s*(\w+|\@)\s*)((?:\s*[\(\[]\s*\w+(?:\s*\.\s*[^\s\)\]]*\s*)?[\)\]])+)(.*?)$/) {
my $part1 = $1;
my $external_name = $2;
my $part3 = $3;
my $part4 = $4;
$part4 =~ s/\s*$//;
my @entries = ();
while($part3 =~ s/^\s*([\(\[]\s*(\w+)(?:\s*\.\s*([^\s\)\]]*)\s*)?[\)\]])//) {
push @entries, [$1, $2, $3];
}
my $found = 0;
foreach my $external_name2 (@external_names) {
if($external_name eq $external_name2) {
$found_external_names{$external_name2} = 1;
$found = 1;
last;
}
}
my $replaced = 0;
my $replace2 = "";
foreach my $entry (@entries) {
my $part12 = $part1;
(my $part32, my $module, my $ordinal) = @$entry;
foreach my $entry2 (get_all_module_internal_ordinal($internal_name)) {
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
if(options->documentation_name && lc($module) eq $module2 &&
$external_name ne $external_name2)
{
if(!$found && $part12 =~ s/\b\Q$external_name\E\b/$external_name2/) {
$external_name = $external_name2;
$replaced++;
}
}
if(options->documentation_ordinal &&
$external_name eq $external_name2 &&
lc($module) eq $module2 &&
($#entries > 0 || !defined($ordinal) || ($ordinal ne $ordinal2)))
{
if(defined($ordinal)) {
if($part32 =~ s/\Q$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
$replaced++;
}
} else {
if($part32 =~ s/\Q$module\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
$replaced++;
}
}
}
}
if($replace2) { $replace2 .= "\n"; }
$replace2 .= "$part12$part32$part4";
}
if($replaced > 0) {
$line3 = $line2;
$search = "^\Q$_\E\$";
$replace = $replace2;
}
$count++;
} elsif(/^(\s*\*\s*)(\w+|\@)\s*$/) {
my $part1 = $1;
my $external_name = $2;
if($internal_name eq $external_name) {
foreach my $entry (get_all_module_internal_ordinal($internal_name)) {
(my $external_name2, my $module, my $ordinal) = @$entry;
$line3 = $line2;
$search = "^\Q$_\E\$";
$replace = "$part1$external_name2 (\U$module\E.$ordinal)";
}
}
$count++;
}
}
if(defined($line3) && defined($search) && defined($replace)) {
if($count > 1 || $#external_names >= 1) {
output->write("multiple entries (fixup not supported)\n");
# output->write("s/$search/$replace/\n");
} else {
$substitute_line{$line3}{search} = $search;
$substitute_line{$line3}{replace} = $replace;
}
}
if(options->documentation_missing) {
foreach my $external_name (keys(%found_external_names)) {
if(!$found_external_names{$external_name}) {
output->write("$external_name missing (fixup not supported)\n");
}
}
}
}
if(0 && !$documentation) {
# FIXME: Not correct
my $external_name;
my $module;
my $ordinal;
foreach my $winapi (@winapis) {
$external_name = ($winapi->function_external_name($internal_name) || $external_name);
$module = ($winapi->function_internal_module($internal_name) || $module);
$ordinal = ($winapi->function_internal_ordinal($internal_name) || $ordinal);
if(defined($external_name) || defined($module) || defined($ordinal)) { last; }
}
if(defined($external_name) && defined($module) && defined($ordinal)) {
$insert_line{$line} =
"/" . "*" x 71 . "\n" .
" *\t\t$external_name (\U$module\E.$ordinal)\n" .
" */\n";
}
}
if(options->stub) {
# FIXME: Not correct
foreach my $winapi (@winapis) {
if($winapi->function_stub($internal_name)) {
my $module = $winapi->function_internal_module($internal_name);
my $ordinal = $winapi->function_internal_ordinal($internal_name);
my $external_name = $internal_name;
if($winapi->name eq "win16") {
$external_name =~ s/(?:_)?16([AW]?)$//;
if(defined($1)) {
$external_name .= $1;
}
}
my $abort = 0;
my $n;
my @argument_kinds = map {
my $type = $_;
my $kind = "unknown";
$winapi->type_used_in_module($type, $module);
if(!defined($kind = $winapi->translate_argument($type))) {
output->write("no translation defined: " . $type . "\n");
}
# FIXME: Kludge
if(defined($kind) && $kind eq "longlong") {
$n += 2;
("long", "long");
} elsif(defined($kind)) {
$n++;
$kind;
} else {
$abort = 1;
$n++;
"undef";
}
} @argument_types;
my $substitute = {};
$substitute->{search} = "^\\s*$ordinal\\s+stub\\s+$external_name\\s*(?:#.*?)?\$";
if($winapi->name eq "win16") {
$substitute->{replace} = "$ordinal $calling_convention16 $external_name(@argument_kinds) $internal_name";
} else {
$substitute->{replace} = "$ordinal $calling_convention32 $external_name(@argument_kinds) $internal_name";
}
if(!defined($spec_file{$module})) {
$spec_file{$module} = [];
}
if(!$abort) {
push @{$spec_file{$module}}, $substitute;
}
}
}
}
$output->prefix("");
};
my $found_preprocessor = sub {
my $directive = shift;
my $argument = shift;
};
winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
my $editor = sub {
local *IN = shift;
local *OUT = shift;
my $modified = 0;
while(<IN>) {
chomp;
my $line = $insert_line{$.};
if(defined($line)) {
if(options->modify) {
$_ = "$line$_";
$modified = 1;
} else {
output->write("$file: $.: insert : '$line'\n");
}
}
my $search = $substitute_line{$.}{search};
my $replace = $substitute_line{$.}{replace};
if(defined($search) && defined($replace)) {
my $modified2 = 0;
if(s/$search/$replace/) {
if(options->modify) {
$modified = 1;
}
$modified2 = 1;
}
if(!options->modify || !$modified2) {
my $search2;
my $replace2;
if(!$modified2) {
$search2 = "unmatched search";
$replace2 = "unmatched replace";
} else {
$search2 = "search";
$replace2 = "replace";
}
output->write("$file: $.: $search2 : '$search'\n");
my @replace2 = split(/\n/, $replace);
if($#replace2 > 0) {
output->write("$file: $.: $replace2: \\\n");
foreach my $replace2 (@replace2) {
output->write("'$replace2'\n");
}
} else {
output->write("$file: $.: $replace2: '$replace'\n");
}
}
}
print OUT "$_\n";
}
return $modified;
};
my $n = 0; while(defined(each %substitute_line)) { $n++; }
if($n > 0) {
edit_file($file, $editor);
}
foreach my $module (sort(keys(%spec_file))) {
my $file;
foreach my $winapi (@winapis) {
$file = ($winapi->module_file($module) || $file);
}
if(defined($file)) {
$file = file_normalize($file);
}
my @substitutes = @{$spec_file{$module}};
my $editor = sub {
local *IN = shift;
local *OUT = shift;
my $modified = 0;
while(<IN>) {
chomp;
my @substitutes2 = ();
foreach my $substitute (@substitutes) {
my $search = $substitute->{search};
my $replace = $substitute->{replace};
if(s/$search/$replace/) {
if(options->modify) {
$modified = 1;
} else {
output->write("$file: search : '$search'\n");
output->write("$file: replace: '$replace'\n");
}
next;
} else {
push @substitutes2, $substitute;
}
}
@substitutes = @substitutes2;
print OUT "$_\n";
}
return $modified;
};
if(defined($file)) {
edit_file($file, $editor);
} else {
output->write("$module: doesn't have any spec file\n");
}
if($#substitutes >= 0) {
foreach my $substitute (@substitutes) {
my $search = $substitute->{search};
my $replace = $substitute->{replace};
output->write("$file: unmatched search : '$search'\n");
output->write("$file: unmatched replace: '$replace'\n");
}
}
}
}
output->hide_progress;