#!/usr/bin/perl -w # # Update spec files across dlls that share an implementation # # Copyright 2011 Alexandre Julliard # # 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; my %funcs; my $group_head; my @dll_groups = ( [ "msvcrt", "msvcirt", "msvcrt40", "msvcrt20", ], [ "msvcrt", "msvcp90", "msvcp100", "msvcp110", "msvcp120", "msvcp140", "msvcp71", "msvcp80", "msvcp70", "msvcp60", ], [ "msvcr120", "msvcr120_app", "concrt140", ], [ "ucrtbase", "vcruntime140", ], [ "msvcp120", "msvcp120_app", ], [ "msvcp140", "msvcp_win", ], [ "d3d10", "d3d10_1", ], [ "d3dx10_43", "d3dx10_42", "d3dx10_41", "d3dx10_40", "d3dx10_39", "d3dx10_38", "d3dx10_37", "d3dx10_36", "d3dx10_35", "d3dx10_34", "d3dx10_33", ], [ "xinput1_3", "xinput1_4", "xinput1_2", "xinput1_1", "xinput9_1_0", ], [ "vcomp", "vcomp140", "vcomp120", "vcomp110", "vcomp100", "vcomp90", ], [ "advapi32", "sechost", ], [ "netapi32", "srvcli", ], [ "ole32", "iprop", ], [ "secur32", "security", "sspicli", ], [ "gdi32", "usp10" ], [ "bthprops.cpl", "irprops.cpl", ], [ "sfc_os", "sfc", ], [ "bcrypt", "ncrypt", "cng.sys", ], [ "ntoskrnl.exe", "hal", ], [ "mscoree", "mscorwks", ], [ "sppc", "slc", ], ); my $update_flags = 0; my $show_duplicates = 0; foreach my $arg (@ARGV) { if ($arg eq "-f") { $update_flags = 1; } elsif ($arg eq "-d") { $show_duplicates = 1; } } # update a file if changed sub update_file($$) { my $file = shift; my $new = shift; open FILE, ">$file.new" or die "cannot create $file.new"; print FILE $new; close FILE; rename "$file.new", "$file"; print "$file updated\n"; } # parse a spec file line sub parse_line($$$) { my ($name, $line, $str) = @_; if ($str =~ /^\s*(\@|\d+)\s+(stdcall|cdecl|varargs|thiscall|stub|extern)\s+((?:-\S+\s+)*)([A-Za-z0-9_\@\$?]+)(?:\s*(\([^)]*\)))?(?:\s+([A-Za-z0-9_\@\$?.]+))?(\s*\#.*)?/) { return ( "ordinal" => $1, "callconv" => $2, "flags" => $3, "name" => $4, "args" => $5 || "", "target" => $6 || $4, "comment" => $7, "spec" => $name ); } return () if $str =~ /^\s*$/; return () if $str =~ /^\s*\#/; printf STDERR "$name.spec:$line: error: Unrecognized line $_\n"; } sub read_spec_file($) { my $name = shift; my $file = "dlls/$name/$name.spec"; my %stubs; open SPEC, "<$file" or die "cannot open $file"; while (<SPEC>) { chomp; my %descr = parse_line( $name, $., $_ ); next unless %descr; my $func = $descr{name}; if (defined $funcs{$func}) { my %update = %{$funcs{$func}}; next if $update{ordinal} ne $descr{ordinal} or $update{callconv} ne $descr{callconv} or $update{args} ne $descr{args}; my $arch = $1 if $update{flags} =~ /-arch=(\S+)/; my $new_arch = $1 if $descr{flags} =~ /-arch=(\S+)/; next if !defined $arch or !defined $new_arch; if (($arch eq "win32" and $new_arch eq "win64") or ($arch eq "win64" and $new_arch eq "win32")) { $funcs{$func}{flags} =~ s/-arch=\S+\s+//; next; } $funcs{$func}{flags} =~ s/-arch=$arch/-arch=$arch,$new_arch/; next; } next if $func eq "@"; $funcs{$func} = \%descr; } close SPEC; } sub update_spec_file($) { my $name = shift; my $file = "dlls/$name/$name.spec"; my %stubs; my ($old, $new); open SPEC, "<$file" or die "cannot open $file"; while (<SPEC>) { $old .= $_; chomp; my $commented_out = 0; my %descr = parse_line( $name, $., $_ ); if (!%descr) { # check for commented out exports if (/^\s*\#\s*((?:\@|\d+)\s+)?((?:extern|stub|stdcall|cdecl|varargs|thiscall)\s+.*)/) { $commented_out = 1; %descr = parse_line( $name, $., ($1 || "\@ ") . $2 ); } } goto done unless %descr; my $func = $descr{name}; if (!defined $funcs{$func}) { $funcs{$func} = \%descr unless $commented_out || $name =~ /-/; goto done; } my %parent = %{$funcs{$func}}; goto done if $parent{spec} eq $descr{spec}; # the definition is in this spec file goto done if $descr{comment} && $descr{comment} =~ /don't forward/; if ($descr{callconv} ne "stub" && $descr{target} !~ /\./ && !$commented_out) { printf "%s:%u: note: %s already defined in %s\n", $file, $., $func, $parent{spec} if $show_duplicates; goto done; } my $flags = $descr{flags}; if ($parent{callconv} ne "stub" || $update_flags) { $flags = $parent{flags}; $flags =~ s/-ordinal\s*// if $descr{ordinal} eq "@"; $flags =~ s/-noname\s*// if $descr{ordinal} eq "@"; $flags =~ s/-import\s*//; if ($descr{flags} =~ /-private/) # preserve -private flag { $flags = "-private " . $flags unless $flags =~ /-private/; } } if ($parent{callconv} ne "stub" || $parent{args}) { my $callconv = $parent{callconv} ne "stub" ? $parent{callconv} : $parent{spec} =~ /(msvc|ucrtbase)/ ? "cdecl" : "stdcall"; # hack $_ = sprintf "$descr{ordinal} %s %s%s", $callconv, $flags, $func; if ($parent{target} =~ /$group_head\./) # use the same forward as parent if possible { $_ .= sprintf "%s %s", $parent{args}, $parent{target}; } else { $_ .= sprintf "%s %s.%s", $parent{args}, $parent{spec}, $func; } } else { $_ = sprintf "$descr{ordinal} stub %s%s", $flags, $func; } $_ .= $descr{comment} || ""; done: $new .= "$_\n"; } close SPEC; update_file( $file, $new ) if $old ne $new; } sub sync_spec_files(@) { %funcs = (); $group_head = shift; read_spec_file( $group_head ); foreach my $spec (@_) { update_spec_file($spec); } } foreach my $group (@dll_groups) { sync_spec_files( @{$group} ); }