Wine source

2623e329c… Alex*0001 #!/usr/bin/perl -w
                0002 #
                0003 # Update spec files across dlls that share an implementation
                0004 #
                0005 # Copyright 2011 Alexandre Julliard
                0006 #
                0007 # This library is free software; you can redistribute it and/or
                0008 # modify it under the terms of the GNU Lesser General Public
                0009 # License as published by the Free Software Foundation; either
                0010 # version 2.1 of the License, or (at your option) any later version.
                0011 #
                0012 # This library is distributed in the hope that it will be useful,
                0013 # but WITHOUT ANY WARRANTY; without even the implied warranty of
                0014 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
                0015 # Lesser General Public License for more details.
                0016 #
                0017 # You should have received a copy of the GNU Lesser General Public
                0018 # License along with this library; if not, write to the Free Software
                0019 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
                0020 #
                0021
                0022 use strict;
                0023
                0024 my %funcs;
                0025 my $group_head;
                0026
                0027 my @dll_groups =
                0028 (
                0029  [
                0030   "msvcrt",
9228d9794… Piot*0031   "msvcirt",
2623e329c… Alex*0032   "msvcrt40",
                0033   "msvcrt20",
                0034  ],
                0035  [
                0036   "msvcrt",
                0037   "msvcp90",
                0038   "msvcp100",
56538fdf8… Stef*0039   "msvcp110",
c68e82431… Yifu*0040   "msvcp120",
1135db709… Mart*0041   "msvcp140",
2623e329c… Alex*0042   "msvcp71",
48c19ac11… Piot*0043   "msvcp80",
2623e329c… Alex*0044   "msvcp70",
                0045   "msvcp60",
                0046  ],
a44e013b4… Mart*0047  [
                0048   "msvcr120",
                0049   "msvcr120_app",
6682824d7… Dani*0050   "concrt140",
a44e013b4… Mart*0051  ],
bf9609224… Mart*0052  [
                0053   "ucrtbase",
4e4f0f295… Mart*0054   "vcruntime140",
bf9609224… Mart*0055  ],
69269a7f0… Mart*0056  [
                0057   "msvcp120",
                0058   "msvcp120_app",
                0059  ],
9321d524b… Piot*0060  [
                0061   "msvcp140",
                0062   "msvcp_win",
                0063  ],
c6251b0de… Seba*0064  [
                0065   "d3d10",
                0066   "d3d10_1",
                0067  ],
6744fec6c… Alex*0068  [
                0069   "d3dx10_43",
                0070   "d3dx10_42",
                0071   "d3dx10_41",
                0072   "d3dx10_40",
                0073   "d3dx10_39",
                0074   "d3dx10_38",
                0075   "d3dx10_37",
                0076   "d3dx10_36",
                0077   "d3dx10_35",
                0078   "d3dx10_34",
                0079   "d3dx10_33",
                0080  ],
                0081  [
                0082   "xinput1_3",
0079248f1… Andr*0083   "xinput1_4",
6744fec6c… Alex*0084   "xinput1_2",
                0085   "xinput1_1",
                0086   "xinput9_1_0",
                0087  ],
41c4357f1… Andr*0088  [
                0089   "vcomp",
71bb4a13c… Dani*0090   "vcomp140",
66808858a… Dani*0091   "vcomp120",
824b81ea1… Aust*0092   "vcomp110",
41c4357f1… Andr*0093   "vcomp100",
a6086e116… Andr*0094   "vcomp90",
41c4357f1… Andr*0095  ],
52a231c5b… Detl*0096  [
                0097   "advapi32",
23791eb11… Alex*0098   "sechost",
294560c1a… Andr*0099  ],
c0c806854… Andr*0100  [
                0101   "netapi32",
8f81123f4… Alis*0102   "srvcli",
c0c806854… Andr*0103  ],
cdec918b2… Detl*0104  [
                0105   "ole32",
4e1514127… Vinc*0106   "iprop",
cdec918b2… Detl*0107  ],
5e74b9ea9… Dmit*0108  [
                0109   "secur32",
3eca3516a… Alex*0110   "security",
5e74b9ea9… Dmit*0111   "sspicli",
                0112  ],
6bb42462b… Mart*0113  [
                0114   "gdi32",
b9178da58… Niko*0115   "usp10"
6bb42462b… Mart*0116  ],
c78f7a96e… Aust*0117  [
                0118   "bthprops.cpl",
                0119   "irprops.cpl",
                0120  ],
89eb67dbc… Aust*0121  [
                0122   "sfc_os",
                0123   "sfc",
                0124  ],
084827e90… Alex*0125  [
                0126   "bcrypt",
                0127   "ncrypt",
d09d4d97e… Alis*0128   "cng.sys",
084827e90… Alex*0129  ],
f3ccfc092… Aust*0130  [
                0131   "ntoskrnl.exe",
                0132   "hal",
                0133  ],
12d5b6899… Zebe*0134  [
                0135   "mscoree",
                0136   "mscorwks",
                0137  ],
0807b09cf… Esme*0138  [
                0139   "sppc",
                0140   "slc",
                0141  ],
2623e329c… Alex*0142 );
                0143
                0144 my $update_flags = 0;
                0145 my $show_duplicates = 0;
                0146
                0147 foreach my $arg (@ARGV)
                0148 {
                0149     if ($arg eq "-f") { $update_flags = 1; }
                0150     elsif ($arg eq "-d") { $show_duplicates = 1; }
                0151 }
                0152
af91122ca… Alex*0153 # update a file if changed
                0154 sub update_file($$)
2623e329c… Alex*0155 {
                0156     my $file = shift;
af91122ca… Alex*0157     my $new = shift;
                0158
                0159     open FILE, ">$file.new" or die "cannot create $file.new";
                0160     print FILE $new;
                0161     close FILE;
                0162     rename "$file.new", "$file";
                0163     print "$file updated\n";
2623e329c… Alex*0164 }
                0165
401288a78… Alex*0166 # update a file if changed
                0167 sub output_file($$)
                0168 {
                0169     my $file = shift;
                0170     my $new = shift;
                0171     my $old = "";
                0172     if (open FILE, "<$file")
                0173     {
                0174         local $/ = undef;
                0175         $old .= <FILE>;
                0176         close FILE;
                0177     }
                0178     update_file( $file, $new ) if $old ne $new;
                0179 }
                0180
2623e329c… Alex*0181 # parse a spec file line
                0182 sub parse_line($$$)
                0183 {
801317392… Alex*0184     my ($name, $line, $str) = @_;
2623e329c… Alex*0185
801317392… Alex*0186     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*\#.*)?/)
2623e329c… Alex*0187     {
                0188         return ( "ordinal" => $1, "callconv" => $2, "flags" => $3, "name" => $4, "args" => $5 || "",
                0189                  "target" => $6 || $4, "comment" => $7, "spec" => $name );
                0190     }
801317392… Alex*0191     return () if $str =~ /^\s*$/;
                0192     return () if $str =~ /^\s*\#/;
2623e329c… Alex*0193     printf STDERR "$name.spec:$line: error: Unrecognized line $_\n";
                0194 }
                0195
                0196 sub read_spec_file($)
                0197 {
                0198     my $name = shift;
                0199     my $file = "dlls/$name/$name.spec";
                0200     my %stubs;
                0201     open SPEC, "<$file" or die "cannot open $file";
                0202     while (<SPEC>)
                0203     {
                0204         chomp;
                0205         my %descr = parse_line( $name, $., $_ );
                0206         next unless %descr;
                0207
                0208         my $func = $descr{name};
64534e9b5… Piot*0209         if (defined $funcs{$func})
                0210         {
                0211             my %update = %{$funcs{$func}};
                0212             next if $update{ordinal} ne $descr{ordinal} or $update{callconv} ne $descr{callconv} or $update{args} ne $descr{args};
                0213
                0214             my $arch = $1 if $update{flags} =~ /-arch=(\S+)/;
                0215             my $new_arch = $1 if $descr{flags} =~ /-arch=(\S+)/;
                0216             next if !defined $arch or !defined $new_arch;
                0217
                0218             if (($arch eq "win32" and $new_arch eq "win64") or ($arch eq "win64" and $new_arch eq "win32"))
                0219             {
                0220                 $funcs{$func}{flags} =~ s/-arch=\S+\s+//;
                0221                 next;
                0222             }
                0223
                0224             $funcs{$func}{flags} =~ s/-arch=$arch/-arch=$arch,$new_arch/;
                0225             next;
                0226         }
646117bf9… Aust*0227         next if $func eq "@";
2623e329c… Alex*0228         $funcs{$func} = \%descr;
                0229     }
                0230     close SPEC;
                0231 }
                0232
                0233 sub update_spec_file($)
                0234 {
                0235     my $name = shift;
                0236     my $file = "dlls/$name/$name.spec";
                0237     my %stubs;
af91122ca… Alex*0238     my ($old, $new);
2623e329c… Alex*0239
                0240     open SPEC, "<$file" or die "cannot open $file";
                0241     while (<SPEC>)
                0242     {
af91122ca… Alex*0243         $old .= $_;
2623e329c… Alex*0244         chomp;
                0245
                0246         my $commented_out = 0;
                0247         my %descr = parse_line( $name, $., $_ );
                0248         if (!%descr)
                0249         {
                0250             # check for commented out exports
                0251             if (/^\s*\#\s*((?:\@|\d+)\s+)?((?:extern|stub|stdcall|cdecl|varargs|thiscall)\s+.*)/)
                0252             {
                0253                 $commented_out = 1;
                0254                 %descr = parse_line( $name, $., ($1 || "\@ ") . $2 );
                0255             }
                0256         }
                0257         goto done unless %descr;
                0258
                0259         my $func = $descr{name};
                0260         if (!defined $funcs{$func})
                0261         {
d8bb3030d… Alex*0262             $funcs{$func} = \%descr unless $commented_out || $name =~ /-/;
2623e329c… Alex*0263             goto done;
                0264         }
                0265
                0266         my %parent = %{$funcs{$func}};
                0267         goto done if $parent{spec} eq $descr{spec};  # the definition is in this spec file
c0ac16403… Alex*0268         goto done if $descr{comment} && $descr{comment} =~ /don't forward/;
83a8c45dc… Alex*0269         if ($descr{callconv} ne "stub" && $descr{target} !~ /\./ && !$commented_out)
2623e329c… Alex*0270         {
                0271             printf "%s:%u: note: %s already defined in %s\n", $file, $., $func, $parent{spec} if $show_duplicates;
                0272             goto done;
                0273         }
                0274
a0ec06566… Alex*0275         my $flags = $descr{flags};
                0276         if ($parent{callconv} ne "stub" || $update_flags)
                0277         {
                0278             $flags = $parent{flags};
                0279             $flags =~ s/-ordinal\s*// if $descr{ordinal} eq "@";
801317392… Alex*0280             $flags =~ s/-noname\s*// if $descr{ordinal} eq "@";
cf619dd41… Alex*0281             $flags =~ s/-import\s*//;
0a3cc8b85… Alex*0282             if ($descr{flags} =~ /-private/)  # preserve -private flag
                0283             {
                0284                 $flags = "-private " . $flags unless $flags =~ /-private/;
                0285             }
a0ec06566… Alex*0286         }
2623e329c… Alex*0287
6c8822807… Alex*0288         if ($parent{callconv} ne "stub" || $parent{args})
2623e329c… Alex*0289         {
                0290             my $callconv = $parent{callconv} ne "stub" ? $parent{callconv} :
b256c55d0… Mart*0291                            $parent{spec} =~ /(msvc|ucrtbase)/ ? "cdecl" : "stdcall";  # hack
ed3a27659… Andr*0292             $_ = sprintf "$descr{ordinal} %s %s%s", $callconv, $flags, $func;
2623e329c… Alex*0293
                0294             if ($parent{target} =~ /$group_head\./)  # use the same forward as parent if possible
                0295             {
                0296                 $_ .= sprintf "%s %s", $parent{args}, $parent{target};
                0297             }
                0298             else
                0299             {
                0300                 $_ .= sprintf "%s %s.%s", $parent{args}, $parent{spec}, $func;
                0301             }
                0302         }
                0303         else
                0304         {
ed3a27659… Andr*0305             $_ = sprintf "$descr{ordinal} stub %s%s", $flags, $func;
2623e329c… Alex*0306         }
                0307         $_ .= $descr{comment} || "";
                0308
                0309       done:
af91122ca… Alex*0310         $new .= "$_\n";
2623e329c… Alex*0311     }
                0312     close SPEC;
af91122ca… Alex*0313     update_file( $file, $new ) if $old ne $new;
2623e329c… Alex*0314 }
                0315
401288a78… Alex*0316 sub get_args_size($)
                0317 {
                0318     my $args = shift;
                0319     my $ret32 = 0;
                0320     my $ret64 = 0;
                0321     if ($args =~ /^\((.*)\)$/)
                0322     {
                0323         my @args = split /\s+/, $1;
                0324         $ret64 += 8 * scalar @args;
                0325         map { $ret32 += ($_ eq "int64") ? 8 : 4; } @args;
                0326     }
                0327     return ($ret32, $ret64);
                0328 }
                0329
                0330 sub get_syscalls_str(@)
                0331 {
                0332     my @syscalls = sort { $a->[0] cmp $b->[0] } @_;
                0333
                0334     my $ret = "";
                0335     for (my $i = 0; $i < @syscalls; $i++)
                0336     {
                0337         my ($name, $args) = @{$syscalls[$i]};
                0338         $ret .= sprintf " \\\n    SYSCALL_ENTRY( 0x%04x, %s, %u )", $i, $name, $args;
                0339     }
                0340     return $ret . "\n";
                0341 }
                0342
                0343 sub read_syscalls($)
                0344 {
                0345     my $spec = shift;
                0346     my @syscalls32 = ();
                0347     my @syscalls64 = ();
                0348
                0349     %funcs = ();
                0350     read_spec_file( $spec );
                0351
                0352     foreach my $func (keys %funcs)
                0353     {
                0354         my $descr = $funcs{$func};
                0355         next unless $descr->{flags} =~ /-syscall/;
                0356         next if $descr->{target} ne $func && defined $funcs{$descr->{target}};
                0357         my ($args32, $args64) = get_args_size( $funcs{$func}->{args} );
                0358         push @syscalls32, [ $func, $args32 ] unless $descr->{flags} =~ /-arch=win64/;
                0359         push @syscalls64, [ $func, $args64 ] unless $descr->{flags} =~ /-arch=win32/;
                0360     }
                0361     return (\@syscalls32, \@syscalls64);
                0362 }
                0363
                0364 sub update_syscalls($$)
                0365 {
                0366     my ($spec, $file) = @_;
                0367     my ($syscalls32, $syscalls64) = read_syscalls( $spec );
                0368
                0369     output_file( $file,
                0370                  "/* Automatically generated by tools/make_specfiles */\n" .
                0371                  "\n#define ALL_SYSCALLS32" . get_syscalls_str( @{$syscalls32} ) .
                0372                  "\n#define ALL_SYSCALLS64" . get_syscalls_str( @{$syscalls64} ));
                0373 }
                0374
2623e329c… Alex*0375 sub sync_spec_files(@)
                0376 {
                0377     %funcs = ();
                0378     $group_head = shift;
                0379     read_spec_file( $group_head );
                0380     foreach my $spec (@_) { update_spec_file($spec); }
                0381 }
                0382
                0383 foreach my $group (@dll_groups)
                0384 {
                0385     sync_spec_files( @{$group} );
                0386 }
401288a78… Alex*0387
                0388 update_syscalls( "ntdll", "dlls/ntdll/ntsyscalls.h" );
                0389 update_syscalls( "win32u", "dlls/win32u/win32syscalls.h" );