ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/OpenCL/gengetinfo
(Generate patch)

Comparing OpenCL/gengetinfo (file contents):
Revision 1.13 by root, Fri May 4 14:29:35 2012 UTC vs.
Revision 1.17 by root, Sat May 5 13:30:07 2012 UTC

… …
18 sampler Sampler 18 sampler Sampler
19 program Program 19 program Program
20 program_build Program 20 program_build Program
21 kernel Kernel 21 kernel Kernel
22 kernel_work_group Kernel 22 kernel_work_group Kernel
23 kernel_arg_info Kernel
23 command_queue Queue 24 command_queue Queue
24); 25);
25 26
26my %typemap = ( 27my %typemap = (
28 # getinfo.txt c type, constructor, pod
27 cl_bool => ['cl_bool', 'value [i] ? &PL_sv_yes : &PL_sv_no', 'boolean'], 29 cl_bool => ['cl_bool', 'value [i] ? &PL_sv_yes : &PL_sv_no', 'boolean'],
28 #char => ['char', 'newSVpvn (value, size)', 'string'], 30 #char => ['char', 'newSVpvn (value, size)', 'string'],
29 char => ['char', 'newSVpv (value, 0)', 'string'], # all these are 0-terminated strings, and the driver often appends a \0 31 char => ['char', 'newSVpv (value, 0)', 'string'], # all these are 0-terminated strings, and the driver often appends a \0
30 size_t => ['size_t', 'newSVuv (value [i])', 'int'], 32 size_t => ['size_t', 'newSVuv (value [i])', 'int'],
31 "void*" => ['void *', 'newSVuv ((IV)(intptr_t)value [i])', 'ptr_value'], 33 "void*" => ['void *', 'newSVuv ((IV)(intptr_t)value [i])', 'ptr_value'],
… …
35 cl_device_id => ['cl_device_id', 'OpenCL::Device', 'device'], 37 cl_device_id => ['cl_device_id', 'OpenCL::Device', 'device'],
36 Memory => ['cl_mem', 'OpenCL::Memory', 'mem'], 38 Memory => ['cl_mem', 'OpenCL::Memory', 'mem'],
37 Program => ['cl_program', 'OpenCL::Program', 'program'], 39 Program => ['cl_program', 'OpenCL::Program', 'program'],
38 CommandQueue => ['cl_command_queue', 'OpenCL::Queue', 'queue'], 40 CommandQueue => ['cl_command_queue', 'OpenCL::Queue', 'queue'],
39 cl_context_properties => ['cl_context_properties', 'newSVuv ((UV)value [i])', 'property_int'], 41 cl_context_properties => ['cl_context_properties', 'newSVuv ((UV)value [i])', 'property_int'],
42 cl_program_binary_type => ['cl_program_binary_type', 'newSVuv (UV)value [i])', 'binary_type'],
40); 43);
41 44
42{ 45{
43 my %tmap = ( 46 my %tmap = (
44 T_IV => "newSViv (value [i])", 47 T_IV => "newSViv (value [i])",
… …
77 } 80 }
78 81
79 rename "$file~", $file; 82 rename "$file~", $file;
80} 83}
81 84
82for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling gl_texture)) { 85for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group kernel_arg event profiling gl_texture)) {
83 open my $fh, "<getinfo.txt" 86 open my $fh, "<getinfo.txt"
84 or die "getinfo.txt: $!"; 87 or die "getinfo.txt: $!";
85 88
86 my $POD; 89 my $POD;
87 my @funcs; 90 my @funcs;
… …
106 $cbase = "EventProfiling" if $cbase eq "Profiling"; 109 $cbase = "EventProfiling" if $cbase eq "Profiling";
107 110
108 my $real_class = $CLASS; 111 my $real_class = $CLASS;
109 $real_class = "program" if $real_class eq "program_build"; 112 $real_class = "program" if $real_class eq "program_build";
110 $real_class = "kernel" if $real_class eq "kernel_work_group"; 113 $real_class = "kernel" if $real_class eq "kernel_work_group";
114 $real_class = "kernel" if $real_class eq "kernel_arg";
111 $real_class = "event" if $real_class eq "profiling"; 115 $real_class = "event" if $real_class eq "profiling";
112 116
113 my $perl_name = lc $name; 117 my $perl_name = lc $name;
114 $perl_name =~ s/^cl_//; 118 $perl_name =~ s/^cl_//;
115 $perl_name =~ s/^$real_class\_//; 119 $perl_name =~ s/^$real_class\_//;
… …
121 125
122 if ($CLASS eq "program_build" || $CLASS eq "kernel_work_group") { 126 if ($CLASS eq "program_build" || $CLASS eq "kernel_work_group") {
123 $extra_args = ', device'; 127 $extra_args = ', device';
124 $extra_perl_args = ' ($device)'; 128 $extra_perl_args = ' ($device)';
125 $extra_xs_args = ', OpenCL::Device device'; 129 $extra_xs_args = ', OpenCL::Device device';
130 }
131
132 if ($CLASS eq "kernel_arg") {
133 $extra_args = ', idx';
134 $extra_perl_args = ' ($idx)';
135 $extra_xs_args = ', cl_uint idx';
126 } 136 }
127 137
128 my $dynamic; 138 my $dynamic;
129 my $nelem = "size / sizeof (*value)"; 139 my $nelem = "size / sizeof (*value)";
130 140

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines