Sweden-Number/tools/winapi/winapi_extract

#!/usr/bin/perl -w

# Copyright 2001 Patrik Stridvall

use strict;

BEGIN {
    $0 =~ m%^(.*?/?tools)/winapi/winapi_extract$%;
    require "$1/winapi/setup.pm";
}

use config qw(
    &file_type &files_skip &files_filter &get_spec_files
    $current_dir $wine_dir $winapi_dir $winapi_check_dir
);
use modules;
use nativeapi;
use output;
use options;
use winapi;
use winapi_function;
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 extraction" },
    "win32" => { default => 1, description => "Win32 extraction" },

    "local" =>  { default => 1, description => "local extraction" },
    "global" => { default => 1, description => "global extraction" },

    "spec-files" => { default => 1, parent => "global", description => "spec files extraction" },
    "stub-statistics" => { default => 0, parent => "global", description => "stub statistics" },
);

my %options_short = (
    "d" => "debug",
    "?" => "help",
    "v" => "verbose"
);

my $options_usage = "usage: winapi_extract [--help] [<files>]\n";

my $options = 'options'->new(\%options_long, \%options_short, $options_usage);

my %module2spec_file;
my %module2type;
{
    local $_;

    foreach my $spec_file (get_spec_files("winelib")) {
	my $module;
	my $type;

	open(IN, "< $wine_dir/$spec_file");
	while(<IN>) {
	    s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begining and end of line
	    s/^(.*?)\s*#.*$/$1/;  # remove comments
	    /^$/ && next;         # skip empty lines

	    if(/^name\s+(.*?)$/) {
		$module = $1;
		$module2spec_file{$module} = $spec_file;
	    } elsif(/^type\s+(.*?)$/) {
		$type = $1;
		$module2type{$module} = $type;
	    }
	}
	close(IN);
    }
}

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 $nativeapi = 'nativeapi'->new($options, $output, "$winapi_check_dir/nativeapi.dat", 
				 "$wine_dir/configure.in", "$wine_dir/include/config.h.in");

my %specifications;

sub documentation_specifications {
    my $function = shift;

    my @debug_channels = @{$function->debug_channels};
    my $documentation = $function->documentation;
    my $documentation_line = $function->documentation_line;
    my $return_type = $function->return_type;
    my $linkage = $function->linkage;
    my $internal_name = $function->internal_name;
    my @argument_types = @{$function->argument_types};

    if($linkage eq "static") {
	return;
    }

    local $_;
    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($ordinal eq "@") {
		if(1 || !exists($specifications{$module}{unfixed}{$external_name})) {
		    $specifications{$module}{unfixed}{$external_name}{ordinal} = $ordinal;
		    $specifications{$module}{unfixed}{$external_name}{external_name} = $external_name;
		    $specifications{$module}{unfixed}{$external_name}{function} = $function;
		} else {
		    $output->write("$external_name ($module.$ordinal) already exists\n");
		}
	    } elsif($ordinal =~ /^\d+$/) {
		if(1 || !exists($specifications{$module}{fixed}{$ordinal})) {
		    $specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
		    $specifications{$module}{fixed}{$ordinal}{external_name} = $external_name;
		    $specifications{$module}{fixed}{$ordinal}{function} = $function;
		    } else {
			$output->write("$external_name ($module.$ordinal) already exists\n");
		    }
	    } elsif($ordinal eq "init") {
		if(!exists($specifications{$module}{init})) {
		    $specifications{$module}{init}{function} = $function;
		} else {
		    $output->write("$external_name ($module.$ordinal) already exists\n");
		}
	    } else {
		if(!exists($specifications{$module}{unknown}{$external_name})) {
		    $specifications{$module}{unknown}{$external_name}{ordinal} = $ordinal;
		    $specifications{$module}{unknown}{$external_name}{external_name} = $external_name;
		    $specifications{$module}{unknown}{$external_name}{function} = $function;
		} else {
		    $output->write("$external_name ($module.$ordinal) already exists\n");
		}
	    }
	    
	    if($options->debug) {
		$output->write("$external_name ($module.$ordinal)\n");
	    }
	}
    }
}

my %module_pseudo_stub_count16;
my %module_pseudo_stub_count32;

sub statements_stub {
    my $function = shift;

    my $statements = $function->statements;
    if(defined($statements) && $statements =~ /FIXME[^;]*stub/s) {
	if($options->win16) {
	    foreach my $module16 ($function->modules16) {
		$module_pseudo_stub_count16{$module16}++;
	    }
	}
	if($options->win32) {
	    foreach my $module32 ($function->modules32) {
		$module_pseudo_stub_count32{$module32}++;
	    }
	}
    }
}

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

    $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;

	$functions{$internal_name} = $function;

	$output->prefix("$file: " . $function->prefix);

	if($options->spec_files) {
	    documentation_specifications($function);
	}

	if($options->stub_statistics) {
	    statements_stub($function);
	}

	$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 @internal_names = keys(%functions);
    if($#internal_names < 0) {
	$output->write("$file: doesn't contain any functions\n");
    }
}

sub output_function {
    local *OUT = shift;
    my $type = shift;
    my $ordinal = shift;
    my $external_name = shift;
    my $function = shift;

    my $internal_name = $function->internal_name;

    my $return_kind;
    my $calling_convention;
    my @argument_kinds;
    if($type eq "win16") {
	$return_kind = $function->return_kind16 || "undef";
	$calling_convention = $function->calling_convention16 || "undef";
	@argument_kinds = map { $_ || "undef"; } @{$function->argument_kinds16};
    } elsif($type eq "win32") {
	$return_kind = $function->return_kind32 || "undef";
	$calling_convention = $function->calling_convention32 || "undef";
	@argument_kinds = map { $_ || "undef"; } @{$function->argument_kinds32};
    }

    print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
}

if($options->spec_files) {
    foreach my $module (keys(%specifications)) {
	my $spec_file = $module2spec_file{$module};
	my $type = $module2type{$module};
	
	if(!defined($spec_file) || !defined($type)) {
	    $output->write("$module: doesn't exist\n");
	    next;
	}
	
	$spec_file .= "2";
	
	$output->progress("$spec_file");
	open(OUT, "> $wine_dir/$spec_file");

	print OUT "name $module\n";
	print OUT "type $type\n";
	if(exists($specifications{$module}{init})) {
	    my $function = $specifications{$module}{init}{function};
	    print OUT "init " . $function->internal_name . "\n";
	}
	print OUT "\n";
	
	my %debug_channels;
	if(exists($specifications{$module}{init})) {
	    my $function = $specifications{$module}{init}{function};
	    foreach my $debug_channel (@{$function->debug_channels}) {
		$debug_channels{$debug_channel}++;
	    }
	}
	foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
	    my $function = $specifications{$module}{fixed}{$ordinal}{function};
	    foreach my $debug_channel (@{$function->debug_channels}) {
		$debug_channels{$debug_channel}++;
	    }
	}
	foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
	    my $function = $specifications{$module}{unfixed}{$name}{function}; 
	    foreach my $debug_channel (@{$function->debug_channels}) {
		$debug_channels{$debug_channel}++;
	    }
	}
	foreach my $name (sort(keys(%{$specifications{$module}{unknown}}))) {
	    my $function = $specifications{$module}{unknown}{$name}{function};
	    foreach my $debug_channel (@{$function->debug_channels}) {
		$debug_channels{$debug_channel}++;
	    }
	}

	my @debug_channels = sort(keys(%debug_channels));
	if($#debug_channels >= 0) { 
	    print OUT "debug_channels (" .  join(" ", @debug_channels) . ")\n";
	    print OUT "\n";
	}
	
	my $empty = 1;

	if(!$empty) {
	    print OUT "\n";
	    $empty = 1;
	}
	foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
	    my $entry = $specifications{$module}{unknown}{$external_name};
	    my $ordinal = $entry->{ordinal}; 
	    my $function = $entry->{function}; 
	    print OUT "# ";
	    output_function(\*OUT, $type, $ordinal, $external_name, $function);
	    $empty = 0;
	}

	if(!$empty) {
	    print OUT "\n";
	    $empty = 1;
	}
	foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
	    my $entry = $specifications{$module}{fixed}{$ordinal};
	    my $external_name = $entry->{external_name}; 
	    my $function = $entry->{function}; 
	    output_function(\*OUT, $type, $ordinal, $external_name, $function);
	    $empty = 0;
	}

	if(!$empty) {
	    print OUT "\n";
	    $empty = 1;
	}
	foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
	    my $entry = $specifications{$module}{unfixed}{$external_name};
	    my $ordinal = $entry->{ordinal};
	    my $function = $entry->{function};
	    output_function(\*OUT, $type, $ordinal, $external_name, $function);
	    $empty = 0;
	}

	close(OUT);
    }
}

if($options->stub_statistics) {
    foreach my $winapi (@winapis) {
	if($winapi->name eq "win16" && !$options->win16) { next; }
	if($winapi->name eq "win32" && !$options->win32) { next; }

	my %module_stub_count;
	my %module_total_count;
	
	foreach my $internal_name ($winapi->all_internal_functions,$winapi->all_functions_stub) {
	    foreach my $module (split(/ \& /, $winapi->function_internal_module($internal_name))) {
		if($winapi->function_stub($internal_name)) {
		    $module_stub_count{$module}++;
		}
		$module_total_count{$module}++;
	    }
	}

	foreach my $module ($winapi->all_modules) {
	    my $pseudo_stubs;
	    if($winapi->name eq "win16") {
		$pseudo_stubs = $module_pseudo_stub_count16{$module};
	    } elsif($winapi->name eq "win32") {
		$pseudo_stubs = $module_pseudo_stub_count32{$module};
	    }

	    my $real_stubs = $module_stub_count{$module};
	    my $total = $module_total_count{$module};

	    if(!defined($real_stubs)) { $real_stubs = 0; }
	    if(!defined($pseudo_stubs)) { $pseudo_stubs = 0; }
	    if(!defined($total)) { $total = 0;}

	    my $stubs = $real_stubs + $pseudo_stubs;
    
	    $output->write("*.c: $module: ");
	    $output->write("$stubs of $total functions are stubs ($real_stubs real, $pseudo_stubs pseudo)\n");
	}
    } 
}

$output->hide_progress;