| … | |
… | |
| 123 | $extra_args = ', device'; |
123 | $extra_args = ', device'; |
| 124 | $extra_perl_args = ' ($device)'; |
124 | $extra_perl_args = ' ($device)'; |
| 125 | $extra_xs_args = ', OpenCL::Device device'; |
125 | $extra_xs_args = ', OpenCL::Device device'; |
| 126 | } |
126 | } |
| 127 | |
127 | |
|
|
128 | if ($CLASS eq "kernel_arg") { |
|
|
129 | $extra_args = ', idx'; |
|
|
130 | $extra_perl_args = ' ($idx)'; |
|
|
131 | $extra_xs_args = ', cl_uint idx'; |
|
|
132 | } |
|
|
133 | |
| 128 | my $dynamic; |
134 | my $dynamic; |
| 129 | my $nelem = "size / sizeof (*value)"; |
135 | my $nelem = "size / sizeof (*value)"; |
| 130 | |
136 | |
| 131 | if ($ctype eq "STRING_CLASS") { |
137 | if ($ctype eq "STRING_CLASS") { |
| 132 | $ctype = "VECTOR_CLASS<char>"; |
138 | $ctype = "VECTOR_CLASS<char>"; |
| … | |
… | |
| 154 | $perltype = "\@${perltype}s"; |
160 | $perltype = "\@${perltype}s"; |
| 155 | } else { |
161 | } else { |
| 156 | $perltype = "\$$perltype"; |
162 | $perltype = "\$$perltype"; |
| 157 | } |
163 | } |
| 158 | |
164 | |
|
|
165 | (my $perlenum = $name) =~ s/^CL_/OpenCL::/ or die; |
|
|
166 | |
| 159 | $POD .= "=item $perltype = \$$real_class->$perl_name$extra_perl_args\n\nCalls C<clGet${cbase}Info> with C<$name> and returns the result.\n\n"; |
167 | $POD .= "=item $perltype = \$$real_class->$perl_name$extra_perl_args\n\nCalls C<clGet${cbase}Info> with C<$perlenum> and returns the result.\n\n"; |
| 160 | |
168 | |
| 161 | # XS1 contains the function before ALIAS, XS2 the function afterwards (the body) |
169 | # XS1 contains the function before ALIAS, XS2 the function afterwards (the body) |
| 162 | # after we generate the bdoy we look for an identical body generated earlier |
170 | # after we generate the bdoy we look for an identical body generated earlier |
| 163 | # and simply alias us to the earlier xs function, to save text size. |
171 | # and simply alias us to the earlier xs function, to save text size. |
| 164 | my ($XS1, $XS2); |
172 | my ($XS1, $XS2); |
| … | |
… | |
| 189 | if ($type->[1] =~ /^OpenCL::(\S+)$/) { |
197 | if ($type->[1] =~ /^OpenCL::(\S+)$/) { |
| 190 | my $oclass = $1; |
198 | my $oclass = $1; |
| 191 | $oclass = "MemObject" if $oclass eq "Memory"; |
199 | $oclass = "MemObject" if $oclass eq "Memory"; |
| 192 | $oclass = "CommandQueue" if $oclass eq "Queue"; |
200 | $oclass = "CommandQueue" if $oclass eq "Queue"; |
| 193 | |
201 | |
|
|
202 | my $stash = lc $type->[1]; |
|
|
203 | $stash =~ s/opencl:://; |
|
|
204 | $stash =~ s/::/_/g; |
|
|
205 | |
| 194 | $XS2 .= " {\n"; |
206 | $XS2 .= " {\n"; |
| 195 | $XS2 .= " NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $1 eq "Platform" || $1 eq "Device"; |
207 | $XS2 .= " NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $oclass eq "Platform" || $oclass eq "Device"; |
| 196 | $XS2 .= " PUSHs (NEW_MORTAL_OBJ (\"$type->[1]\", value [i]));\n"; |
208 | $XS2 .= " PUSH_CLOBJ (stash_$stash, value [i]);\n"; |
| 197 | $XS2 .= " }\n"; |
209 | $XS2 .= " }\n"; |
| 198 | } else { |
210 | } else { |
| 199 | $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; |
211 | $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; |
| 200 | } |
212 | } |
| 201 | |
213 | |
