#!/usr/bin/perl # 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; use warnings 'all'; 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); } } }