--- OpenCL/gengetinfo	2012/04/16 09:42:33	1.6
+++ OpenCL/gengetinfo	2012/05/05 13:30:07	1.17
@@ -14,15 +14,18 @@
    profiling         Event
    mem               Memory
    image             Image
+   gl_texture	     Image
    sampler           Sampler
    program           Program
    program_build     Program
    kernel            Kernel
    kernel_work_group Kernel
+   kernel_arg_info   Kernel
    command_queue     Queue
 );
 
 my %typemap = (
+   # getinfo.txt        c type, constructor, pod
    cl_bool         => ['cl_bool', 'value [i] ? &PL_sv_yes : &PL_sv_no', 'boolean'],
    #char            => ['char', 'newSVpvn (value, size)', 'string'],
    char            => ['char', 'newSVpv (value, 0)', 'string'], # all these are 0-terminated strings, and the driver often appends a \0
@@ -36,6 +39,7 @@
    Program         => ['cl_program', 'OpenCL::Program', 'program'],
    CommandQueue    => ['cl_command_queue', 'OpenCL::Queue', 'queue'],
    cl_context_properties => ['cl_context_properties', 'newSVuv ((UV)value [i])', 'property_int'],
+   cl_program_binary_type => ['cl_program_binary_type', 'newSVuv (UV)value [i])', 'binary_type'],
 );
 
 {
@@ -78,7 +82,7 @@
    rename "$file~", $file;
 }
 
-for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling)) {
+for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group kernel_arg event profiling gl_texture)) {
    open my $fh, "<getinfo.txt"
       or die "getinfo.txt: $!";
 
@@ -88,7 +92,7 @@
 
    while (<$fh>) {
       chomp;
-      my ($class, $name, $ctype) = split /,\s*/, $_, 3;
+      my ($class, $name, $ctype) = split /\s*,\s*/, $_, 3;
       next unless $class eq "cl_$CLASS\_info";
       next if $name eq "CL_IMAGE_FORMAT"; # struct
       next if $name eq "CL_PROGRAM_BINARIES"; # needs multiple calls
@@ -98,6 +102,7 @@
 
       my $cbase = $class;
       $cbase =~ s/_(.)/\U$1/g;
+      $cbase =~ s/Gl(?=[A-Z])/GL/g;
       $cbase =~ s/^cl//;
       $cbase =~ s/Info$//;
       $cbase = "MemObject"      if $cbase eq "Mem";
@@ -106,6 +111,7 @@
       my $real_class = $CLASS;
       $real_class = "program" if $real_class eq "program_build";
       $real_class = "kernel"  if $real_class eq "kernel_work_group";
+      $real_class = "kernel"  if $real_class eq "kernel_arg";
       $real_class = "event"   if $real_class eq "profiling";
 
       my $perl_name = lc $name;
@@ -123,6 +129,12 @@
          $extra_xs_args   = ', OpenCL::Device device';
       }
 
+      if ($CLASS eq "kernel_arg") {
+         $extra_args      = ', idx';
+         $extra_perl_args = ' ($idx)';
+         $extra_xs_args   = ', cl_uint idx';
+      }
+
       my $dynamic;
       my $nelem = "size / sizeof (*value)";
 
@@ -154,7 +166,9 @@
          $perltype = "\$$perltype";
       }
 
-      $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";
+      (my $perlenum = $name) =~ s/^CL_/OpenCL::/ or die;
+
+      $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";
 
       # XS1 contains the function before ALIAS, XS2 the function afterwards (the body)
       # after we generate the bdoy we look for an identical body generated earlier
@@ -189,9 +203,13 @@
          $oclass = "MemObject"    if $oclass eq "Memory";
          $oclass = "CommandQueue" if $oclass eq "Queue";
 
+         my $stash = lc $type->[1];
+         $stash =~ s/opencl:://;
+         $stash =~ s/::/_/g;
+
          $XS2 .= " {\n";
-         $XS2 .= "   NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $1 eq "Platform" || $1 eq "Device";
-         $XS2 .= "   PUSHs (NEW_MORTAL_OBJ (\"$type->[1]\", value [i]));\n";
+         $XS2 .= "   NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $oclass eq "Platform" || $oclass eq "Device";
+         $XS2 .= "   PUSH_CLOBJ (stash_$stash, value [i]);\n";
          $XS2 .= " }\n";
       } else {
          $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n";
@@ -222,6 +240,8 @@
       $XS .= join "", @$_;
    }
 
+   warn "patching class $CLASS\n";
+
    patch "OpenCL.xs", "#BEGIN:$CLASS"               , "#END:$CLASS"               , $XS;
    patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD;
 }