622 lines
16 KiB
Perl
Executable File
622 lines
16 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
|
|
$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-missing" => { default => 1, parent => "documentation", description => "documentation missing fixup" },
|
|
"documentation-name" => { default => 1, parent => "documentation", description => "documentation name fixup" },
|
|
"documentation-ordinal" => { default => 1, parent => "documentation", description => "documentation ordinal fixup" },
|
|
"documentation-wrong" => { default => 1, parent => "documentation", description => "documentation wrong 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);
|
|
}
|
|
|
|
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 %insert_line;
|
|
my %substitute_line;
|
|
my %delete_line;
|
|
|
|
my %spec_file;
|
|
|
|
$progress_current++;
|
|
if($options->progress) {
|
|
$output->progress("$file: file $progress_current of $progress_max");
|
|
}
|
|
|
|
my $found_function = sub {
|
|
my $function = shift;
|
|
|
|
my $documentation_line = $function->documentation_line;
|
|
my $documentation = $function->documentation;
|
|
my $function_line = $function->function_line;
|
|
my $linkage = $function->linkage;
|
|
my $return_type = $function->return_type;
|
|
my $calling_convention = $function->calling_convention;
|
|
my $internal_name = $function->internal_name;
|
|
my @argument_types = @{$function->argument_types};
|
|
my @argument_names = @{$function->argument_names};
|
|
my @argument_documentations = @{$function->argument_documentations};
|
|
my $statements = $function->statements;
|
|
|
|
if($linkage eq "static" || ($linkage eq "" && !defined($statements))) {
|
|
return;
|
|
}
|
|
|
|
my @external_names = $function->external_names;
|
|
if($#external_names < 0) {
|
|
return;
|
|
}
|
|
|
|
$output->prefix("$file: " . $function->prefix);
|
|
|
|
my @module_ordinal_entries = ();
|
|
foreach my $entry2 ($function->get_all_module_ordinal) {
|
|
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
|
if(($external_name2 eq "@" ||
|
|
($win16api->is_module($module2) && !$win16api->is_function_stub_in_module($module2, $external_name2)) ||
|
|
($win32api->is_module($module2) && !$win32api->is_function_stub_in_module($module2, $external_name2))) &&
|
|
$modules->is_allowed_module_in_file($module2, "$current_dir/$file"))
|
|
{
|
|
push @module_ordinal_entries, $entry2;
|
|
}
|
|
}
|
|
|
|
my $spec_modified = 0;
|
|
|
|
if($options->stub && $documentation) {
|
|
my $calling_convention16 = $function->calling_convention16;
|
|
my $calling_convention32 = $function->calling_convention32;
|
|
|
|
foreach my $winapi (@winapis) {
|
|
my @entries = ();
|
|
my $module = $winapi->function_internal_module($internal_name);
|
|
my $ordinal = $winapi->function_internal_ordinal($internal_name);
|
|
|
|
if($winapi->is_function_stub_in_module($module, $internal_name)) {
|
|
my $external_name = $internal_name;
|
|
if($winapi->name eq "win16") {
|
|
$external_name =~ s/(?:_)?16([AW]?)$//;
|
|
if(defined($1)) {
|
|
$external_name .= $1;
|
|
}
|
|
}
|
|
push @entries, [$external_name, $module, $ordinal];
|
|
}
|
|
|
|
foreach (split(/\n/, $documentation)) {
|
|
if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
|
|
my $external_name = $1;
|
|
my $module = lc($2);
|
|
my $ordinal = $3;
|
|
|
|
if($external_name ne "@" &&
|
|
$winapi->is_module($module) &&
|
|
$winapi->is_function_stub_in_module($module, $external_name) &&
|
|
$internal_name !~ /^\U$module\E_\Q$external_name\E$/)
|
|
{
|
|
push @entries, [$external_name, $module, $ordinal];
|
|
}
|
|
}
|
|
}
|
|
|
|
foreach my $entry (@entries) {
|
|
(my $external_name, my $module, my $ordinal) = @$entry;
|
|
|
|
my $abort = 0;
|
|
my $n;
|
|
my @argument_kinds = map {
|
|
my $type = $_;
|
|
my $kind;
|
|
if($type ne "..." && !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;
|
|
} elsif($type eq "...") {
|
|
if($winapi->name eq "win16") {
|
|
$calling_convention16 = "pascal"; # FIXME: Is this correct?
|
|
} else {
|
|
$calling_convention32 = "varargs";
|
|
}
|
|
();
|
|
} 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) {
|
|
$spec_modified = 1;
|
|
push @{$spec_file{$module}}, $substitute;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
my %found_external_names;
|
|
foreach my $external_name (@external_names) {
|
|
$found_external_names{$external_name} = {};
|
|
}
|
|
|
|
my $documentation_modified = 0;
|
|
|
|
if(!$spec_modified &&
|
|
($documentation && !$documentation_modified) &&
|
|
($options->documentation_name || $options->documentation_ordinal ||
|
|
$options->documentation_missing))
|
|
{
|
|
local $_;
|
|
|
|
my $line3;
|
|
my $search;
|
|
my $replace;
|
|
|
|
my $count = 0;
|
|
my $line2 = $documentation_line - 1;
|
|
foreach (split(/\n/, $documentation)) {
|
|
$line2++;
|
|
if(/^(\s*\*\s*(\S+)\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) {
|
|
foreach my $entry (@entries) {
|
|
(undef, my $module, undef) = @$entry;
|
|
$found_external_names{$external_name2}{$module} = 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 (@module_ordinal_entries) {
|
|
(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*)([^\s\(]+)(?:\(\))?\s*$/) {
|
|
my $part1 = $1;
|
|
my $external_name = $2;
|
|
|
|
if($internal_name =~ /^(?:\S+_)?\Q$external_name\E(?:16)?$/) {
|
|
foreach my $entry (@module_ordinal_entries) {
|
|
(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");
|
|
# $output->write("@external_names\n");
|
|
} else {
|
|
$documentation_modified = 1;
|
|
$substitute_line{$line3}{search} = $search;
|
|
$substitute_line{$line3}{replace} = $replace;
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
if(!$spec_modified && !$documentation_modified &&
|
|
$options->documentation_missing && $documentation)
|
|
{
|
|
my $part1;
|
|
my $part2;
|
|
my $part3;
|
|
my $part4;
|
|
my $line3 = 0;
|
|
|
|
my $line2 = $documentation_line - 1;
|
|
foreach (split(/\n/, $documentation)) {
|
|
$line2++;
|
|
if(/^(\s*\*\s*)(\S+\s*)([\(\[])\s*\w+\s*\.\s*[^\s\)\]]*\s*([\)\]]).*?$/) {
|
|
$part1 = $1;
|
|
$part2 = $2;
|
|
$part3 = $3;
|
|
$part4 = $4;
|
|
|
|
$part2 =~ s/\S/ /g;
|
|
|
|
$line3 = $line2 + 1;
|
|
}
|
|
}
|
|
|
|
foreach my $entry2 (@module_ordinal_entries) {
|
|
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
|
|
|
my $found = 0;
|
|
foreach my $external_name (keys(%found_external_names)) {
|
|
foreach my $module3 (keys(%{$found_external_names{$external_name}})) {
|
|
if($external_name eq $external_name2 && uc($module2) eq $module3) {
|
|
$found = 1;
|
|
}
|
|
}
|
|
}
|
|
# FIXME: Not 100% correct
|
|
if(!$found &&
|
|
!$win16api->is_function_stub_in_module($module2, $internal_name) &&
|
|
!$win32api->is_function_stub_in_module($module2, $internal_name))
|
|
{
|
|
if($line3 > 0) {
|
|
$part2 = $external_name2 . " " x (length($part2) - length($external_name2));
|
|
$insert_line{$line3} = "$part1$part2$part3\U$module2\E.$ordinal2$part4\n";
|
|
} else {
|
|
$output->write("$external_name2 (\U$module2\E.$ordinal2) missing (fixup not supported)\n");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if(!$documentation_modified &&
|
|
$options->documentation_wrong)
|
|
{
|
|
my $line2 = $documentation_line - 1;
|
|
foreach (split(/\n/, $documentation)) {
|
|
$line2++;
|
|
if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
|
|
my $external_name = $1;
|
|
my $module = $2;
|
|
my $ordinal = $3;
|
|
|
|
my $found = 0;
|
|
foreach my $entry2 (@module_ordinal_entries) {
|
|
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
|
|
|
if($external_name eq $external_name2 &&
|
|
lc($module) eq $module2 &&
|
|
$ordinal eq $ordinal2)
|
|
{
|
|
$found = 1;
|
|
}
|
|
}
|
|
if(!$found) {
|
|
if(1) {
|
|
$delete_line{$line2} = "^\Q$_\E\$";
|
|
} else {
|
|
$output->write("$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n");
|
|
};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if(0) # !$spec_modified && !$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{$function_line} =
|
|
"/" . "*" x 71 . "\n" .
|
|
" *\t\t$external_name (\U$module\E.$ordinal)\n" .
|
|
" */\n";
|
|
}
|
|
}
|
|
|
|
$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;
|
|
|
|
$line = $insert_line{$.};
|
|
if(defined($line)) {
|
|
if($options->modify) {
|
|
$_ = "$line$_";
|
|
$modified = 1;
|
|
} else {
|
|
my $line2 = $line; chomp($line2);
|
|
my @line2 = split(/\n/, $line2);
|
|
if($#line2 > 0) {
|
|
$output->write("$file: $.: insert: \\\n");
|
|
foreach my $line2 (@line2) {
|
|
$output->write("'$line2'\n");
|
|
}
|
|
} else {
|
|
$output->write("$file: $.: insert: '$line2'\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");
|
|
}
|
|
}
|
|
}
|
|
|
|
$line = $delete_line{$.};
|
|
if(defined($line)) {
|
|
if(/$line/) {
|
|
if($options->modify) {
|
|
$modified = 1;
|
|
next;
|
|
} else {
|
|
$output->write("$file: $.: delete: '$line'\n");
|
|
}
|
|
} else {
|
|
$output->write("$file: $.: unmatched delete: '$line'\n");
|
|
}
|
|
}
|
|
|
|
print OUT "$_\n";
|
|
}
|
|
|
|
return $modified;
|
|
};
|
|
|
|
my $n = 0;
|
|
while(defined(each %insert_line)) { $n++; }
|
|
while(defined(each %substitute_line)) { $n++; }
|
|
while(defined(each %delete_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;
|
|
|
|
|