Sweden-Number/tools/winapi/winapi_fixup

#!/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 qw($output);
use modules;
use util;
use winapi;
use winapi_parser;
use winapi_fixup_options qw($options);

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 %documentation_line_used;

    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 $statements = $function->statements;

	if($linkage eq "static" ||
	   ($linkage eq "extern" && !defined($statements)) ||
	   ($linkage eq "" && !defined($statements)))
	{
	    return;
	}

	my @external_names = $function->external_names;
	if($#external_names < 0) {
	    return;
	}

	if($documentation_line_used{$documentation_line}) {
	    $documentation = undef;
	}
	$documentation_line_used{$documentation_line}++;
    
	$output->prefix_callback(sub { return $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 && defined($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 $refargument_types = $function->argument_types;

		    if(!defined($refargument_types)) {
			next;
		    }

		    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";
			}
		    } @$refargument_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 &&
	   (defined($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 && defined($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) {
			$documentation_modified = 1;

			$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 && 
	   defined($documentation) &&
	   $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) {
			    $documentation_modified = 1;

			    $delete_line{$line2} = "^\Q$_\E\$";
			} else {
			    $output->write("$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n");
			};
		    }
		}
	    }
	}

	if(!$spec_modified && !$documentation_modified && !defined($documentation))
	{
	    my $insert = "";
	    foreach my $winapi (@winapis) {
		my $external_name = $winapi->function_external_name($internal_name);
		my $module = $winapi->function_internal_module($internal_name);
		my $ordinal = $winapi->function_internal_ordinal($internal_name);

		if(defined($external_name) && defined($module) && defined($ordinal)) {
		    $insert .= " *\t\t$external_name (\U$module\E.$ordinal)\n";
		}
	    }
	    if($insert) {
		$insert_line{$function_line} = 
		    "/" . "*" x 71 . "\n" .
		    "$insert" .
		    " */\n";
	    }
	}

	$output->prefix("");
    };

    my $found_preprocessor = sub {
	my $directive = shift;
	my $argument = shift;
    };

    &winapi_parser::parse_c_file($options, $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;