#!/usr/bin/perl -w
-# Copyright 2001 Patrik Stridvall
+# 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
use strict;
}
use config qw(
- &file_type &file_skip &files_skip &get_spec_files
+ &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" },
+use output qw($output);
+use winapi_extract_options qw($options);
- "spec-files" => { default => 1, parent => "global", description => "spec files extraction" },
- "stub-statistics" => { default => 0, parent => "global", description => "stub statistics" },
-);
+if($options->progress) {
+ $output->enable_progress;
+} else {
+ $output->disable_progress;
+}
-my %options_short = (
- "d" => "debug",
- "?" => "help",
- "v" => "verbose"
-);
+use c_parser;
+use function;
+use type;
-my $options_usage = "usage: winapi_extract [--help] [<files>]\n";
+use winapi_c_parser;
+use winapi_function;
-my $options = 'options'->new(\%options_long, \%options_short, $options_usage);
+use vars qw($win16api $win32api @winapis);
+if ($options->spec_files || $options->implemented || $options->stub_statistics || $options->winetest) {
+ require winapi;
+ import winapi qw($win16api $win32api @winapis);
+}
+my %module2entries;
my %module2spec_file;
-my %module2type;
-{
+if($options->spec_files || $options->winetest) {
local $_;
foreach my $spec_file (get_spec_files("winelib")) {
- my $module;
- my $type;
+ my $entries = [];
+
+ my $module = $spec_file;
+ $module =~ s/^.*?([^\/]*)\.spec$/$1/;
+
+ my $type = "win32";
open(IN, "< $wine_dir/$spec_file");
- while(<IN>) {
+
+ my $header = 1;
+ my $lookahead = 0;
+ while($lookahead || defined($_ = <IN>)) {
+ $lookahead = 0;
+
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;
+ if($header) {
+ if(/^\d+|@/) {
+ $header = 0;
+ $lookahead = 1;
+ }
+ next;
}
- }
- close(IN);
- }
-}
-my $modules = 'modules'->new($options, $output, $wine_dir, $current_dir, \&file_type, "$winapi_check_dir/modules.dat");
+ if(/^(@|\d+)\s+stdcall\s+(\w+)\s*\(\s*([^\)]*)\s*\)/) {
+ my $ordinal = $1;
+ my $name = $2;
+ my @args = split(/\s+/, $3);
-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);
+ push @$entries, [$name, "undef", \@args];
+ }
+ }
+ close(IN);
-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);
+ $module2spec_file{$module} = $spec_file;
+ $module2entries{$module} = $entries;
+ }
}
-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 $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;
$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;
+my %module_pseudo_stub;
-sub statements_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_count16{$module16}++;
+ $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_count32{$module32}++;
+ $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 = $options->c_files;
-@c_files = files_skip(@c_files);
-@c_files = files_filter("winelib", @c_files);
+my @c_files = ();
+if($options->spec_files || $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(@c_files);
+my $progress_max = scalar(@h_files) + scalar(@c_files);
-foreach my $file (@c_files) {
+foreach my $file (@h_files, @c_files) {
my %functions;
$progress_current++;
- if($options->progress) {
- $output->progress("$file: file $progress_current of $progress_max");
+
+ {
+ open(IN, "< $file");
+ local $/ = undef;
+ $_ = <IN>;
+ close(IN);
+ }
+
+ my $max_line = 0;
+ {
+ local $_ = $_;
+ while(s/^.*?\n//) { $max_line++; }
+ if($_) { $max_line++; }
}
+ my $parser;
+ if (!$options->old) {
+ $parser = new c_parser($file);
+ } else {
+ $parser = new winapi_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 {
- 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);
+ $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->spec_files || $options->winetest) {
+ documentation_specifications($old_function);
+ }
+
+ if ($function->statements) {
+ $function = undef;
+ &$update_output();
+ } else {
+ $function = undef;
}
- if($options->stub_statistics) {
- statements_stub($function);
+ my $pseudo_stub = 0;
+ if ($options->pseudo_implemented || $options->pseudo_stub_statistics) {
+ $pseudo_stub = statements_pseudo_stub($old_function);
}
- $output->prefix("");
+ 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;
- my $found_preprocessor = sub {
- my $directive = shift;
- my $argument = shift;
+ &$update_output;
};
+ $parser->set_found_line_callback($found_line);
+
+ my $found_type = sub {
+ my $type = shift;
- winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
+ &$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;
- my @internal_names = keys(%functions);
- if($#internal_names < 0) {
- $output->write("$file: doesn't contain any functions\n");
+ 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");
+ }
+ }
+ }
}
}
my $return_kind;
my $calling_convention;
- my @argument_kinds;
+ my $refargument_kinds;
if($type eq "win16") {
$return_kind = $function->return_kind16 || "undef";
$calling_convention = $function->calling_convention16 || "undef";
- @argument_kinds = map { $_ || "undef"; } @{$function->argument_kinds16};
+ $refargument_kinds = $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};
+ $refargument_kinds = $function->argument_kinds32;
}
- print OUT "$ordinal $calling_convention $external_name(@argument_kinds) $internal_name\n";
+ 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->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 $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) {
+ my $spec_file = $module2spec_file{$module};
+
+ if(!defined($spec_file) || !defined($type)) {
+ $output->write("$module: doesn't exist\n");
+ next;
}
- }
- 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}++;
+
+ $spec_file .= "2";
+
+ $output->progress("$spec_file");
+ open(OUT, "> $wine_dir/$spec_file");
+
+ if(exists($specifications{$module}{init})) {
+ my $function = $specifications{$module}{init}{function};
+ print OUT "init " . $function->internal_name . "\n";
}
- }
- 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}++;
+ 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 $name (sort(keys(%{$specifications{$module}{unknown}}))) {
- my $function = $specifications{$module}{unknown}{$name}{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 @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);
}
-
- my $empty = 1;
+ }
+}
- if(!$empty) {
- print OUT "\n";
- $empty = 1;
+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};
- my $ordinal = $entry->{ordinal};
- my $function = $entry->{function};
- print OUT "# ";
- output_function(\*OUT, $type, $ordinal, $external_name, $function);
- $empty = 0;
+ push @entries, $entry;
}
- 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;
+ push @entries, $entry;
}
- 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;
+ push @entries, $entry;
}
- close(OUT);
- }
-}
+ my $n = 0;
+ foreach my $entry (@entries) {
+ my $external_name = $entry->{external_name};
+ my $ordinal = $entry->{ordinal};
+ my $function = $entry->{function};
-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 $return_kind = $function->return_kind32 || "undef";
+ my $calling_convention = $function->calling_convention32 || "undef";
+ my $refargument_kinds = $function->argument_kinds32;
- 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}++;
+ my @argument_kinds;
+ if(defined($refargument_kinds)) {
+ @argument_kinds = map { $_ || "undef"; } @$refargument_kinds;
}
- }
- 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};
- }
+ next if $calling_convention ne "stdcall";
+ next if $external_name eq "\@";
+
+ if($n == 0) {
+ open(OUT, "> $wine_dir/programs/winetest/include/${package}.pm");
+
+ print OUT "package ${package};\n";
+ print OUT "\n";
+
+ print OUT "use strict;\n";
+ print OUT "\n";
- my $real_stubs = $module_stub_count{$module};
- my $total = $module_total_count{$module};
+ print OUT "require Exporter;\n";
+ print OUT "\n";
- if(!defined($real_stubs)) { $real_stubs = 0; }
- if(!defined($pseudo_stubs)) { $pseudo_stubs = 0; }
- if(!defined($total)) { $total = 0;}
+ print OUT "use wine;\n";
+ print OUT "use vars qw(\@ISA \@EXPORT \@EXPORT_OK);\n";
+ print OUT "\n";
- 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");
+ 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++;
}
- }
-}
-$output->hide_progress;
+ 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);
+ }
+ }
+}
projects / wine / blobdiff