… | |
… | |
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; |
… | |
… | |
96 | $ctype =~ s/cl:://g; |
97 | $ctype =~ s/cl:://g; |
97 | $ctype =~ s/::size_t/size_t/g; |
98 | $ctype =~ s/::size_t/size_t/g; |
98 | |
99 | |
99 | my $cbase = $class; |
100 | my $cbase = $class; |
100 | $cbase =~ s/_(.)/\U$1/g; |
101 | $cbase =~ s/_(.)/\U$1/g; |
|
|
102 | $cbase =~ s/Gl(?=[A-Z])/GL/g; |
101 | $cbase =~ s/^cl//; |
103 | $cbase =~ s/^cl//; |
102 | $cbase =~ s/Info$//; |
104 | $cbase =~ s/Info$//; |
103 | $cbase = "MemObject" if $cbase eq "Mem"; |
105 | $cbase = "MemObject" if $cbase eq "Mem"; |
104 | $cbase = "EventProfiling" if $cbase eq "Profiling"; |
106 | $cbase = "EventProfiling" if $cbase eq "Profiling"; |
105 | |
107 | |
… | |
… | |
160 | # after we generate the bdoy we look for an identical body generated earlier |
162 | # 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. |
163 | # and simply alias us to the earlier xs function, to save text size. |
162 | my ($XS1, $XS2); |
164 | my ($XS1, $XS2); |
163 | |
165 | |
164 | $XS1 = "void\n" |
166 | $XS1 = "void\n" |
165 | . "XXXNAMEXXX (OpenCL::$classmap{$real_class} this$extra_xs_args)\n"; |
167 | . "XXXNAMEXXX (OpenCL::$classmap{$real_class} self$extra_xs_args)\n"; |
166 | $XS2 = " PPCODE:\n"; |
168 | $XS2 = " PPCODE:\n"; |
167 | |
169 | |
168 | if ($dynamic) { |
170 | if ($dynamic) { |
169 | $XS2 .= " size_t size;\n" |
171 | $XS2 .= " size_t size;\n" |
170 | . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, 0, 0, &size));\n" |
172 | . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, 0, 0, &size));\n" |
171 | . " $type->[0] *value = tmpbuf (size);\n" |
173 | . " $type->[0] *value = tmpbuf (size);\n" |
172 | . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, size, value, 0));\n"; |
174 | . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, size, value, 0));\n"; |
173 | } else { |
175 | } else { |
174 | $XS2 .= " $type->[0] value [1];\n" |
176 | $XS2 .= " $type->[0] value [1];\n" |
175 | . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, sizeof (value), value, 0));\n"; |
177 | . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, sizeof (value), value, 0));\n"; |
176 | } |
178 | } |
177 | |
179 | |
178 | if ($array && $nelem ne "1") { |
180 | if ($array && $nelem ne "1") { |
179 | $XS2 .= " int i, n = $nelem;\n" |
181 | $XS2 .= " int i, n = $nelem;\n" |
180 | . " EXTEND (SP, n);\n" |
182 | . " EXTEND (SP, n);\n" |
… | |
… | |
220 | $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; |
222 | $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; |
221 | } |
223 | } |
222 | $XS .= join "", @$_; |
224 | $XS .= join "", @$_; |
223 | } |
225 | } |
224 | |
226 | |
|
|
227 | warn "patching class $CLASS\n"; |
|
|
228 | |
225 | patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS; |
229 | patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS; |
226 | patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD; |
230 | patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD; |
227 | } |
231 | } |
228 | |
232 | |