Add pattern matching for object type fallbacks
authorNot Zed <notzed@gmail.com>
Wed, 5 Jan 2022 03:14:12 +0000 (13:44 +1030)
committerNot Zed <notzed@gmail.com>
Wed, 5 Jan 2022 03:14:12 +0000 (13:44 +1030)
Add basic opencl api mapping, c-like with some conveniences.

src/export-defines
src/generate-native
src/template/Memory.java
test-opencl-basic/Makefile [new file with mode: 0644]
test-opencl-basic/opencl.api [new file with mode: 0644]
test-opencl-basic/opencl.h [new file with mode: 0644]
test-opencl-basic/src/opencl/test/TestOpenCL.java [new file with mode: 0644]

index 79b35e5..907b5c1 100755 (executable)
@@ -43,6 +43,7 @@ foreach $export (@exports) {
                my @options = @{$inc->{options}};
 
                if ($inc->{match} =~ m@^/(.*)/$@) {
+                       print "$export->{name} - $inc->{match} - regex $1\n";
                        $inc->{regex} = qr/$1/;
                } else {
                        $inc->{regex} = qr/^$inc->{match}$/;
@@ -106,7 +107,7 @@ foreach $export (@exports) {
                my $output = 0;
                my $matches = 0;
 
-               print "? $d->{name} $d->{file}" if $verbose;
+               print "? $d->{name} $d->{file} " if $verbose;
                foreach $inc (@{$export->{items}}) {
                        if ($inc->{mode} eq "include") {
                                $matches = $d->{name} =~ m/$inc->{regex}/;
@@ -119,7 +120,7 @@ foreach $export (@exports) {
                        } elsif ($inc->{mode} eq "file-exclude") {
                                $matches = $d->{file} =~ m/$inc->{regex}/;
                        }
-                       print " ($inc->{mode} '$inc->{match}' =$matches)" if $verbose;
+                       print " ($inc->{mode} '$inc->{match}' '$inc->{regex}' =$matches)" if $verbose;
                        last if $matches;
                }
 
index 62cf2fb..d8d2497 100755 (executable)
@@ -10,6 +10,7 @@
 # TODO: arrays with specified lengths passed as arguments could be size-checked in function stubs.
 # TODO: error codes -> exceptions?
 # TODO: auto-loading of libraries (library xx load=blah) option.
+# TODO: rename objects via .api file
 
 use Data::Dumper;
 use File::Basename;
@@ -117,7 +118,7 @@ while (@ARGV) {
 my $api = loadControlFile($apidef);
 
 analyseAPI($api);
-analyseAndFixTypes();
+analyseAndFixTypes($api);
 
 if (0) {
        $s = $data{'struct:AVCodecContext'};
@@ -161,24 +162,6 @@ sub findAPIObject {
        return $api->{"$type:<default>"};
 }
 
-# sub findAPIStruct {
-#      my $api = shift;
-#      my $name = shift;
-
-#      foreach $obj ( @{$api->{struct}} ) {
-#              next if $obj->{name} eq '<default>';
-#              print "$obj->{name} ? $name\n" if $verbose;
-#              if ($obj->{name} =~ m@/(.*)/@) {
-#                      my $rx = qr/$1/;
-#                      return $obj if ($name =~ m/$rx/);
-#              } elsif ($obj->{name} eq $name) {
-#                      return $obj;
-#              }
-#      }
-
-#      return $api->{'struct:<default>'};
-# }
-
 sub findAPIField {
        my $obj = shift;
        my $name = shift;
@@ -296,8 +279,10 @@ sub findAPIItem {
        #print "search for $target.$name in $type.$mode\n";
        # what about exclude?
        foreach $obj ( @{$api->{$type}} ) {
-               if ($obj->{name} eq $target) {
-                       #print " found $target\n";
+               #print " check $obj->{name} against $target =~ /$obj->{regex}/\n";
+               #if ($obj->{name} eq $target) {
+               if ($target =~ m/$obj->{regex}/) {
+                       #print "  found $obj->{name}\n";
                        foreach $inc (grep { $_->{mode} eq $mode } @{$obj->{items}}) {
                                #print "  check $inc->{match}\n";
                                return $inc if $name =~ m/$inc->{regex}/;
@@ -315,18 +300,24 @@ sub analyseAPI {
                $obj->{rename} = $renameTable{'identity'};
                $obj->{'func:rename'} = $renameTable{'identity'};
                $obj->{'field:rename'} = $renameTable{'identity'};
+
+               if ($obj->{name} =~ m@/(.*)/@) {
+                       $obj->{regex} = qr/$1/;
+               } else {
+                       $obj->{regex} = qr/^$obj->{name}$/;
+               }
+
                foreach $o (@{$obj->{options}}) {
                        if ($o =~ m/^default=(none|all)$/) {
                                $obj->{default} = $1;
                        } elsif ($o =~ m/^access=([rwi]+)$/) {
                                $obj->{access} = $1;
+                       } elsif ($o =~ m/^success=(.*)$/) {
+                               # for functions
+                               $obj->{success} = $1;
                        } elsif ($o =~ m@^(rename|field:rename|func:rename)=(.*)@) {
                                my $target = $1;
 
-                               if ($obj->{name} eq 'SwsContext') {
-                                       print "SwsContext rename = $o\n";
-                               }
-
                                foreach $n (split /,/,$2) {
                                        my $old = $obj->{$target};
                                        my $new = $renameTable{$n};
@@ -386,6 +377,8 @@ sub analyseAPI {
                                        $inc->{'array_size'} = $1;
                                } elsif ($o =~ m/^array$/) {
                                        $inc->{'array'} = 1;
+                               } elsif ($o =~ m/^implied=(.*)$/) {
+                                       $inc->{'implied'} = $1;
                                } elsif ($o =~ m/^instance=(.*)/) {
                                        $inc->{instance} = $1;
                                } elsif ($o =~ m/^static$/) {
@@ -394,6 +387,8 @@ sub analyseAPI {
                                        $inc->{constructor} = $1;
                                } elsif ($o =~ m/^constructor-result=(.*)$/) {
                                        $inc->{constructor_result} = $1;
+                               } elsif ($o =~ m/^result_code$/) {
+                                       $inc->{result_code} = 1;
                                } elsif ($o =~ m/^success=(.*)$/) {
                                        $inc->{success} = $1;
                                }
@@ -411,6 +406,18 @@ sub analyseAPI {
        $api->{'call:<default>'} = { rename => $renameTable{'identity'}, scope => 'static'} if !$api->{'call:<default>'};
 }
 
+# take a signature-name and fix it
+sub fixAnonymousCall {
+       my $new = shift;
+
+       $new =~ s/u32:/p/g;
+       $new =~ s/u64:/p/g;
+       $new =~ s/\$\{([^\}]+)\}/$1/g;
+       $new =~ s/[\(\)]/_/g;
+       $new =~ s/^/Call/;
+       $new;
+}
+
 # anonymous structs
 #  the exporter doesn't output anonymous structs as they might
 #  just be forward references.  this fills in any missing types.
@@ -419,21 +426,32 @@ sub analyseAPI {
 # typeInfo
 #  setup typeInfo for all type references - memebers, fields, return values
 sub analyseAndFixTypes {
-       my @replace = ();
+       my $api = shift;
+       my %rename = ();
 
-       # pass 1, fix call definition names and keys
+       # pass 1, fix call definition names and keys, other renames
        foreach $old (keys %data) {
-               if ($old =~ m/^call:/) {
-                       push @replace, $old;
+               if ($old =~ m/^call:(.*\(.*)/) {
+                       $rename{$old} = 'call:'.fixAnonymousCall($1);
+               } elsif ($old =~ m/^(call|func|struct):(.*)$/) {
+                       my $obj = findAPIObject($api, $1, $2);
+
+                       if ($obj && $obj->{rename} != $renameTable{'identity'}) {
+                               $rename{$old} = $1.':'.$obj->{rename}->($2);
+                       }
                }
        }
-       foreach $old (@replace) {
-               my $new = $old;
+
+       foreach $old (sort keys %rename) {
+               my $new = $rename{$old};
                my $c;
 
-               $new =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
-               $data{$new} = $c = delete $data{$old};
-               $c->{name} =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
+               $c = delete $data{$old};
+               print "rename $old -> $new\n";
+               $c->{name} = $new;
+               $c->{name} =~ s/^.*://;
+
+               $data{$new} = $c;
        }
 
        # pass 2 add typeinfo and anonymous types, fix call types
@@ -450,16 +468,26 @@ sub analyseAndFixTypes {
 
                foreach $a (@list) {
                        if ($a->{type} =~ m/(struct|union):(.*)/ && !defined($data{$a->{type}})) {
-                               print "Add anonymous $1 $2\n";
-                               $data{$a->{type}} = {
-                                       name => $2,
-                                       type => $1,
-                                       size => 0
-                               };
-                       }
+                               my $t = $1;
+                               my $n = $2;
+                               my $obj = findAPIObject($api, $t, $n);
+
+                               if ($obj && $obj->{rename} != $renameTable{'identity'}) {
+                                       $n = $obj->{rename}->($n);
+                                       $rename{$a->{type}} = "$t:$n";
+                                       $a->{type} = "$t:$n";
+                               }
 
-                       if ($a->{type} =~ m/^call:/) {
-                               $a->{type} =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
+                               if (!defined($data{$a->{type}})) {
+                                       print "Add anonymous $1 $2\n";
+                                       $data{$a->{type}} = {
+                                               name => $n,
+                                               type => $t,
+                                               size => 0
+                                       };
+                               }
+                       } else {
+                               $a->{type} = $rename{$a->{type}} if ($rename{$a->{type}});
                        }
 
                        # must be last
@@ -589,6 +617,8 @@ sub analyseTypeInfo {
                        die();
                }
        } elsif ($m->{type} =~ m/^([iuf]\d+)$/) {
+               # primitive types
+
                if ($m->{deref} =~ m/\[(\d*)u64:.*\]/) {
                        $info->{byValue} = 1;
                        $info->{type} = "Memory.PointerArray";
@@ -609,6 +639,15 @@ sub analyseTypeInfo {
                        } elsif ($inc->{array_size}) {
                                $info->{type} = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
                                $info->{create} = $info->{type}.".createArray(\${result}, \${array_size}, \${scope})";
+                       } elsif ($inc->{result_code}) {
+                               my $holder = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
+                               $info->{type} = $typeSizes{$m->{type}};
+                               $info->{declare} = "$holder $m->{name} = $holder.createArray(1, frame)";
+                               $info->{hide} = 1;
+                               $info->{result_code} = 1;
+                               $s->{success} = $inc->{success};
+                               $s->{resolveFrame} = 1;
+                               $s->{result_code} = $m;
                        } elsif ($typeSizes{$m->{type}} eq 'byte') {
                                $info->{type} = 'String';
                                $info->{resolve} = "(Addressable)Memory.address(frame.copy(\${value}))";
@@ -626,6 +665,11 @@ sub analyseTypeInfo {
                        $info->{carrier} = $typeSizes{$m->{type}};
                        $info->{resolve} = "($info->{type})(\${value})";
                        $info->{create} = "\${result}";
+                       if ($inc->{implied}) {
+                               $info->{hide} = 1;
+                               $info->{implied} = $inc->{implied};
+                               $info->{resolve} = "($info->{type})($inc->{implied})";
+                       }
                }
        } elsif ($m->{type} =~ m/^(struct|union):(.*)/) {
                my $type = $2;
@@ -666,9 +710,10 @@ sub analyseTypeInfo {
                        $info->{type} = "Memory.PointerArray";
                        $info->{create} = $info->{type}.".createArray(\${result}, Long.MAX_VALUE, \${scope})";
                } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
+                       # TODO: this should be MemorySegment for input arguments?  Or at least Addressable
                        $info->{type} = "MemoryAddress";
                        $info->{create} = "\${result}";
-                       $info->{resolve} = "(Addressable)\${value}";
+                       $info->{resolve} = "(Addressable)Memory.address(\${value})";
                } else {
                        $info->{type} = "void";
                        $info->{carrier} = "void";
@@ -804,18 +849,29 @@ sub formatFunction {
        $desc .= " $name(";
 
        for $m (@arguments) {
-               if ($inc->{scope} eq 'static' || $index != $inc->{instance}) {
+               if (($inc->{scope} eq 'static' || $index != $inc->{instance}) && !$m->{typeInfo}->{hide}) {
                        $desc .= ", " if ($count++ > 0);
                        $desc .= $m->{typeInfo}->{type};
                        $desc .= " $m->{name}"
                }
                $index++;
        }
-       $desc .=") {\n ";
+       $desc .=") {\n";
+
+       if ($c->{result_code}) {
+               my $r = $c->{result_code};
+               $desc .= "$r->{typeInfo}->{type} $r->{name}\$value;\n";
+       }
 
-       $desc .= "try ";
+       $desc .= " try ";
        $desc .= "(Frame frame = Memory.createFrame()) " if ($c->{resolveFrame});
        $desc .= "{\n";
+
+       if ($c->{result_code}) {
+               my $r = $c->{result_code};
+               $desc .= "  $r->{typeInfo}->{declare};\n";
+       }
+
        $desc .= "  $result->{typeInfo}->{carrier} res\$value = ($result->{typeInfo}->{carrier})" if ($rtype ne "void");
        $desc .= "  " if ($rtype eq "void");
 
@@ -845,17 +901,38 @@ sub formatFunction {
 
                # ooh, templates could insert other arguments or values as well?
                $create =~ s/\$\{result\}/res\$value/;
+               # TODO: libraries have a static scope() but instances don't, so could do better here
                if ($inc->{scope} eq 'static') {
                        $create =~ s/\$\{scope\}/ResourceScope.globalScope()/;
                } else {
                        $create =~ s/\$\{scope\}/scope()/;
                }
 
+               if ($c->{result_code}) {
+                       my $r = $c->{result_code};
+                       my $success = $c->{success} ? $c->{success} : '0';
+
+                       $desc .= "  $r->{name}\$value = $r->{name}.get(0);\n";
+                       $desc .= "  if (";
+                       $count = 0;
+                       foreach $s (split /,/,$success) {
+                               $desc .= " || " if ($count++ > 0);
+                               $desc .= "($r->{name}\$value == $s)";
+                       }
+                       $desc .= ")\n";
+               }
+
                $desc .= "  return $create;\n";
        }
        # throw Error()?
        $desc .= " } catch (Throwable t) { throw new RuntimeException(t); }\n";
 
+       # assume it's an int
+       if ($c->{result_code}) {
+               my $r = $c->{result_code};
+               $desc .= " throw new RuntimeException(String.format(\"error=%d\", $r->{name}\$value));\n";
+       }
+
        $desc .="}";
 
        return $desc;
@@ -1212,6 +1289,8 @@ sub exportStruct {
                        print $f " public static $s->{name} createArray(MemoryAddress address, long size, ResourceScope scope) {\n";
                        print $f "  return MemoryAddress.NULL != address ? create(MemorySegment.ofAddress(address, size * LAYOUT.byteSize(), scope)) : null;\n";
                        print $f " }\n";
+
+                       print $f " public long length() { return segment.byteSize() / LAYOUT.byteSize(); }\n";
                }
                print $f " public static $s->{name} create(Frame frame) { return create(frame.allocate(LAYOUT)); }\n";
                print $f " public static $s->{name} create(ResourceScope scope) { return create(MemorySegment.allocateNative(LAYOUT, scope)); }\n";
@@ -1465,10 +1544,12 @@ foreach $lib ( @{$api->{library}} ) {
                                print $f $tmp."\n\n";
                        }
                } elsif ($inc->{mode} eq 'define') {
+                       print "looking for define $inc->{regex}\n";
+
                        my @list = grep { $_->{type} eq $inc->{mode} && $_->{name} =~ m/$inc->{regex}/ } values %data;
                        foreach $c (@list) {
                                delete $toDump->{"define:$c->{name}"};
-                               foreach $m (@{$c->{fields}}) {
+                               foreach $m (@{$c->{values}}) {
                                        print $f " /**\n ($m->{comment}) */\n" if ($m->{comment});
                                        print $f " public static final $defineType{$m->{type}} $m->{name} = $definePrefix{$m->{type}}$m->{value}$defineSuffix{$m->{type}};\n";
                                }
index 023c828..89b4c6c 100644 (file)
@@ -25,6 +25,7 @@ import static jdk.incubator.foreign.ValueLayout.*;
 import java.util.AbstractList;
 import java.util.function.Function;
 import java.util.function.BiFunction;
+import java.util.List;
 
 /**
  * A utility for memory operations including a stack allocator.
@@ -171,6 +172,10 @@ public class Memory {
                return v != null ? v.symbol().address() : MemoryAddress.NULL;
        }
 
+       public static long size(List<?> list) {
+               return list != null ? list.size() : 0;
+       }
+
        // hmm do i want this or not?
        // -> added 'type safety'
        // -> load of crap to be written
diff --git a/test-opencl-basic/Makefile b/test-opencl-basic/Makefile
new file mode 100644 (file)
index 0000000..913527e
--- /dev/null
@@ -0,0 +1,54 @@
+
+CFLAGS=-g -fPIC
+HOST_CC=gcc
+
+JAVA_HOME=/opt/jdk-foreign/jvm/openjdk-19-internal
+JAVAC=$(JAVA_HOME)/bin/javac
+JAVA=$(JAVA_HOME)/bin/java
+
+JAVACFLAGS=--add-modules jdk.incubator.foreign
+
+api_SOURCES := $(wildcard ../src/api/*.java)
+opencl_SOURCES := $(wildcard src/proto/opencl/*.java)
+opencl_demo_SOURCES := $(wildcard src/opencl/test/*.java)
+
+$(info $(opencl_demo_SOURCES))
+
+all::
+       mkdir -p bin
+
+all:: bin/demo.built
+
+bin/opencl.built: bin/opencl.gen $(opencl_SOURCES)
+       $(JAVAC) $(JAVACFLAGS) -cp bin/classes -d bin/classes \
+               $(shell find bin/java -name '*.java') \
+               $(opencl_SOURCES)
+       touch $@
+
+bin/opencl.gen: bin/opencl.pm bin/opencl-defines.pm ../src/generate-native $(api_SOURCES)
+       ../src/generate-native -d bin/java -t proto.opencl -a ./bin/opencl.pm -a ./bin/opencl-defines.pm opencl.api
+       touch $@
+
+bin/opencl-defines.pm: opencl.h ../src/export-defines opencl.api
+       ../src/export-defines -d bin/opencl-defines.c opencl.api
+       $(HOST_CC) -o bin/opencl-defines -I. bin/opencl-defines.c
+       bin/opencl-defines $@~
+       mv $@~ $@
+
+bin/opencl.pm: opencl.h ../src/export.so
+       gcc -fplugin=../src/export.so -fplugin-arg-export-output=$@~ ./$< -o /dev/null
+       mv $@~ $@
+
+bin/demo.built: $(opencl_demo_SOURCES) bin/opencl.built
+       $(JAVAC) $(JAVACFLAGS) -cp bin/classes -d bin/classes $(opencl_demo_SOURCES)
+       touch $@
+
+demo: all
+       $(JAVA) --enable-native-access=ALL-UNNAMED --add-modules jdk.incubator.foreign \
+               -cp bin/classes \
+               opencl.test.TestOpenCL
+
+clean:
+       rm -rf bin
+
+.PHONY: demo clean all
diff --git a/test-opencl-basic/opencl.api b/test-opencl-basic/opencl.api
new file mode 100644 (file)
index 0000000..3728ba6
--- /dev/null
@@ -0,0 +1,146 @@
+
+struct cl_image_format access=rwi {
+}
+
+struct /^_cl/ access= rename=s/^_cl/cl/ {
+}
+
+library CL {
+       define:CLConstants
+
+       clGetPlatformIDs
+       clGetPlatformInfo
+       clGetDeviceIDs
+       clGetDeviceInfo
+       clCreateSubDevices
+       clRetainDevice
+       clReleaseDevice
+       clSetDefaultDeviceCommandQueue
+       clGetDeviceAndHostTimer
+       clGetHostTimer
+       clCreateContext
+       clCreateContextFromType
+       clRetainContext
+       clReleaseContext
+       clGetContextInfo
+       clCreateCommandQueueWithProperties
+       clRetainCommandQueue
+       clReleaseCommandQueue
+       clGetCommandQueueInfo
+       clCreateBuffer
+       clCreateSubBuffer
+       clCreateImage
+       clCreatePipe
+       clRetainMemObject
+       clReleaseMemObject
+       clGetSupportedImageFormats
+       clGetMemObjectInfo
+       clGetImageInfo
+       clGetPipeInfo
+       clSetMemObjectDestructorCallback
+       clSVMAlloc
+       clSVMFree
+       clCreateSamplerWithProperties
+       clRetainSampler
+       clReleaseSampler
+       clGetSamplerInfo
+       clCreateProgramWithSource
+       clCreateProgramWithBinary
+       clCreateProgramWithBuiltInKernels
+       clCreateProgramWithIL
+       clRetainProgram
+       clReleaseProgram
+       clBuildProgram
+       clCompileProgram
+       clLinkProgram
+       clUnloadPlatformCompiler
+       clGetProgramInfo
+       clGetProgramBuildInfo
+       clCreateKernel
+       clCreateKernelsInProgram
+       clCloneKernel
+       clRetainKernel
+       clReleaseKernel
+       clSetKernelArg
+       clSetKernelArgSVMPointer
+       clSetKernelExecInfo
+       clGetKernelInfo
+       clGetKernelArgInfo
+       clGetKernelWorkGroupInfo
+       clGetKernelSubGroupInfo
+       clWaitForEvents
+       clGetEventInfo
+       clCreateUserEvent
+       clRetainEvent
+       clReleaseEvent
+       clSetUserEventStatus
+       clSetEventCallback
+       clGetEventProfilingInfo
+       clFlush
+       clFinish
+       clEnqueueReadBuffer
+       clEnqueueReadBufferRect
+       clEnqueueWriteBuffer
+       clEnqueueWriteBufferRect
+       clEnqueueFillBuffer
+       clEnqueueCopyBuffer
+       clEnqueueCopyBufferRect
+       clEnqueueReadImage
+       clEnqueueWriteImage
+       clEnqueueFillImage
+       clEnqueueCopyImage
+       clEnqueueCopyImageToBuffer
+       clEnqueueCopyBufferToImage
+       clEnqueueMapBuffer
+       clEnqueueMapImage
+       clEnqueueUnmapMemObject
+       clEnqueueMigrateMemObjects
+       clEnqueueNDRangeKernel
+       clEnqueueNativeKernel
+       clEnqueueMarkerWithWaitList
+       clEnqueueBarrierWithWaitList
+       clEnqueueSVMFree
+       clEnqueueSVMMemcpy
+       clEnqueueSVMMemFill
+       clEnqueueSVMMap
+       clEnqueueSVMUnmap
+       clEnqueueSVMMigrateMem
+       clGetExtensionFunctionAddressForPlatform
+       clCreateImage2D
+       clCreateImage3D
+       clEnqueueMarker
+       clEnqueueWaitForEvents
+       clEnqueueBarrier
+       clUnloadCompiler
+       clGetExtensionFunctionAddress
+       clCreateCommandQueue
+       clCreateSampler
+       clEnqueueTask
+
+}
+
+# base constants
+define CLConstants opencl.h {
+       /.*/cl.h/             file-include
+}
+
+func clGetPlatformIDs {
+     num_entries     implied=Memory.size(platforms)
+}
+
+func clGetDeviceIDs {
+     num_entries     implied=Memory.size(devices)
+}
+
+func clCreateContext {
+     num_devices     implied=Memory.size(devices)
+     errcode_ret     result_code  success=CL_SUCCESS
+}
+
+func /clCreate/ {
+     errcode_ret     result_code  success=CL_SUCCESS
+}
+
+func clGetSupportedImageFormats {
+     num_entries     implied=(image_formats!=null?image_formats.length():0)
+}
diff --git a/test-opencl-basic/opencl.h b/test-opencl-basic/opencl.h
new file mode 100644 (file)
index 0000000..8d71726
--- /dev/null
@@ -0,0 +1,4 @@
+
+#define CL_TARGET_OPENCL_VERSION 300
+
+#include <CL/opencl.h>
diff --git a/test-opencl-basic/src/opencl/test/TestOpenCL.java b/test-opencl-basic/src/opencl/test/TestOpenCL.java
new file mode 100644 (file)
index 0000000..2f1e429
--- /dev/null
@@ -0,0 +1,78 @@
+
+package opencl.test;
+
+import static proto.opencl.CL.*;
+import proto.opencl.*;
+import proto.opencl.Memory.*;
+import java.io.PrintStream;
+import jdk.incubator.foreign.*;
+
+public class TestOpenCL {
+
+       static class platform_string {
+               final int key;
+               final String name;
+               platform_string(int key, String name) {
+                       this.key = key;
+                       this.name = name;
+               }
+
+               void print(PrintStream out, String what) {
+                       out.printf("%-40s: %s\n", name, what);
+               }
+
+               void print(PrintStream out, cl_platform_id p) {
+                       try (Frame frame = Memory.createFrame()) {
+                               LongArray sizep = LongArray.createArray(1, frame);
+                               int res;
+                               MemorySegment seg;
+
+                               res = clGetPlatformInfo(p, key, 0, null, sizep);
+                               seg = frame.allocate(sizep.get(0), 1);
+                               res = clGetPlatformInfo(p, key, seg.byteSize(), seg.address(), null);
+
+                               out.printf("%-40s: %s\n", name, seg.getUtf8String(0));
+                       }
+               }
+       }
+
+       static platform_string[] platform = {
+               new platform_string(CL_PLATFORM_PROFILE, "Platform Profile"),
+               new platform_string(CL_PLATFORM_VERSION, "Platform Version"),
+               new platform_string(CL_PLATFORM_NAME, "Platform Name"),
+               new platform_string(CL_PLATFORM_VENDOR, "Platform Vendor"),
+               new platform_string(CL_PLATFORM_EXTENSIONS, "Platform Extensions"),
+       };
+
+       static void print(cl_platform_id src, platform_string[] props) {
+               for (platform_string p : props) {
+                       try {
+                               p.print(System.out, src);
+                       } catch (RuntimeException ex) {
+                               ex.printStackTrace();
+                               p.print(System.out, "*unsupported");
+                       }
+               }
+       }
+
+       public static void main(String[] args) throws Exception {
+               System.loadLibrary("OpenCL");
+
+               try (Frame frame = Memory.createFrame()) {
+                       IntArray countp = IntArray.createArray(1, frame);
+                       HandleArray<cl_platform_id> platforms;
+                       int res;
+                       int count;
+
+                       res = clGetPlatformIDs(null, countp);
+                       platforms = HandleArray.createArray(countp.get(0), frame, cl_platform_id::create);
+                       res = clGetPlatformIDs(platforms, countp);
+
+                       System.out.printf("Number of Platforms: %d\n", platforms.size());
+                       for (cl_platform_id p: platforms) {
+                               print(p, platform);
+                               System.out.println();
+                       }
+               }
+       }
+}