ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/OpenCL/gengetinfo
(Generate patch)

Comparing OpenCL/gengetinfo (file contents):
Revision 1.5 by root, Tue Nov 22 10:29:18 2011 UTC vs.
Revision 1.13 by root, Fri May 4 14:29:35 2012 UTC

… …
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
81for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling)) { 82for 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
… …
152 $perltype = "\@${perltype}s"; 154 $perltype = "\@${perltype}s";
153 } else { 155 } else {
154 $perltype = "\$$perltype"; 156 $perltype = "\$$perltype";
155 } 157 }
156 158
159 (my $perlenum = $name) =~ s/^CL_/OpenCL::/ or die;
160
157 $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";
158 162
159 # 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)
160 # 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
161 # 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.
162 my ($XS1, $XS2); 166 my ($XS1, $XS2);
163 167
164 $XS1 = "void\n" 168 $XS1 = "void\n"
165 . "XXXNAMEXXX (OpenCL::$classmap{$real_class} this$extra_xs_args)\n"; 169 . "XXXNAMEXXX (OpenCL::$classmap{$real_class} self$extra_xs_args)\n";
166 $XS2 = " PPCODE:\n"; 170 $XS2 = " PPCODE:\n";
167 171
168 if ($dynamic) { 172 if ($dynamic) {
169 $XS2 .= " size_t size;\n" 173 $XS2 .= " size_t size;\n"
170 . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, 0, 0, &size));\n" 174 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, 0, 0, &size));\n"
171 . " $type->[0] *value = tmpbuf (size);\n" 175 . " $type->[0] *value = tmpbuf (size);\n"
172 . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, size, value, 0));\n"; 176 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, size, value, 0));\n";
173 } else { 177 } else {
174 $XS2 .= " $type->[0] value [1];\n" 178 $XS2 .= " $type->[0] value [1];\n"
175 . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, sizeof (value), value, 0));\n"; 179 . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, sizeof (value), value, 0));\n";
176 } 180 }
177 181
178 if ($array && $nelem ne "1") { 182 if ($array && $nelem ne "1") {
179 $XS2 .= " int i, n = $nelem;\n" 183 $XS2 .= " int i, n = $nelem;\n"
180 . " EXTEND (SP, n);\n" 184 . " EXTEND (SP, n);\n"
… …
187 if ($type->[1] =~ /^OpenCL::(\S+)$/) { 191 if ($type->[1] =~ /^OpenCL::(\S+)$/) {
188 my $oclass = $1; 192 my $oclass = $1;
189 $oclass = "MemObject" if $oclass eq "Memory"; 193 $oclass = "MemObject" if $oclass eq "Memory";
190 $oclass = "CommandQueue" if $oclass eq "Queue"; 194 $oclass = "CommandQueue" if $oclass eq "Queue";
191 195
196 my $stash = lc $type->[1];
197 $stash =~ s/opencl:://;
198 $stash =~ s/::/_/g;
199
192 $XS2 .= " {\n"; 200 $XS2 .= " {\n";
193 $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";
194 $XS2 .= " PUSHs (NEW_MORTAL_OBJ (\"$type->[1]\", value [i]));\n"; 202 $XS2 .= " PUSH_CLOBJ (stash_$stash, value [i]);\n";
195 $XS2 .= " }\n"; 203 $XS2 .= " }\n";
196 } else { 204 } else {
197 $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n"; 205 $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n";
198 } 206 }
199 207
… …
220 $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] }; 228 $_->[1] = " ALIAS:\n" . join "", map " $_->[0] = $_->[1]\n", @{ $_->[1] };
221 } 229 }
222 $XS .= join "", @$_; 230 $XS .= join "", @$_;
223 } 231 }
224 232
233 warn "patching class $CLASS\n";
234
225 patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS; 235 patch "OpenCL.xs", "#BEGIN:$CLASS" , "#END:$CLASS" , $XS;
226 patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD; 236 patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD;
227} 237}
228 238

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines