… | |
… | |
87 | my @funcs; |
87 | my @funcs; |
88 | my %alias; |
88 | my %alias; |
89 | |
89 | |
90 | while (<$fh>) { |
90 | while (<$fh>) { |
91 | chomp; |
91 | chomp; |
92 | my ($class, $name, $ctype) = split /,\s*/, $_, 3; |
92 | my ($class, $name, $ctype) = split /\s*,\s*/, $_, 3; |
93 | next unless $class eq "cl_$CLASS\_info"; |
93 | next unless $class eq "cl_$CLASS\_info"; |
94 | next if $name eq "CL_IMAGE_FORMAT"; # struct |
94 | next if $name eq "CL_IMAGE_FORMAT"; # struct |
95 | next if $name eq "CL_PROGRAM_BINARIES"; # needs multiple calls |
95 | next if $name eq "CL_PROGRAM_BINARIES"; # needs multiple calls |
96 | |
96 | |
97 | $ctype =~ s/cl:://g; |
97 | $ctype =~ s/cl:://g; |
98 | $ctype =~ s/::size_t/size_t/g; |
98 | $ctype =~ s/::size_t/size_t/g; |
99 | |
99 | |
100 | my $cbase = $class; |
100 | my $cbase = $class; |
101 | $cbase =~ s/_(.)/\U$1/g; |
101 | $cbase =~ s/_(.)/\U$1/g; |
102 | $cbase =~ s/_Gl_/_GL/g; |
102 | $cbase =~ s/Gl(?=[A-Z])/GL/g; |
103 | $cbase =~ s/^cl//; |
103 | $cbase =~ s/^cl//; |
104 | $cbase =~ s/Info$//; |
104 | $cbase =~ s/Info$//; |
105 | $cbase = "MemObject" if $cbase eq "Mem"; |
105 | $cbase = "MemObject" if $cbase eq "Mem"; |
106 | $cbase = "EventProfiling" if $cbase eq "Profiling"; |
106 | $cbase = "EventProfiling" if $cbase eq "Profiling"; |
107 | |
107 | |
… | |
… | |
154 | $perltype = "\@${perltype}s"; |
154 | $perltype = "\@${perltype}s"; |
155 | } else { |
155 | } else { |
156 | $perltype = "\$$perltype"; |
156 | $perltype = "\$$perltype"; |
157 | } |
157 | } |
158 | |
158 | |
|
|
159 | (my $perlenum = $name) =~ s/^CL_/OpenCL::/ or die; |
|
|
160 | |
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"; |
161 | $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 | |
162 | |
161 | # XS1 contains the function before ALIAS, XS2 the function afterwards (the body) |
163 | # 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 |
164 | # 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. |
165 | # and simply alias us to the earlier xs function, to save text size. |
164 | my ($XS1, $XS2); |
166 | my ($XS1, $XS2); |
… | |
… | |
189 | if ($type->[1] =~ /^OpenCL::(\S+)$/) { |
191 | if ($type->[1] =~ /^OpenCL::(\S+)$/) { |
190 | my $oclass = $1; |
192 | my $oclass = $1; |
191 | $oclass = "MemObject" if $oclass eq "Memory"; |
193 | $oclass = "MemObject" if $oclass eq "Memory"; |
192 | $oclass = "CommandQueue" if $oclass eq "Queue"; |
194 | $oclass = "CommandQueue" if $oclass eq "Queue"; |
193 | |
195 | |
|
|
196 | my $stash = lc $type->[1]; |
|
|
197 | $stash =~ s/opencl:://; |
|
|
198 | $stash =~ s/::/_/g; |
|
|
199 | |
194 | $XS2 .= " {\n"; |
200 | $XS2 .= " {\n"; |
195 | $XS2 .= " NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $1 eq "Platform" || $1 eq "Device"; |
201 | $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"; |
202 | $XS2 .= " PUSH_CLOBJ (stash_$stash, value [i]);\n"; |
197 | $XS2 .= " }\n"; |
203 | $XS2 .= " }\n"; |
198 | } else { |
204 | } else { |
199 | $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; |
205 | $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; |
200 | } |
206 | } |
201 | |
207 | |