… | |
… | |
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; |
87 | my %alias; |
88 | my %alias; |
88 | |
89 | |
89 | while (<$fh>) { |
90 | while (<$fh>) { |
90 | chomp; |
91 | chomp; |
91 | my ($class, $name, $ctype) = split /,\s*/, $_, 3; |
92 | my ($class, $name, $ctype) = split /\s*,\s*/, $_, 3; |
92 | next unless $class eq "cl_$CLASS\_info"; |
93 | next unless $class eq "cl_$CLASS\_info"; |
93 | next if $name eq "CL_IMAGE_FORMAT"; # struct |
94 | next if $name eq "CL_IMAGE_FORMAT"; # struct |
94 | next if $name eq "CL_PROGRAM_BINARIES"; # needs multiple calls |
95 | next if $name eq "CL_PROGRAM_BINARIES"; # needs multiple calls |
95 | |
96 | |
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 | |
… | |
… | |
187 | if ($type->[1] =~ /^OpenCL::(\S+)$/) { |
189 | if ($type->[1] =~ /^OpenCL::(\S+)$/) { |
188 | my $oclass = $1; |
190 | my $oclass = $1; |
189 | $oclass = "MemObject" if $oclass eq "Memory"; |
191 | $oclass = "MemObject" if $oclass eq "Memory"; |
190 | $oclass = "CommandQueue" if $oclass eq "Queue"; |
192 | $oclass = "CommandQueue" if $oclass eq "Queue"; |
191 | |
193 | |
|
|
194 | my $stash = lc $type->[1]; |
|
|
195 | $stash =~ s/opencl:://; |
|
|
196 | $stash =~ s/::/_/g; |
|
|
197 | |
192 | $XS2 .= " {\n"; |
198 | $XS2 .= " {\n"; |
193 | $XS2 .= " NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $1 eq "Platform" || $1 eq "Device"; |
199 | $XS2 .= " NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $oclass eq "Platform" || $oclass eq "Device"; |
194 | $XS2 .= " PUSHs (NEW_MORTAL_OBJ (\"$type->[1]\", value [i]));\n"; |
200 | $XS2 .= " PUSH_CLOBJ (stash_$stash, value [i]);\n"; |
195 | $XS2 .= " }\n"; |
201 | $XS2 .= " }\n"; |
196 | } else { |
202 | } else { |
197 | $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; |
203 | $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; |
198 | } |
204 | } |
199 | |
205 | |
… | |
… | |
220 | $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; |
226 | $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; |
221 | } |
227 | } |
222 | $XS .= join "", @$_; |
228 | $XS .= join "", @$_; |
223 | } |
229 | } |
224 | |
230 | |
|
|
231 | warn "patching class $CLASS\n"; |
|
|
232 | |
225 | patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS; |
233 | patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS; |
226 | patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD; |
234 | patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD; |
227 | } |
235 | } |
228 | |
236 | |