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

Comparing OpenCL/gengetinfo (file contents):
Revision 1.18 by root, Sat May 5 13:56:00 2012 UTC vs.
Revision 1.19 by root, Sat May 5 15:43:02 2012 UTC

… …
40 CommandQueue => ['cl_command_queue', 'OpenCL::Queue', 'queue'], 40 CommandQueue => ['cl_command_queue', 'OpenCL::Queue', 'queue'],
41 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'], 42 cl_program_binary_type => ['cl_program_binary_type', 'newSVuv ((UV)value [i])', 'binary_type'],
43); 43);
44 44
45
46# try to re-use types with same representation in C - if we
47# ever overload bitfields etc. then we need to remove all
48# typesimplify code.
49my %typesimplify;
50{
51 open my $h, "<CL/cl.h" or die "CL/cl.h: $!";
52
53 while (<$h>) {
54 $typesimplify{$2} = $1
55 if /typedef\s+(cl_\S+)\s+(cl_\S+);/;
56 }
57}
58
45{ 59{
46 my %tmap = ( 60 my %tmap = (
47 T_IV => "newSViv (value [i])", 61 T_IV => "newSViv (value [i])",
48 T_UV => "newSVuv (value [i])", 62 T_UV => "newSVuv (value [i])",
49 ); 63 );
… …
177 191
178 $XS1 = "void\n" 192 $XS1 = "void\n"
179 . "XXXNAMEXXX (OpenCL::$classmap{$real_class} self$extra_xs_args)\n"; 193 . "XXXNAMEXXX (OpenCL::$classmap{$real_class} self$extra_xs_args)\n";
180 $XS2 = " PPCODE:\n"; 194 $XS2 = " PPCODE:\n";
181 195
196 my $stype = $type->[0]; # simplified type
197 $stype = $typesimplify{$stype} while exists $typesimplify{$stype};
198
182 if ($dynamic) { 199 if ($dynamic) {
183 $XS2 .= " size_t size;\n" 200 $XS2 .= " size_t size;\n"
184 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, 0, 0, &size));\n" 201 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, 0, 0, &size));\n"
185 . " $type->[0] *value = tmpbuf (size);\n" 202 . " $stype *value = tmpbuf (size);\n"
186 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, size, value, 0));\n"; 203 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, size, value, 0));\n";
187 } else { 204 } else {
188 $XS2 .= " $type->[0] value [1];\n" 205 $XS2 .= " $stype value [1];\n"
189 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, sizeof (value), value, 0));\n"; 206 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, sizeof (value), value, 0));\n";
190 } 207 }
191 208
192 if ($array && $nelem ne "1") { 209 if ($array && $nelem ne "1") {
193 $XS2 .= " int i, n = $nelem;\n" 210 $XS2 .= " int i, n = $nelem;\n"
… …
205 222
206 my $stash = lc $type->[1]; 223 my $stash = lc $type->[1];
207 $stash =~ s/opencl:://; 224 $stash =~ s/opencl:://;
208 $stash =~ s/::/_/g; 225 $stash =~ s/::/_/g;
209 226
210 $XS2 .= " {\n";
211 $XS2 .= " NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $oclass eq "Platform" || $oclass eq "Device"; 227 $XS2 .= " NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $oclass eq "Platform" || $oclass eq "Device";
212 $XS2 .= " PUSH_CLOBJ (stash_$stash, value [i]);\n"; 228 $XS2 .= " PUSH_CLOBJ (stash_$stash, value [i]);\n";
213 $XS2 .= " }\n";
214 } else { 229 } else {
215 $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; 230 $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n";
216 } 231 }
217 232
218 $XS2 .= "\n"; 233 $XS2 .= "\n";
… …
233 248
234 if (@{ $_->[1] } == 1) { # undo ALIAS 249 if (@{ $_->[1] } == 1) { # undo ALIAS
235 $_->[2] =~ s/\bix\b/$_->[1][0][1]/g; 250 $_->[2] =~ s/\bix\b/$_->[1][0][1]/g;
236 $_->[1] = ""; 251 $_->[1] = "";
237 } else { 252 } else {
238 $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; 253 $_->[1] = " ALIAS:\n" . join "", sort, map " $_->[0] = $_->[1]\n", @{ $_->[1] };
239 } 254 }
240 $XS .= join "", @$_; 255 $XS .= join "", @$_;
241 } 256 }
242 257
243 warn "patching class $CLASS\n"; 258 warn "patching class $CLASS\n";

Diff Legend

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