| … | |
… | |
| 12 | context Context |
12 | context Context |
| 13 | event Event |
13 | event Event |
| 14 | profiling Event |
14 | profiling Event |
| 15 | mem Memory |
15 | mem Memory |
| 16 | image Image |
16 | image Image |
|
|
17 | gl_texture Image |
| 17 | sampler Sampler |
18 | sampler Sampler |
| 18 | program Program |
19 | program Program |
| 19 | program_build Program |
20 | program_build Program |
| 20 | kernel Kernel |
21 | kernel Kernel |
| 21 | kernel_work_group Kernel |
22 | kernel_work_group Kernel |
| … | |
… | |
| 76 | } |
77 | } |
| 77 | |
78 | |
| 78 | rename "$file~", $file; |
79 | rename "$file~", $file; |
| 79 | } |
80 | } |
| 80 | |
81 | |
| 81 | for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling)) { |
82 | for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling gl_texture)) { |
| 82 | open my $fh, "<getinfo.txt" |
83 | open my $fh, "<getinfo.txt" |
| 83 | or die "getinfo.txt: $!"; |
84 | or die "getinfo.txt: $!"; |
| 84 | |
85 | |
| 85 | my $POD; |
86 | my $POD; |
| 86 | my @funcs; |
87 | my @funcs; |
| … | |
… | |
| 160 | # after we generate the bdoy we look for an identical body generated earlier |
161 | # after we generate the bdoy we look for an identical body generated earlier |
| 161 | # and simply alias us to the earlier xs function, to save text size. |
162 | # and simply alias us to the earlier xs function, to save text size. |
| 162 | my ($XS1, $XS2); |
163 | my ($XS1, $XS2); |
| 163 | |
164 | |
| 164 | $XS1 = "void\n" |
165 | $XS1 = "void\n" |
| 165 | . "XXXNAMEXXX (OpenCL::$classmap{$real_class} this$extra_xs_args)\n"; |
166 | . "XXXNAMEXXX (OpenCL::$classmap{$real_class} self$extra_xs_args)\n"; |
| 166 | $XS2 = " PPCODE:\n"; |
167 | $XS2 = " PPCODE:\n"; |
| 167 | |
168 | |
| 168 | if ($dynamic) { |
169 | if ($dynamic) { |
| 169 | $XS2 .= " size_t size;\n" |
170 | $XS2 .= " size_t size;\n" |
| 170 | . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, 0, 0, &size));\n" |
171 | . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, 0, 0, &size));\n" |
| 171 | . " $type->[0] *value = tmpbuf (size);\n" |
172 | . " $type->[0] *value = tmpbuf (size);\n" |
| 172 | . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, size, value, 0));\n"; |
173 | . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, size, value, 0));\n"; |
| 173 | } else { |
174 | } else { |
| 174 | $XS2 .= " $type->[0] value [1];\n" |
175 | $XS2 .= " $type->[0] value [1];\n" |
| 175 | . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, sizeof (value), value, 0));\n"; |
176 | . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, sizeof (value), value, 0));\n"; |
| 176 | } |
177 | } |
| 177 | |
178 | |
| 178 | if ($array && $nelem ne "1") { |
179 | if ($array && $nelem ne "1") { |
| 179 | $XS2 .= " int i, n = $nelem;\n" |
180 | $XS2 .= " int i, n = $nelem;\n" |
| 180 | . " EXTEND (SP, n);\n" |
181 | . " EXTEND (SP, n);\n" |
| … | |
… | |
| 220 | $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; |
221 | $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; |
| 221 | } |
222 | } |
| 222 | $XS .= join "", @$_; |
223 | $XS .= join "", @$_; |
| 223 | } |
224 | } |
| 224 | |
225 | |
|
|
226 | warn "patching class $CLASS\n"; |
|
|
227 | |
| 225 | patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS; |
228 | patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS; |
| 226 | patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD; |
229 | patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD; |
| 227 | } |
230 | } |
| 228 | |
231 | |
