forked from Mirrors/wine-wine
610 lines
17 KiB
Perl
610 lines
17 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
# Copyright 2002 Patrik Stridvall
|
|
#
|
|
# This library is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU Lesser General Public
|
|
# License as published by the Free Software Foundation; either
|
|
# version 2.1 of the License, or (at your option) any later version.
|
|
#
|
|
# This library is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
# Lesser General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU Lesser General Public
|
|
# License along with this library; if not, write to the Free Software
|
|
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
|
|
#
|
|
|
|
use strict;
|
|
|
|
BEGIN {
|
|
$0 =~ m%^(.*?/?tools)/winapi/winapi_extract$%;
|
|
require "$1/winapi/setup.pm";
|
|
}
|
|
|
|
use config qw(
|
|
files_skip files_filter get_spec_files
|
|
$current_dir $wine_dir $winapi_dir
|
|
);
|
|
use output qw($output);
|
|
use winapi_extract_options qw($options);
|
|
|
|
if($options->progress) {
|
|
$output->enable_progress;
|
|
} else {
|
|
$output->disable_progress;
|
|
}
|
|
|
|
use c_parser;
|
|
use function;
|
|
use type;
|
|
|
|
use winapi_function;
|
|
|
|
use vars qw($win16api $win32api @winapis);
|
|
if ($options->implemented || $options->stub_statistics || $options->winetest) {
|
|
require winapi;
|
|
import winapi qw($win16api $win32api @winapis);
|
|
}
|
|
|
|
my %module2entries;
|
|
my %module2spec_file;
|
|
if($options->winetest) {
|
|
local $_;
|
|
|
|
foreach my $spec_file (get_spec_files("winelib")) {
|
|
my $entries = [];
|
|
|
|
my $module = $spec_file;
|
|
$module =~ s/^.*?([^\/]*)\.spec$/$1/;
|
|
|
|
my $type = "win32";
|
|
|
|
open(IN, "< $wine_dir/$spec_file") || die "Error: Can't open $wine_dir/$spec_file: $!\n";
|
|
|
|
my $header = 1;
|
|
my $lookahead = 0;
|
|
while($lookahead || defined($_ = <IN>)) {
|
|
$lookahead = 0;
|
|
|
|
s/^\s*?(.*?)\s*$/$1/; # remove whitespace at beginning and end of line
|
|
s/^(.*?)\s*#.*$/$1/; # remove comments
|
|
/^$/ && next; # skip empty lines
|
|
|
|
if($header) {
|
|
if(/^(?:\d+|@)/) {
|
|
$header = 0;
|
|
$lookahead = 1;
|
|
}
|
|
next;
|
|
}
|
|
|
|
if(/^(\d+|@)\s+stdcall\s+(\w+)\s*\(\s*([^\)]*)\s*\)/) {
|
|
my $ordinal = $1;
|
|
my $name = $2;
|
|
my @args = split(/\s+/, $3);
|
|
|
|
push @$entries, [$name, "undef", \@args];
|
|
}
|
|
}
|
|
close(IN);
|
|
|
|
$module2spec_file{$module} = $spec_file;
|
|
$module2entries{$module} = $entries;
|
|
}
|
|
}
|
|
|
|
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;
|
|
|
|
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;
|
|
|
|
sub statements_pseudo_stub($) {
|
|
my $function = shift;
|
|
|
|
my $pseudo_stub = 0;
|
|
my $statements = $function->statements;
|
|
if(defined($statements) && $statements =~ /FIXME[^;]*stub/s) {
|
|
if($options->win16) {
|
|
my $external_name16 = $function->external_name16;
|
|
foreach my $module16 ($function->modules16) {
|
|
$module_pseudo_stub{$module16}{$external_name16}++;
|
|
$pseudo_stub = 1;
|
|
}
|
|
}
|
|
if($options->win32) {
|
|
my $external_name32 = $function->external_name32;
|
|
foreach my $module32 ($function->modules32) {
|
|
$module_pseudo_stub{$module32}{$external_name32}++;
|
|
$pseudo_stub = 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
return $pseudo_stub;
|
|
}
|
|
|
|
my @h_files = ();
|
|
if($options->headers) {
|
|
@h_files = $options->h_files;
|
|
@h_files = files_skip(@h_files);
|
|
@h_files = files_filter("winelib", @h_files);
|
|
}
|
|
|
|
my @c_files = ();
|
|
if($options->pseudo_implemented || $options->pseudo_stub_statistics) {
|
|
@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(@h_files) + scalar(@c_files);
|
|
|
|
foreach my $file (@h_files, @c_files) {
|
|
my %functions;
|
|
|
|
$progress_current++;
|
|
|
|
{
|
|
open(IN, "< $file") || die "Error: Can't open $file: $!\n";
|
|
local $/ = undef;
|
|
$_ = <IN>;
|
|
close(IN);
|
|
}
|
|
|
|
my $max_line = 0;
|
|
{
|
|
local $_ = $_;
|
|
while(s/^.*?\n//) { $max_line++; }
|
|
if($_) { $max_line++; }
|
|
}
|
|
|
|
my $parser = new c_parser($file);
|
|
|
|
my $function;
|
|
my $line;
|
|
|
|
my $update_output = sub {
|
|
my $progress = "";
|
|
my $prefix = "";
|
|
|
|
$progress .= "$file (file $progress_current of $progress_max)";
|
|
$prefix .= "$file:";
|
|
|
|
if(defined($function)) {
|
|
my $name = $function->name;
|
|
my $begin_line = $function->begin_line;
|
|
my $begin_column = $function->begin_column;
|
|
|
|
$progress .= ": function $name";
|
|
$prefix .= "$begin_line.$begin_column: function $name: ";
|
|
} else {
|
|
$prefix .= " ";
|
|
}
|
|
|
|
if(defined($line)) {
|
|
$progress .= ": line $line of $max_line";
|
|
}
|
|
|
|
$output->progress($progress);
|
|
$output->prefix($prefix);
|
|
};
|
|
|
|
&$update_output();
|
|
|
|
my $found_function = sub {
|
|
$function = shift;
|
|
|
|
my $name = $function->name;
|
|
$functions{$name} = $function;
|
|
|
|
if ($function->statements) {
|
|
&$update_output();
|
|
}
|
|
|
|
my $old_function;
|
|
if($options->implemented || $options->stub_statistics) {
|
|
$old_function = 'winapi_function'->new;
|
|
} else {
|
|
$old_function = 'function'->new;
|
|
}
|
|
|
|
$old_function->file($function->file);
|
|
$old_function->debug_channels([]); # FIXME: Not complete
|
|
|
|
$old_function->documentation_line(0); # FIXME: Not complete
|
|
$old_function->documentation(""); # FIXME: Not complete
|
|
|
|
$old_function->function_line($function->begin_line());
|
|
$old_function->linkage($function->linkage);
|
|
$old_function->return_type($function->return_type);
|
|
$old_function->calling_convention($function->calling_convention);
|
|
$old_function->internal_name($function->name);
|
|
if (defined($function->argument_types)) {
|
|
$old_function->argument_types([@{$function->argument_types}]);
|
|
}
|
|
if (defined($function->argument_names)) {
|
|
$old_function->argument_names([@{$function->argument_names}]);
|
|
}
|
|
$old_function->argument_documentations([]); # FIXME: Not complete
|
|
$old_function->statements_line($function->statements_line);
|
|
$old_function->statements($function->statements);
|
|
|
|
if($options->winetest) {
|
|
documentation_specifications($old_function);
|
|
}
|
|
|
|
if ($function->statements) {
|
|
$function = undef;
|
|
&$update_output();
|
|
} else {
|
|
$function = undef;
|
|
}
|
|
|
|
my $pseudo_stub = 0;
|
|
if ($options->pseudo_implemented || $options->pseudo_stub_statistics) {
|
|
$pseudo_stub = statements_pseudo_stub($old_function);
|
|
}
|
|
|
|
my $module = $old_function->module;
|
|
my $external_name = $old_function->external_name;
|
|
my $statements = $old_function->statements;
|
|
if ($options->pseudo_implemented && $module && $external_name && $statements) {
|
|
my @external_names = split(/\s*&\s*/, $external_name);
|
|
my @modules = split(/\s*&\s*/, $module);
|
|
|
|
my @external_names2;
|
|
while(defined(my $external_name = shift @external_names) &&
|
|
defined(my $module = shift @modules))
|
|
{
|
|
if ($pseudo_stub) {
|
|
$output->write("$module.$external_name: pseudo implemented\n");
|
|
} else {
|
|
$output->write("$module.$external_name: implemented\n");
|
|
}
|
|
}
|
|
}
|
|
};
|
|
$parser->set_found_function_callback($found_function);
|
|
|
|
my $found_line = sub {
|
|
$line = shift;
|
|
|
|
&$update_output;
|
|
};
|
|
$parser->set_found_line_callback($found_line);
|
|
|
|
my $found_type = sub {
|
|
my $type = shift;
|
|
|
|
&$update_output();
|
|
|
|
my $kind = $type->kind;
|
|
my $_name = $type->_name;
|
|
my $name = $type->name;
|
|
|
|
foreach my $field ($type->fields) {
|
|
my $field_type_name = $field->type_name;
|
|
my $field_name = $field->name;
|
|
|
|
if ($options->struct && $kind =~ /^(?:struct|union)$/) {
|
|
if ($name) {
|
|
$output->write("$name:$field_type_name:$field_name\n");
|
|
} else {
|
|
$output->write("$kind $_name:$field_type_name:$field_name\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
};
|
|
$parser->set_found_type_callback($found_type);
|
|
|
|
{
|
|
my $line = 1;
|
|
my $column = 0;
|
|
if(!$parser->parse_c_file(\$_, \$line, \$column)) {
|
|
$output->write("can't parse file\n");
|
|
}
|
|
}
|
|
|
|
$output->prefix("");
|
|
}
|
|
|
|
|
|
if($options->implemented && !$options->pseudo_implemented) {
|
|
foreach my $winapi (@winapis) {
|
|
my $type = $winapi->name;
|
|
|
|
if($type eq "win16" && !$options->win16) { next; }
|
|
if($type eq "win32" && !$options->win32) { next; }
|
|
|
|
foreach my $module ($winapi->all_modules) {
|
|
foreach my $external_name ($winapi->all_functions_in_module($module)) {
|
|
my $external_calling_convention =
|
|
$winapi->function_external_calling_convention_in_module($module, $external_name);
|
|
|
|
if($external_calling_convention eq "forward") {
|
|
(my $forward_module, my $forward_external_name) =
|
|
$winapi->function_forward_final_destination($module, $external_name);
|
|
|
|
my $forward_external_calling_convention =
|
|
$winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
|
|
|
|
if(!defined($forward_external_calling_convention)) {
|
|
next;
|
|
}
|
|
|
|
$external_calling_convention = $forward_external_calling_convention;
|
|
}
|
|
|
|
if ($external_calling_convention ne "stub") {
|
|
$output->write("*.spec: $module.$external_name: implemented\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 $refargument_kinds;
|
|
if($type eq "win16") {
|
|
$return_kind = $function->return_kind16 || "undef";
|
|
$calling_convention = $function->calling_convention16 || "undef";
|
|
$refargument_kinds = $function->argument_kinds16;
|
|
} elsif($type eq "win32") {
|
|
$return_kind = $function->return_kind32 || "undef";
|
|
$calling_convention = $function->calling_convention32 || "undef";
|
|
$refargument_kinds = $function->argument_kinds32;
|
|
}
|
|
|
|
if(defined($refargument_kinds)) {
|
|
my @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
|
|
print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
|
|
} else {
|
|
print OUT "$ordinal $calling_convention $external_name() $internal_name # FIXME: arguments undefined\n";
|
|
}
|
|
}
|
|
|
|
if($options->stub_statistics) {
|
|
foreach my $winapi (@winapis) {
|
|
my $type = $winapi->name;
|
|
|
|
if($type eq "win16" && !$options->win16) { next; }
|
|
if($type eq "win32" && !$options->win32) { next; }
|
|
|
|
my %module_counts;
|
|
foreach my $module ($winapi->all_modules) {
|
|
foreach my $external_name ($winapi->all_functions_in_module($module)) {
|
|
my $external_calling_convention =
|
|
$winapi->function_external_calling_convention_in_module($module, $external_name);
|
|
if($external_calling_convention !~ /^(?:forward|stub)$/) {
|
|
if($module_pseudo_stub{$module}{$external_name}) {
|
|
$external_calling_convention = "pseudo_stub";
|
|
}
|
|
} elsif($external_calling_convention eq "forward") {
|
|
(my $forward_module, my $forward_external_name) =
|
|
$winapi->function_forward_final_destination($module, $external_name);
|
|
|
|
my $forward_external_calling_convention =
|
|
$winapi->function_external_calling_convention_in_module($forward_module, $forward_external_name);
|
|
|
|
if(!defined($forward_external_calling_convention)) {
|
|
next;
|
|
}
|
|
|
|
if($forward_external_calling_convention ne "stub" &&
|
|
$module_pseudo_stub{$forward_module}{$forward_external_name})
|
|
{
|
|
$forward_external_calling_convention = "pseudo_stub";
|
|
}
|
|
|
|
$external_calling_convention = "forward_$forward_external_calling_convention";
|
|
}
|
|
|
|
$module_counts{$module}{$external_calling_convention}++;
|
|
}
|
|
}
|
|
|
|
foreach my $module ($winapi->all_modules) {
|
|
my $pseudo_stubs = $module_counts{$module}{pseudo_stub} || 0;
|
|
my $real_stubs = $module_counts{$module}{stub} || 0;
|
|
my $forward_pseudo_stubs = $module_counts{$module}{forward_pseudo_stub} || 0;
|
|
my $forward_real_stubs = $module_counts{$module}{forward_stub} || 0;
|
|
|
|
my $forwards = 0;
|
|
my $total = 0;
|
|
foreach my $calling_convention (keys(%{$module_counts{$module}})) {
|
|
my $count = $module_counts{$module}{$calling_convention};
|
|
if($calling_convention =~ /^forward/) {
|
|
$forwards += $count;
|
|
}
|
|
$total += $count;
|
|
}
|
|
|
|
if($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) " .
|
|
"and $forwards are forwards\n");
|
|
}
|
|
|
|
if($forwards > 0) {
|
|
my $forward_stubs = $forward_real_stubs + $forward_pseudo_stubs;
|
|
|
|
$output->write("*.c: $module: ");
|
|
$output->write("$forward_stubs of $forwards forwarded functions are stubs " .
|
|
"($forward_real_stubs real, $forward_pseudo_stubs pseudo)\n");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if($options->winetest) {
|
|
foreach my $module ($win32api->all_modules) {
|
|
my $type = "win32";
|
|
|
|
my $package = $module;
|
|
$package =~ s/\.dll$//;
|
|
$package =~ s/\./_/g;
|
|
|
|
my @entries;
|
|
|
|
foreach my $external_name (sort(keys(%{$specifications{$module}{unknown}}))) {
|
|
my $entry = $specifications{$module}{unknown}{$external_name};
|
|
push @entries, $entry;
|
|
}
|
|
|
|
foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
|
|
my $entry = $specifications{$module}{fixed}{$ordinal};
|
|
push @entries, $entry;
|
|
}
|
|
|
|
foreach my $external_name (sort(keys(%{$specifications{$module}{unfixed}}))) {
|
|
my $entry = $specifications{$module}{unfixed}{$external_name};
|
|
push @entries, $entry;
|
|
}
|
|
|
|
my $n = 0;
|
|
foreach my $entry (@entries) {
|
|
my $external_name = $entry->{external_name};
|
|
my $ordinal = $entry->{ordinal};
|
|
my $function = $entry->{function};
|
|
|
|
my $return_kind = $function->return_kind32 || "undef";
|
|
my $calling_convention = $function->calling_convention32 || "undef";
|
|
my $refargument_kinds = $function->argument_kinds32;
|
|
|
|
my @argument_kinds;
|
|
if(defined($refargument_kinds)) {
|
|
@argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
|
|
}
|
|
|
|
next if $calling_convention ne "stdcall";
|
|
next if $external_name eq "\@";
|
|
|
|
if($n == 0) {
|
|
open(OUT, "> $wine_dir/programs/winetest/include/${package}.pm") || die "Error: Can't open $wine_dir/programs/winetest/include/${package}.pm: $!\n";
|
|
|
|
print OUT "package ${package};\n";
|
|
print OUT "\n";
|
|
|
|
print OUT "use strict;\n";
|
|
print OUT "\n";
|
|
|
|
print OUT "require Exporter;\n";
|
|
print OUT "\n";
|
|
|
|
print OUT "use wine;\n";
|
|
print OUT "use vars qw(\@ISA \@EXPORT \@EXPORT_OK);\n";
|
|
print OUT "\n";
|
|
|
|
print OUT "\@ISA = qw(Exporter);\n";
|
|
print OUT "\@EXPORT = qw();\n";
|
|
print OUT "\@EXPORT_OK = qw();\n";
|
|
print OUT "\n";
|
|
|
|
print OUT "my \$module_declarations = {\n";
|
|
} elsif($n > 0) {
|
|
print OUT ",\n";
|
|
}
|
|
|
|
print OUT " \"\Q$external_name\E\" => [\"$return_kind\", [";
|
|
my $m = 0;
|
|
foreach my $argument_kind (@argument_kinds) {
|
|
if($m > 0) {
|
|
print OUT ", ";
|
|
}
|
|
print OUT "\"$argument_kind\"";
|
|
$m++;
|
|
}
|
|
print OUT "]]";
|
|
$n++;
|
|
}
|
|
|
|
if($n > 0) {
|
|
print OUT "\n";
|
|
print OUT "};\n";
|
|
print OUT "\n";
|
|
print OUT "&wine::declare(\"$module\",\%\$module_declarations);\n";
|
|
print OUT "push \@EXPORT, map { \"&\" . \$_; } sort(keys(\%\$module_declarations));\n";
|
|
print OUT "1;\n";
|
|
close(OUT);
|
|
}
|
|
}
|
|
}
|