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

Comparing OpenCL/gengetinfo (file contents):
Revision 1.12 by root, Tue May 1 16:37:23 2012 UTC vs.
Revision 1.16 by root, Fri May 4 14:56:50 2012 UTC

… …
18 sampler Sampler 18 sampler Sampler
19 program Program 19 program Program
20 program_build Program 20 program_build Program
21 kernel Kernel 21 kernel Kernel
22 kernel_work_group Kernel 22 kernel_work_group Kernel
23 kernel_arg_info Kernel
23 command_queue Queue 24 command_queue Queue
24); 25);
25 26
26my %typemap = ( 27my %typemap = (
27 cl_bool => ['cl_bool', 'value [i] ? &PL_sv_yes : &PL_sv_no', 'boolean'], 28 cl_bool => ['cl_bool', 'value [i] ? &PL_sv_yes : &PL_sv_no', 'boolean'],
… …
77 } 78 }
78 79
79 rename "$file~", $file; 80 rename "$file~", $file;
80} 81}
81 82
82for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling gl_texture)) { 83for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group kernel_arg event profiling gl_texture)) {
83 open my $fh, "<getinfo.txt" 84 open my $fh, "<getinfo.txt"
84 or die "getinfo.txt: $!"; 85 or die "getinfo.txt: $!";
85 86
86 my $POD; 87 my $POD;
87 my @funcs; 88 my @funcs;
… …
106 $cbase = "EventProfiling" if $cbase eq "Profiling"; 107 $cbase = "EventProfiling" if $cbase eq "Profiling";
107 108
108 my $real_class = $CLASS; 109 my $real_class = $CLASS;
109 $real_class = "program" if $real_class eq "program_build"; 110 $real_class = "program" if $real_class eq "program_build";
110 $real_class = "kernel" if $real_class eq "kernel_work_group"; 111 $real_class = "kernel" if $real_class eq "kernel_work_group";
112 $real_class = "kernel" if $real_class eq "kernel_arg";
111 $real_class = "event" if $real_class eq "profiling"; 113 $real_class = "event" if $real_class eq "profiling";
112 114
113 my $perl_name = lc $name; 115 my $perl_name = lc $name;
114 $perl_name =~ s/^cl_//; 116 $perl_name =~ s/^cl_//;
115 $perl_name =~ s/^$real_class\_//; 117 $perl_name =~ s/^$real_class\_//;
… …
121 123
122 if ($CLASS eq "program_build" || $CLASS eq "kernel_work_group") { 124 if ($CLASS eq "program_build" || $CLASS eq "kernel_work_group") {
123 $extra_args = ', device'; 125 $extra_args = ', device';
124 $extra_perl_args = ' ($device)'; 126 $extra_perl_args = ' ($device)';
125 $extra_xs_args = ', OpenCL::Device device'; 127 $extra_xs_args = ', OpenCL::Device device';
128 }
129
130 if ($CLASS eq "kernel_arg") {
131 $extra_args = ', idx';
132 $extra_perl_args = ' ($idx)';
133 $extra_xs_args = ', cl_uint idx';
126 } 134 }
127 135
128 my $dynamic; 136 my $dynamic;
129 my $nelem = "size / sizeof (*value)"; 137 my $nelem = "size / sizeof (*value)";
130 138
… …
154 $perltype = "\@${perltype}s"; 162 $perltype = "\@${perltype}s";
155 } else { 163 } else {
156 $perltype = "\$$perltype"; 164 $perltype = "\$$perltype";
157 } 165 }
158 166
167 (my $perlenum = $name) =~ s/^CL_/OpenCL::/ or die;
168
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"; 169 $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 170
161 # XS1 contains the function before ALIAS, XS2 the function afterwards (the body) 171 # 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 172 # 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. 173 # and simply alias us to the earlier xs function, to save text size.
164 my ($XS1, $XS2); 174 my ($XS1, $XS2);

Diff Legend

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