535 lines
14 KiB
Perl
Executable File
535 lines
14 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
use strict;
|
|
use XML::LibXML;
|
|
|
|
# Copyright 2021 Zebediah Figura
|
|
#
|
|
# 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
|
|
|
|
# Files to generate
|
|
my $spec_file = "opencl.spec";
|
|
my $pe_file = "pe_thunks.c";
|
|
my $types_file = "opencl_types.h";
|
|
my $unix_file = "unix_thunks.c";
|
|
my $unixheader_file = "unixlib.h";
|
|
|
|
# If set to 1, generate TRACEs for each OpenGL function
|
|
my $gen_traces = 1;
|
|
|
|
# List of categories to put in the 'opengl_core.c' file
|
|
my %cat_1_0 = ( "CL_VERSION_1_0" => 1 );
|
|
my %cat_1_1 = ( %cat_1_0, "CL_VERSION_1_1" => 1 );
|
|
|
|
my %core_categories = ();
|
|
|
|
my %arg_types =
|
|
(
|
|
"cl_bitfield" => [ "int64", "wine_dbgstr_longlong(%s)" ],
|
|
"double" => [ "double", "%.16e" ],
|
|
"float" => [ "float", "%.8e" ],
|
|
"int" => [ "long", "%d" ],
|
|
"int8_t" => [ "long", "%d" ],
|
|
"int16_t" => [ "long", "%d" ],
|
|
"int32_t" => [ "long", "%d" ],
|
|
"int64_t" => [ "int64", "wine_dbgstr_longlong(%s)" ],
|
|
"intptr_t" => [ "long", "%Id" ],
|
|
"size_t" => [ "long", "%Iu" ],
|
|
"uint8_t" => [ "long", "%u" ],
|
|
"uint16_t" => [ "long", "%u" ],
|
|
"uint32_t" => [ "long", "%u" ],
|
|
"uint64_t" => [ "int64", "wine_dbgstr_longlong(%s)" ],
|
|
"unsigned int" => [ "long", "%u" ],
|
|
);
|
|
|
|
my %unsupported_extensions =
|
|
(
|
|
# Needs wined3d integration.
|
|
"cl_intel_d3d11_nv12_media_sharing" => 1,
|
|
"cl_intel_dx9_media_sharing" => 1,
|
|
"cl_khr_d3d10_sharing" => 1,
|
|
"cl_khr_d3d11_sharing" => 1,
|
|
"cl_khr_dx9_media_sharing" => 1,
|
|
"cl_nv_d3d9_sharing" => 1,
|
|
"cl_nv_d3d10_sharing" => 1,
|
|
"cl_nv_d3d11_sharing" => 1,
|
|
|
|
# Needs a loader/ICD split.
|
|
"cl_khr_icd" => 1,
|
|
"cl_loader_layers" => 1,
|
|
|
|
# Needs callback conversion.
|
|
"cl_apple_setmemobjectdestructor" => 1,
|
|
"cl_arm_shared_virtual_memory" => 1,
|
|
);
|
|
|
|
sub generate_pe_thunk($$)
|
|
{
|
|
my ($name, $func_ref) = @_;
|
|
my $call_arg = "";
|
|
my $trace_call_arg = "";
|
|
my $trace_arg = "";
|
|
|
|
my $ret = get_func_proto( "%s WINAPI %s(%s)", $name, $func_ref );
|
|
foreach my $arg (@{$func_ref->[1]})
|
|
{
|
|
my $ptype = get_arg_type( $arg );
|
|
next unless $arg->findnodes("./name");
|
|
my $pname = get_arg_name( $arg );
|
|
my $param = $arg->textContent();
|
|
$call_arg .= " " . $pname . ",";
|
|
if ($param =~ /\*/ || $param =~ /\[/)
|
|
{
|
|
$trace_arg .= ", %p";
|
|
$trace_call_arg .= ", " . $pname;
|
|
}
|
|
elsif (defined $arg_types{$ptype})
|
|
{
|
|
my $format = ${$arg_types{$ptype}}[1];
|
|
$trace_arg .= ", " . ($format =~ /^%/ ? $format : "%s");
|
|
$trace_call_arg .= ", " . sprintf $format =~ /^%/ ? "%s" : $format, $pname;
|
|
}
|
|
else
|
|
{
|
|
die "Unknown type %s in %s\n", $param, $name;
|
|
}
|
|
}
|
|
$call_arg =~ s/,$/ /;
|
|
$trace_arg =~ s/^, //;
|
|
$ret .= "\n{\n";
|
|
$ret .= " TRACE( \"($trace_arg)\\n\"$trace_call_arg );\n" if $gen_traces;
|
|
$ret .= " ";
|
|
$ret .= "return " unless is_void_func( $func_ref );
|
|
$ret .= "opencl_funcs->p$name($call_arg);\n";
|
|
$ret .= "}\n";
|
|
return $ret;
|
|
}
|
|
|
|
sub generate_unix_thunk($$)
|
|
{
|
|
my ($name, $func_ref) = @_;
|
|
my $call_arg = "";
|
|
|
|
my $ret = get_func_proto( "static %s WINAPI wrap_%s(%s)", $name, $func_ref );
|
|
foreach my $arg (@{$func_ref->[1]})
|
|
{
|
|
my $ptype = get_arg_type( $arg );
|
|
next unless $arg->findnodes("./name");
|
|
my $pname = get_arg_name( $arg );
|
|
my $param = $arg->textContent();
|
|
$call_arg .= " " . $pname . ",";
|
|
}
|
|
$call_arg =~ s/,$/ /;
|
|
$ret .= "\n{\n ";
|
|
$ret .= "return " unless is_void_func( $func_ref );
|
|
$ret .= "$name($call_arg);\n";
|
|
$ret .= "}\n";
|
|
return $ret;
|
|
}
|
|
|
|
sub is_void_func($)
|
|
{
|
|
my $func = shift;
|
|
return 0 if @{$func->[0]->findnodes("./type")};
|
|
return $func->[0]->textContent() eq "void";
|
|
}
|
|
|
|
sub get_arg_type($)
|
|
{
|
|
my $p = shift;
|
|
my @type = $p->findnodes("./type");
|
|
return @type ? $type[0]->textContent() : "cl_int";
|
|
}
|
|
|
|
sub get_arg_name($)
|
|
{
|
|
my $p = shift;
|
|
my @name = $p->findnodes("./name");
|
|
return $name[0]->textContent();
|
|
}
|
|
|
|
sub get_func_proto($$$)
|
|
{
|
|
my ($format, $name, $func) = @_;
|
|
die "unknown func $name" unless defined $func->[0];
|
|
my $proto = $func->[0]->textContent();
|
|
$proto =~ s/ +$//;
|
|
my $args = "";
|
|
foreach my $arg (@{$func->[1]})
|
|
{
|
|
(my $argtext = $arg->textContent()) =~ s/ +/ /g;
|
|
$argtext =~ s/CL_CALLBACK/WINAPI/g;
|
|
$args .= " " . $argtext . ",";
|
|
}
|
|
$args =~ s/,$/ /;
|
|
$args ||= "void";
|
|
return sprintf $format, $proto, $name, $args;
|
|
}
|
|
|
|
# extract and check the number of arguments
|
|
if (@ARGV > 1)
|
|
{
|
|
my $name0 = $0;
|
|
$name0 =~ s%^.*/%%;
|
|
die "Usage: $name0 [version]\n";
|
|
}
|
|
my $version = $ARGV[0] || "1.1";
|
|
if ($version eq "1.0")
|
|
{
|
|
%core_categories = %cat_1_0;
|
|
}
|
|
elsif ($version eq "1.1")
|
|
{
|
|
%core_categories = %cat_1_1;
|
|
}
|
|
else
|
|
{
|
|
die "Incorrect OpenCL version.\n";
|
|
}
|
|
|
|
my $url = "https://raw.githubusercontent.com/KhronosGroup/OpenCL-Docs";
|
|
my $commit = "514965312a65e5d01ae17e23119dc95427b7149e";
|
|
-f "cl-$commit.xml" || system "wget", "-O", "cl-$commit.xml", "$url/$commit/xml/cl.xml" || die "cannot download cl.xml";
|
|
|
|
sub generate_spec_entry($$)
|
|
{
|
|
my ($name, $func) = @_;
|
|
my $args=" ";
|
|
foreach my $arg (@{$func->[1]})
|
|
{
|
|
my $ptype = get_arg_type( $arg );
|
|
my $param = $arg->textContent();
|
|
if ($param =~ /[[*]/)
|
|
{
|
|
$args .= "ptr ";
|
|
}
|
|
elsif (defined($arg_types{$ptype}))
|
|
{
|
|
$args .= "$@$arg_types{$ptype}[0] ";
|
|
}
|
|
elsif ($ptype ne "void")
|
|
{
|
|
die "No conversion for func $name type $param\n";
|
|
}
|
|
}
|
|
$args = substr($args,1,-1);
|
|
return "@ stdcall $_($args)";
|
|
}
|
|
|
|
my %core_functions;
|
|
my %cl_enums;
|
|
my (%cl_types, @cl_types); # also use an array to preserve declaration order
|
|
|
|
# some functions need a hand-written wrapper
|
|
sub needs_pe_wrapper($)
|
|
{
|
|
my %funcs =
|
|
(
|
|
# need extension filtering
|
|
"clGetDeviceInfo" => 1,
|
|
"clGetPlatformInfo" => 1,
|
|
|
|
# needs function pointer conversion
|
|
"clGetExtensionFunctionAddress" => 1,
|
|
|
|
# deprecated and absent from headers
|
|
"clSetCommandQueueProperty" => 1,
|
|
);
|
|
my $name = shift;
|
|
|
|
return defined $funcs{$name};
|
|
}
|
|
|
|
# some functions need a hand-written wrapper
|
|
sub needs_unix_wrapper($)
|
|
{
|
|
my %funcs =
|
|
(
|
|
# need callback conversion
|
|
"clBuildProgram" => 1,
|
|
"clCreateContext" => 1,
|
|
"clCreateContextFromType" => 1,
|
|
"clEnqueueNativeKernel" => 1,
|
|
"clSetEventCallback" => 1,
|
|
"clSetMemObjectDestructorCallback" => 1,
|
|
);
|
|
my $name = shift;
|
|
|
|
return defined $funcs{$name};
|
|
}
|
|
|
|
# don't bother putting unused functions in the interface
|
|
sub needs_unix_function($)
|
|
{
|
|
my %funcs =
|
|
(
|
|
"clGetExtensionFunctionAddress" => 1,
|
|
"clSetCommandQueueProperty" => 1,
|
|
);
|
|
my $name = shift;
|
|
|
|
return not defined $funcs{$name};
|
|
}
|
|
|
|
sub generate_struct($)
|
|
{
|
|
my $type = shift;
|
|
my $name = $type->{name};
|
|
my $ret = "typedef struct _$name\n{\n";
|
|
foreach my $member ($type->findnodes("./member"))
|
|
{
|
|
($member = $member->textContent()) =~ s/ +/ /g;
|
|
$ret .= " $member;\n";
|
|
}
|
|
$ret .= "} $name;\n";
|
|
return $ret;
|
|
}
|
|
|
|
sub parse_file($)
|
|
{
|
|
my $file = shift;
|
|
my $xml = XML::LibXML->load_xml( location => $file );
|
|
my %functions;
|
|
my %enums;
|
|
my %types;
|
|
|
|
# save all functions
|
|
foreach my $command ($xml->findnodes("/registry/commands/command"))
|
|
{
|
|
my $proto = @{$command->findnodes("./proto")}[0];
|
|
my $name = @{$command->findnodes("./proto/name")}[0];
|
|
$proto->removeChild( $name );
|
|
my @params = $command->findnodes("./param");
|
|
$functions{$name->textContent()} = [ $proto, \@params ];
|
|
}
|
|
|
|
# save all enums
|
|
foreach my $enum ($xml->findnodes("/registry/enums/enum"))
|
|
{
|
|
if (defined $enum->{value})
|
|
{
|
|
$enums{$enum->{name}} = $enum->{value};
|
|
}
|
|
else
|
|
{
|
|
$enums{$enum->{name}} = "(1 << " . $enum->{bitpos} . ")";
|
|
}
|
|
}
|
|
|
|
# save all types
|
|
foreach my $type ($xml->findnodes("/registry/types/type"))
|
|
{
|
|
if ($type->{category} eq "define")
|
|
{
|
|
my $name = @{$type->findnodes("./name")}[0];
|
|
$name = $name->textContent;
|
|
$types{$name} = $type;
|
|
|
|
my $basetype = @{$type->findnodes("./type")}[0];
|
|
if ($type->textContent() =~ /[[*]/)
|
|
{
|
|
$arg_types{$name} = ["ptr", "%p"];
|
|
}
|
|
elsif (defined($basetype) and defined($arg_types{$basetype->textContent}))
|
|
{
|
|
$arg_types{$name} = $arg_types{$basetype->textContent};
|
|
}
|
|
elsif ($name ne "cl_icd_dispatch")
|
|
{
|
|
die "No conversion for type $name\n"
|
|
}
|
|
}
|
|
elsif ($type->{category} eq "struct")
|
|
{
|
|
my $name = $type->{name};
|
|
$types{$name} = $type;
|
|
}
|
|
}
|
|
|
|
# generate core functions
|
|
foreach my $feature ($xml->findnodes("/registry/feature"))
|
|
{
|
|
next unless defined $core_categories{$feature->{name}};
|
|
foreach my $cmd ($feature->findnodes("./require/command"))
|
|
{
|
|
$core_functions{$cmd->{name}} = $functions{$cmd->{name}};
|
|
}
|
|
foreach my $enum ($feature->findnodes("./require/enum"))
|
|
{
|
|
$cl_enums{$enum->{name}} = $enums{$enum->{name}};
|
|
}
|
|
foreach my $type ($feature->findnodes("./require/type"))
|
|
{
|
|
next unless $types{$type->{name}};
|
|
push @cl_types, $type->{name} unless $cl_types{$type->{name}};
|
|
$cl_types{$type->{name}} = $types{$type->{name}};
|
|
}
|
|
}
|
|
|
|
# generate extension list
|
|
foreach my $ext ($xml->findnodes("/registry/extensions/extension"))
|
|
{
|
|
# we currently don't support clGetExtensionFunctionAddress, and
|
|
# implementing clGetExtensionFunctionAddressForPlatform is nontrivial;
|
|
# we need to generate a table of thunks per platform and retrieve the
|
|
# platform from the called object
|
|
$unsupported_extensions{lc($ext->{name})} = 1 if $ext->findnodes("./require/command");
|
|
}
|
|
}
|
|
|
|
parse_file( "cl-$commit.xml" );
|
|
|
|
# generate the spec file
|
|
open(SPEC, ">$spec_file") or die "cannot create $spec_file";
|
|
|
|
foreach (sort keys %core_functions)
|
|
{
|
|
printf SPEC "%s\n", generate_spec_entry( $_, $core_functions{$_} );
|
|
}
|
|
|
|
close(SPEC);
|
|
|
|
|
|
# generate the PE thunks
|
|
open(PE, ">$pe_file") or die "cannot create $pe_file";
|
|
|
|
print PE "/* Automatically generated from OpenCL registry files; DO NOT EDIT! */\n\n";
|
|
|
|
print PE "#include \"opencl_private.h\"\n";
|
|
print PE "#include \"opencl_types.h\"\n";
|
|
print PE "#include \"unixlib.h\"\n\n";
|
|
|
|
print PE "WINE_DEFAULT_DEBUG_CHANNEL(opencl);\n" if $gen_traces;
|
|
|
|
foreach (sort keys %core_functions)
|
|
{
|
|
next if needs_pe_wrapper( $_ );
|
|
print PE "\n", generate_pe_thunk( $_, $core_functions{$_} );
|
|
}
|
|
|
|
print PE <<EOF
|
|
|
|
BOOL extension_is_supported( const char *name, size_t len )
|
|
{
|
|
unsigned int i;
|
|
|
|
static const char *const unsupported[] =
|
|
{
|
|
EOF
|
|
;
|
|
|
|
foreach (sort keys %unsupported_extensions)
|
|
{
|
|
print PE " \"$_\",\n";
|
|
}
|
|
|
|
print PE <<EOF
|
|
};
|
|
|
|
for (i = 0; i < ARRAY_SIZE(unsupported); ++i)
|
|
{
|
|
if (!strncasecmp( name, unsupported[i], len ))
|
|
return FALSE;
|
|
}
|
|
return TRUE;
|
|
}
|
|
EOF
|
|
;
|
|
|
|
close(PE);
|
|
|
|
# generate the unix library thunks
|
|
open(UNIX, ">$unix_file") or die "cannot create $unix_file";
|
|
|
|
print UNIX <<EOF
|
|
/* Automatically generated from OpenCL registry files; DO NOT EDIT! */
|
|
|
|
#if 0
|
|
#pragma makedep unix
|
|
#endif
|
|
|
|
#include "config.h"
|
|
#include "unix_private.h"
|
|
EOF
|
|
;
|
|
|
|
foreach (sort keys %core_functions)
|
|
{
|
|
next unless needs_unix_function( $_ );
|
|
next if needs_unix_wrapper( $_ );
|
|
print UNIX "\n", generate_unix_thunk( $_, $core_functions{$_} );
|
|
}
|
|
|
|
print UNIX "\nconst struct opencl_funcs funcs =\n{\n";
|
|
foreach (sort keys %core_functions)
|
|
{
|
|
next unless needs_unix_function( $_ );
|
|
print UNIX " wrap_" . $_ . ",\n";
|
|
}
|
|
print UNIX "};\n";
|
|
|
|
close(UNIX);
|
|
|
|
# generate the unix library header
|
|
open(UNIXHEADER, ">$unixheader_file") or die "cannot create $unixheader_file";
|
|
|
|
print UNIXHEADER "/* Automatically generated from OpenCL registry files; DO NOT EDIT! */\n\n";
|
|
|
|
print UNIXHEADER "struct opencl_funcs\n{\n";
|
|
foreach (sort keys %core_functions)
|
|
{
|
|
next unless needs_unix_function( $_ );
|
|
print UNIXHEADER get_func_proto( " %s (WINAPI *p%s)(%s);\n", $_, $core_functions{$_} );
|
|
}
|
|
print UNIXHEADER "};\n\n";
|
|
|
|
print UNIXHEADER "extern const struct opencl_funcs *opencl_funcs;\n";
|
|
|
|
close(UNIXHEADER);
|
|
|
|
# generate the Win32 type definitions
|
|
open(TYPES, ">$types_file") or die "cannot create $types_file";
|
|
|
|
print TYPES <<END
|
|
/* Automatically generated from OpenCL registry files; DO NOT EDIT! */
|
|
|
|
typedef int32_t cl_int DECLSPEC_ALIGN(4);
|
|
typedef uint32_t cl_uint DECLSPEC_ALIGN(4);
|
|
typedef uint64_t cl_ulong DECLSPEC_ALIGN(8);
|
|
|
|
END
|
|
;
|
|
|
|
foreach (@cl_types)
|
|
{
|
|
my $type = $cl_types{$_};
|
|
if ($type->{category} eq "define")
|
|
{
|
|
print TYPES $type->textContent() . "\n";
|
|
}
|
|
elsif ($type->{category} eq "struct")
|
|
{
|
|
print TYPES generate_struct( $type );
|
|
}
|
|
}
|
|
|
|
print TYPES "\n";
|
|
|
|
foreach (sort keys %cl_enums)
|
|
{
|
|
printf TYPES "#define %s %s\n", $_, $cl_enums{$_};
|
|
}
|
|
|
|
close(TYPES);
|