5 # Copyright 2021 Zebediah Figura
7 # This library is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU Lesser General Public
9 # License as published by the Free Software Foundation; either
10 # version 2.1 of the License, or (at your option) any later version.
12 # This library is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # Lesser General Public License for more details.
17 # You should have received a copy of the GNU Lesser General Public
18 # License along with this library; if not, write to the Free Software
19 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
22 my $spec_file = "opencl.spec";
23 my $pe_file = "pe_thunks.c";
24 my $types_file = "opencl_types.h";
25 my $unix_file = "unix_thunks.c";
26 my $unixheader_file = "unixlib.h";
28 # If set to 1, generate TRACEs for each OpenGL function
31 # List of categories to put in the 'opengl_core.c' file
32 my %cat_1_0 = ( "CL_VERSION_1_0" => 1 );
33 my %cat_1_1 = ( %cat_1_0, "CL_VERSION_1_1" => 1 );
34 my %cat_1_2 = ( %cat_1_1, "CL_VERSION_1_2" => 1 );
36 my %core_categories = ();
41 "cl_bitfield" => [ "int64", "ULONGLONG", "wine_dbgstr_longlong(%s)" ],
42 "double" => [ "double", "DOUBLE", "%.16e" ],
43 "float" => [ "float", "float", "%.8e" ],
44 "int" => [ "long", "int", "%d" ],
45 "int8_t" => [ "long", "int8_t", "%d" ],
46 "int16_t" => [ "long", "int16_t", "%d" ],
47 "int32_t" => [ "long", "int32_t", "%d" ],
48 "int64_t" => [ "int64", "LONGLONG", "wine_dbgstr_longlong(%s)" ],
49 "intptr_t" => [ "long", "INT_PTR", "%Id" ],
50 "size_t" => [ "long", "SIZE_T", "%Iu" ],
51 "uint8_t" => [ "long", "uint8_t", "%u" ],
52 "uint16_t" => [ "long", "uint16_t", "%u" ],
53 "uint32_t" => [ "long", "uint32_t", "%u" ],
54 "uint64_t" => [ "int64", "ULONGLONG", "wine_dbgstr_longlong(%s)" ],
55 "unsigned int" => [ "long", "unsigned int", "%u" ],
58 my %unsupported_extensions =
60 # Needs wined3d integration.
61 "cl_intel_d3d11_nv12_media_sharing" => 1,
62 "cl_intel_dx9_media_sharing" => 1,
63 "cl_khr_d3d10_sharing" => 1,
64 "cl_khr_d3d11_sharing" => 1,
65 "cl_khr_dx9_media_sharing" => 1,
66 "cl_nv_d3d9_sharing" => 1,
67 "cl_nv_d3d10_sharing" => 1,
68 "cl_nv_d3d11_sharing" => 1,
70 # Needs a loader/ICD split.
72 "cl_loader_layers" => 1,
74 # Needs callback conversion.
75 "cl_apple_setmemobjectdestructor" => 1,
76 "cl_arm_shared_virtual_memory" => 1,
79 sub generate_pe_thunk
($$)
81 my ($name, $func_ref) = @_;
83 my $trace_call_arg = "";
86 my $ret = get_func_proto
( "%s WINAPI %s(%s)", $name, $func_ref );
87 my $proto = $func_ref->[0]->textContent();
89 foreach my $arg (@
{$func_ref->[1]})
91 my $ptype = get_arg_type
( $arg );
92 next unless $arg->findnodes("./name");
93 my $pname = get_arg_name
( $arg );
94 my $param = $arg->textContent();
95 $call_arg .= " " . $pname . ",";
96 if ($param =~ /\*/ || $param =~ /\[/)
99 $trace_call_arg .= ", " . $pname;
101 elsif (defined $arg_types{$ptype})
103 my $format = ${$arg_types{$ptype}}[2];
104 $trace_arg .= ", " . ($format =~ /^%/ ?
$format : "%s");
105 $trace_call_arg .= ", " . sprintf $format =~ /^%/ ?
"%s" : $format, $pname;
109 die "Unknown type %s in %s\n", $param, $name;
112 $call_arg =~ s/,$/ /;
113 $trace_arg =~ s/^, //;
115 if (is_void_func
( $func_ref ))
117 $ret .= " struct ${name}_params params = {$call_arg};\n";
118 $ret .= " TRACE( \"($trace_arg)\\n\"$trace_call_arg );\n" if $gen_traces;
119 $ret .= " OPENCL_CALL( $name, ¶ms );\n"
121 elsif ($proto eq "cl_int")
123 $ret .= " struct ${name}_params params = {$call_arg};\n";
124 $ret .= " TRACE( \"($trace_arg)\\n\"$trace_call_arg );\n" if $gen_traces;
125 $ret .= " return OPENCL_CALL( $name, ¶ms );\n";
129 $ret .= " $proto __retval;\n";
130 $ret .= " struct ${name}_params params = { &__retval,$call_arg};\n";
131 $ret .= " TRACE( \"($trace_arg)\\n\"$trace_call_arg );\n" if $gen_traces;
132 $ret .= " OPENCL_CALL( $name, ¶ms );\n";
133 $ret .= " return __retval;\n";
139 sub generate_unix_thunk
($$)
141 my ($name, $func_ref) = @_;
144 my $ret = "static NTSTATUS wrap_$name( void *args )\n";
145 my $proto = $func_ref->[0]->textContent();
147 foreach my $arg (@
{$func_ref->[1]})
149 my $ptype = get_arg_type
( $arg );
150 next unless $arg->findnodes("./name");
151 my $pname = get_arg_name
( $arg );
152 my $param = $arg->textContent();
153 $call_arg .= " params->" . $pname . ",";
155 $call_arg =~ s/,$/ /;
157 $ret .= " struct ${name}_params *params = args;\n\n" if $call_arg;
158 if (is_void_func
( $func_ref ))
160 $ret .= " $name($call_arg);\n";
162 elsif ($proto eq "cl_int")
164 $ret .= " return $name($call_arg);\n";
168 $ret .= " *params->__retval = $name($call_arg);\n";
169 $ret .= " return STATUS_SUCCESS;\n";
178 return 0 if @
{$func->[0]->findnodes("./type")};
179 return $func->[0]->textContent() eq "void";
185 my @type = $p->findnodes("./type");
186 return @type ?
$type[0]->textContent() : "cl_int";
192 my @name = $p->findnodes("./name");
193 return $name[0]->textContent();
196 sub get_func_proto
($$$)
198 my ($format, $name, $func) = @_;
199 die "unknown func $name" unless defined $func->[0];
200 my $proto = $func->[0]->textContent();
203 foreach my $arg (@
{$func->[1]})
205 (my $argtext = $arg->textContent()) =~ s/ +/ /g;
206 $argtext =~ s/CL_CALLBACK/WINAPI/g;
207 $args .= " " . $argtext . ",";
211 return sprintf $format, $proto, $name, $args;
214 sub get_func_params
($$)
216 my ($name, $func) = @_;
217 die "unknown func $name" unless defined $func->[0];
218 my $proto = $func->[0]->textContent();
220 my $params = "struct ${name}_params\n{\n";
221 $params .= " $proto* __retval;\n" unless $proto eq "cl_int";
222 foreach my $arg (@
{$func->[1]})
224 my $ptype = get_arg_type
( $arg );
225 next unless $arg->findnodes("./name");
226 my $pname = get_arg_name
( $arg );
227 (my $param = $arg->textContent()) =~ s/ +/ /g;
228 $param =~ s/CL_CALLBACK/WINAPI/g;
229 if ($param =~ /[[*]/)
231 $params .= " $param;\n";
233 elsif (defined $arg_types{$ptype})
235 $params .= " ${$arg_types{$ptype}}[1] $pname;\n";
239 die "Unknown type %s in %s\n", $param, $name;
242 return $params . "};\n";
245 # extract and check the number of arguments
250 die "Usage: $name0 [version]\n";
252 my $version = $ARGV[0] || "1.2";
253 if ($version eq "1.0")
255 %core_categories = %cat_1_0;
257 elsif ($version eq "1.1")
259 %core_categories = %cat_1_1;
261 elsif ($version eq "1.2")
263 %core_categories = %cat_1_2;
267 die "Incorrect OpenCL version.\n";
270 my $url = "https://raw.githubusercontent.com/KhronosGroup/OpenCL-Docs";
271 my $commit = "514965312a65e5d01ae17e23119dc95427b7149e";
272 -f
"cl-$commit.xml" || system "wget", "-O", "cl-$commit.xml", "$url/$commit/xml/cl.xml" || die "cannot download cl.xml";
274 sub generate_spec_entry
($$)
276 my ($name, $func) = @_;
278 foreach my $arg (@
{$func->[1]})
280 my $ptype = get_arg_type
( $arg );
281 my $param = $arg->textContent();
282 if ($param =~ /[[*]/)
286 elsif (defined($arg_types{$ptype}))
288 $args .= "$@$arg_types{$ptype}[0] ";
290 elsif ($ptype ne "void")
292 die "No conversion for func $name type $param\n";
295 $args = substr($args,1,-1);
296 return "@ stdcall $_($args)";
301 my (%header_types, @header_types); # also use an array to preserve declaration order
303 # some functions need a hand-written wrapper
304 sub needs_pe_wrapper
($)
308 # need extension filtering
309 "clGetDeviceInfo" => 1,
310 "clGetPlatformInfo" => 1,
312 # needs function pointer conversion
313 "clGetExtensionFunctionAddress" => 1,
314 "clGetExtensionFunctionAddressForPlatform" => 1,
316 # deprecated and absent from headers
317 "clSetCommandQueueProperty" => 1,
319 # needs GL object unwrapping
320 "clCreateFromGLBuffer" => 1,
321 "clCreateFromGLRenderbuffer" => 1,
322 "clCreateFromGLTexture" => 1,
323 "clCreateFromGLTexture2D" => 1,
324 "clCreateFromGLTexture3D" => 1,
325 "clEnqueueAcquireGLObjects" => 1,
326 "clEnqueueReleaseGLObjects" => 1,
327 "clGetGLObjectInfo" => 1,
328 "clGetGLTextureInfo" => 1,
332 return defined $funcs{$name};
335 # some functions need a hand-written wrapper
336 sub needs_unix_wrapper
($)
340 # need callback conversion
341 "clBuildProgram" => 1,
342 "clCompileProgram" => 1,
343 "clCreateContext" => 1,
344 "clCreateContextFromType" => 1,
345 "clEnqueueNativeKernel" => 1,
346 "clLinkProgram" => 1,
347 "clSetEventCallback" => 1,
348 "clSetMemObjectDestructorCallback" => 1,
352 return defined $funcs{$name};
355 # don't bother putting unused functions in the interface
356 sub needs_unix_function
($)
360 "clGetExtensionFunctionAddress" => 1,
361 "clGetExtensionFunctionAddressForPlatform" => 1,
362 "clSetCommandQueueProperty" => 1,
364 # not yet implemented
365 "clCreateFromGLBuffer" => 1,
366 "clCreateFromGLRenderbuffer" => 1,
367 "clCreateFromGLTexture" => 1,
368 "clCreateFromGLTexture2D" => 1,
369 "clCreateFromGLTexture3D" => 1,
370 "clEnqueueAcquireGLObjects" => 1,
371 "clEnqueueReleaseGLObjects" => 1,
372 "clGetGLObjectInfo" => 1,
373 "clGetGLTextureInfo" => 1,
377 return not defined $funcs{$name};
380 sub generate_struct
($)
383 my $name = $type->{name
};
384 my $ret = "typedef struct _$name\n{\n";
385 foreach my $member ($type->findnodes("./member"))
387 ($member = $member->textContent()) =~ s/ +/ /g;
388 $ret .= " $member;\n";
390 $ret .= "} $name;\n";
398 sub parse_feature
($$)
400 my ($feature, $is_core) = @_;
402 my %extra_core_functions =
404 # these are not core, but exported from the loader anyway
405 "clCreateFromGLBuffer" => 1,
406 "clCreateFromGLRenderbuffer" => 1,
407 "clCreateFromGLTexture" => 1,
408 "clCreateFromGLTexture2D" => 1,
409 "clCreateFromGLTexture3D" => 1,
410 "clEnqueueAcquireGLObjects" => 1,
411 "clEnqueueReleaseGLObjects" => 1,
412 "clGetGLObjectInfo" => 1,
413 "clGetGLTextureInfo" => 1,
416 foreach my $cmd ($feature->findnodes("./require/command"))
418 # TODO: store these in a separate list
419 next unless $is_core or defined $extra_core_functions{$cmd->{name
}};
421 $core_functions{$cmd->{name
}} = $all_functions{$cmd->{name
}};
423 foreach my $enum ($feature->findnodes("./require/enum"))
425 $header_enums{$enum->{name
}} = $all_enums{$enum->{name
}};
427 foreach my $type ($feature->findnodes("./require/type"))
429 next unless $all_types{$type->{name
}};
430 push @header_types, $type->{name
} unless $header_types{$type->{name
}};
431 $header_types{$type->{name
}} = $all_types{$type->{name
}};
438 my $xml = XML
::LibXML
->load_xml( location
=> $file );
441 foreach my $command ($xml->findnodes("/registry/commands/command"))
443 my $proto = @
{$command->findnodes("./proto")}[0];
444 my $name = @
{$command->findnodes("./proto/name")}[0];
445 $proto->removeChild( $name );
446 my @params = $command->findnodes("./param");
447 $all_functions{$name->textContent()} = [ $proto, \
@params ];
451 foreach my $enum ($xml->findnodes("/registry/enums/enum"))
453 if (defined $enum->{value
})
455 $all_enums{$enum->{name
}} = $enum->{value
};
459 $all_enums{$enum->{name
}} = "(1 << " . $enum->{bitpos
} . ")";
464 foreach my $type ($xml->findnodes("/registry/types/type"))
466 if ($type->{category
} eq "define")
468 my $name = @
{$type->findnodes("./name")}[0];
469 $name = $name->textContent;
470 $all_types{$name} = $type;
472 my $basetype = @
{$type->findnodes("./type")}[0];
473 if ($type->textContent() =~ /[[*]/)
475 $arg_types{$name} = ["ptr", $name, "%p"];
477 elsif (defined($basetype) and defined($arg_types{$basetype->textContent}))
479 $arg_types{$name} = $arg_types{$basetype->textContent};
481 elsif ($name ne "cl_icd_dispatch")
483 die "No conversion for type $name\n"
486 elsif ($type->{category
} eq "struct")
488 my $name = $type->{name
};
489 $all_types{$name} = $type;
493 # generate core functions
494 foreach my $feature ($xml->findnodes("/registry/feature"))
496 parse_feature
($feature, 1) if defined $core_categories{$feature->{name
}};
499 # generate extension list and functions
500 foreach my $ext ($xml->findnodes("/registry/extensions/extension"))
502 # we currently don't support clGetExtensionFunctionAddress, and
503 # implementing clGetExtensionFunctionAddressForPlatform is nontrivial;
504 # we need to generate a table of thunks per platform and retrieve the
505 # platform from the called object
506 $unsupported_extensions{lc($ext->{name
})} = 1 if $ext->findnodes("./require/command");
508 # FIXME: Parse all supported extensions. Note that we don't actually
509 # support KHR_gl_sharing yet, but we need to export the functions anyway
510 # (some applications expect them to be present).
511 parse_feature
($ext, 0) if lc($ext->{name
}) eq "cl_khr_gl_sharing";
515 parse_file
( "cl-$commit.xml" );
517 # generate the spec file
518 open(SPEC
, ">$spec_file") or die "cannot create $spec_file";
520 foreach (sort keys %core_functions)
522 printf SPEC
"%s\n", generate_spec_entry
( $_, $core_functions{$_} );
528 # generate the PE thunks
529 open(PE
, ">$pe_file") or die "cannot create $pe_file";
531 print PE
"/* Automatically generated from OpenCL registry files; DO NOT EDIT! */\n\n";
533 print PE
"#include \"opencl_private.h\"\n";
534 print PE
"#include \"opencl_types.h\"\n";
535 print PE
"#include \"unixlib.h\"\n\n";
537 print PE
"WINE_DEFAULT_DEBUG_CHANNEL(opencl);\n" if $gen_traces;
539 foreach (sort keys %core_functions)
541 next if needs_pe_wrapper
( $_ );
542 print PE
"\n", generate_pe_thunk
( $_, $core_functions{$_} );
547 BOOL extension_is_supported( const char *name, size_t len )
551 static const char *const unsupported[] =
556 foreach (sort keys %unsupported_extensions)
558 print PE
" \"$_\",\n";
564 for (i = 0; i < ARRAY_SIZE(unsupported); ++i)
566 if (!strncasecmp( name, unsupported[i], len ))
576 # generate the unix library thunks
577 open(UNIX
, ">$unix_file") or die "cannot create $unix_file";
580 /* Automatically generated from OpenCL registry files; DO NOT EDIT! */
587 #include "unix_private.h"
591 foreach (sort keys %core_functions)
593 next unless needs_unix_function
( $_ );
594 next if needs_unix_wrapper
( $_ );
595 print UNIX
"\n", generate_unix_thunk
( $_, $core_functions{$_} );
598 print UNIX
"\nconst unixlib_entry_t __wine_unix_call_funcs[] =\n{\n";
599 foreach (sort keys %core_functions)
601 next unless needs_unix_function
( $_ );
602 print UNIX
" wrap_" . $_ . ",\n";
608 # generate the unix library header
609 open(UNIXHEADER
, ">$unixheader_file") or die "cannot create $unixheader_file";
611 print UNIXHEADER
"/* Automatically generated from OpenCL registry files; DO NOT EDIT! */\n\n";
613 foreach (sort keys %core_functions)
615 next unless needs_unix_function
( $_ );
616 print UNIXHEADER get_func_params
( $_, $core_functions{$_} ), "\n";
619 print UNIXHEADER
"enum opencl_funcs\n{\n";
620 foreach (sort keys %core_functions)
622 next unless needs_unix_function
( $_ );
623 print UNIXHEADER
" unix_$_,\n";
625 print UNIXHEADER
"};\n";
629 # generate the Win32 type definitions
630 open(TYPES
, ">$types_file") or die "cannot create $types_file";
633 /* Automatically generated from OpenCL registry files; DO NOT EDIT! */
635 typedef int32_t DECLSPEC_ALIGN(4) cl_int;
636 typedef uint32_t DECLSPEC_ALIGN(4) cl_uint;
637 typedef uint64_t DECLSPEC_ALIGN(8) cl_ulong;
642 foreach (@header_types)
644 my $type = $header_types{$_};
645 if ($type->{category
} eq "define")
647 print TYPES
$type->textContent() . "\n";
649 elsif ($type->{category
} eq "struct")
651 print TYPES generate_struct
( $type );
657 foreach (sort keys %header_enums)
659 printf TYPES
"#define %s %s\n", $_, $header_enums{$_};