--- /dev/null
+#!/usr/bin/perl
+
+# replace a datatype with another, do not generate any code for it
+# -r name=new
+
+@matchStruct = ();
+$meta = "";
+# @classes = ( { name => 'class', match => [ func-pattern, ... ], match_file => [ file, ... ], enum => [ enum-pattern, ... ], enum_file => [ file, ...] } )
+@classes = ();
+%class = ();
+$output = ".";
+# map call signatures to a class name
+%callMap = ();
+$package = "";
+%replace = ();
+# calls take raw types and throw Throwable
+$rawCalls = 0;
+
+while (@ARGV) {
+ my $cmd = shift(@ARGV);
+
+ if ($cmd eq "-f") {
+ my $v = shift(@ARGV);
+ push @{$class{match}}, qr/$v/;
+ } elsif ($cmd eq "--func-file") {
+ my $file = shift(@ARGV);
+
+ push @{$class{match_file}}, $file;
+ push @{$class{match}}, readMatchFile($file);
+ } elsif ($cmd eq "-e") {
+ my $v = shift(@ARGV);
+ push @{$class{enum}}, qr/$v/;
+ } elsif ($cmd eq "--enum-file") {
+ my $file = shift(@ARGV);
+ push @{$class{enum_file}}, $file;
+ push @{$class{enum}}, readMatchFile($file);
+ } elsif ($cmd eq "-s") {
+ my $v = shift(@ARGV);
+ push @matchStruct, qr/$v/;
+ } elsif ($cmd eq "--struct-file") {
+ my $file = shift(@ARGV);
+ push @matchStruct, readMatchFile($file);
+ } elsif ($cmd eq "-r") {
+ my $v = shift(@ARGV);
+
+ $v =~ m/(.*)=(.*)/;
+ $replace{$1} = $2;
+ } elsif ($cmd eq "--raw-calls") {
+ $rawCalls = 1;
+ } elsif ($cmd eq "-t") {
+ $package = shift(@ARGV);
+ } elsif ($cmd eq "-c") {
+ my %new = (
+ name => shift(@ARGV),
+ match => [],
+ match_file => [],
+ enum => [],
+ enum_file => [],
+ libs => []);
+ push @classes, \%new;
+ %class = %new;
+ print "new:\n".Dumper(\%class);
+ } elsif ($cmd =~ m/^-l(.*)/) {
+ push @{$class{libs}}, $1;
+ } elsif ($cmd eq "-d") {
+ $output = shift(@ARGV);
+ } elsif ($cmd eq "--enclosing-type") {
+ $enclosingType = shift(@ARGV);
+ } else {
+ $meta = $cmd;
+ }
+}
+
+$importPointer = "import api.Native.Pointer;" if (!$rawCalls);
+
+print "import poirnter: $importPointer\n";
+use Data::Dumper;
+
+require $meta;
+
+# box types for primitives
+%map_box = (
+ "long" => "Long",
+ "int" => "Integer",
+ "short" => "Short",
+ "char" => "Character",
+ "float" => "Float",
+ "double" => "Double",
+ "byte" => "Byte",
+ "void" => "Void"
+ );
+
+sub readMatchFile {
+ my $path = shift @_;
+ my @lines = ();
+
+ open(my $f,"<$path");
+ while (<$f>) {
+ chop;
+ next if m/^#/;
+
+ #push @lines, qr/\^$_\$/;
+ push @lines, $_;
+ }
+ close($f);
+
+ my $all = join ('|', @lines);
+
+ return qr/^($all)$/;
+}
+
+sub camelCase {
+ my $name = shift @_;
+
+ $name =~ s/_(.)/uc($1)/eg;
+
+ return $name;
+}
+
+sub StudlyCaps {
+ my $name = shift @_;
+
+ # hack, or good spot for it?
+ return $replace{$name} if $replace{$name};
+
+ $name =~ s/^(.)/uc($1)/e;
+ $name =~ s/_(.)/uc($1)/eg;
+
+ return $name;
+}
+
+
+sub structSignature {
+ my %struct = %{shift(@_)};
+ my $union = shift(@_);
+ my $sig = "";
+ my @fields = @{$struct{fields}};
+ my $offset = 0;
+
+ my $inbf = 0;
+ my $bfoffset = 0;
+ my $bfstart = 0;
+ my $bfsig = "";
+
+ for $fi (@fields) {
+ my %field = %{$fi};
+ my $off = $field{offset};
+
+ # bitfields, this only handles 1x u64 bitfield section
+ # They need to: align to u32/u64
+ # Group fields into one full u32/u64
+ # TODO: check alignment @ start?
+ # TODO: clean up and complete
+ # TODO: bitfields in unions are probably broken
+ if ($field{ctype} eq 'bitfield') {
+ if ($inbf) {
+ if ($off - $offset) {
+ $bfsig .= "x";
+ $bfsig .= ($off - $offset);
+ }
+ $bfsig .= $field{type};
+ $bfsig .= "($field{name})";
+ $offset = $off + $field{size};
+ } else {
+ $inbf = 1;
+ $bfsig = $field{type};
+ $bfsig .= "($field{name})";
+ $offset = $off + $field{size};
+ $bfstart = $field{offset};
+ }
+
+ if ($union) {
+ $inbf = 0;
+
+ if (($offset - $bfstart) == 32) {
+ $bfsig = "u32=[$bfsig]";
+ } elsif (($offset - $bfstart) < 32) {
+ $bfsig .= "x";
+ $bfsig .= 32 - ($offset - $bfstart);
+ $offset = $bfstart + 32;
+ $bfsig = "u32=[$bfsig]";
+ } elsif (($offset - $bfstart) == 64) {
+ $bfsig = "u64=[$bfsig]";
+ } elsif (($offset - $bfstart) < 64) {
+ $bfsig .= "x";
+ $bfsig .= 64 - ($offset - $bfstart);
+ $offset = $bfstart + 64;
+ $bfsig = "u64=[$bfsig]";
+ }
+
+ $sig .= $bfsig;
+ $sig .= "|" if ($union && $fi != @fields[$#fields]);
+ }
+ next;
+ } elsif ($inbf) {
+ if (($offset - $bfstart) == 32) {
+ $bfsig = "u32=[$bfsig]";
+ } elsif (($offset - $bfstart) < 32) {
+ $bfsig .= "x";
+ $bfsig .= 32 - ($offset - $bfstart);
+ $offset = $bfstart + 32;
+ $bfsig = "u32=[$bfsig]";
+ } elsif (($offset - $bfstart) == 64) {
+ $bfsig = "u64=[$bfsig]";
+ } elsif (($offset - $bfstart) < 64) {
+ $bfsig .= "x";
+ $bfsig .= 64 - ($offset - $bfstart);
+ $offset = $bfstart + 64;
+ $bfsig = "u64=[$bfsig]";
+ }
+ $sig .= $bfsig;
+ $inbf = 0;
+ }
+
+ # skip to next offset if necessary
+ if ($off > $offset) {
+ $sig .= "x";
+ $sig .= ($off - $offset);
+ }
+ $offset = $off + $field{size};
+
+ # normal field processing
+ if ($field{deref}) {
+ my $deref = $field{deref};
+
+ # HACK: function -> Void
+ # if ($field{debug} eq 'function') {
+ # $sig .= "u64($field{name}):v";
+ # } els
+ if ($deref =~ m/^(u\d\d)(:.*)/) {
+ $sig .= "$1($field{name})$2";
+ } else {
+ $sig .= "$deref($field{name})";
+ }
+ } else {
+ if ($field{type} =~ m/(struct|union):(.*)/) {
+ $sig .= "\${$2}";
+ } elsif ($field{type} =~ m/([iuf])(\d+)/) {
+ $sig .= $1;
+ $sig .= $2;
+ } elsif ($field{type} eq 'void') {
+ $sig .= "v";
+ } elsif ($field{type} eq 'enum') {
+ # FIXME: set type in compiler
+ $sig .= "u32";
+ }
+
+ $sig .= "($field{name})";
+ }
+
+ $sig .= "|" if ($union && $fi != @fields[$#fields]);
+ }
+
+ # finish any trailing bitfield
+ # TODO: cleanup
+ if ($inbf) {
+ if (($offset - $bfstart) == 32) {
+ $bfsig = "u32=[$bfsig]";
+ } elsif (($offset - $bfstart) < 32) {
+ $bfsig .= "x";
+ $bfsig .= 32 - ($offset - $bfstart);
+ $offset = $bfstart + 32;
+ $bfsig = "u32=[$bfsig]";
+ } elsif (($offset - $bfstart) == 64) {
+ $bfsig = "u64=[$bfsig]";
+ } elsif (($offset - $bfstart) < 64) {
+ $bfsig .= "x";
+ $bfsig .= 64 - ($offset - $bfstart);
+ $offset = $bfstart + 64;
+ $bfsig = "u64=[$bfsig]";
+ }
+ #$bfsig .= "]";
+ $sig .= $bfsig;
+ }
+
+ return "[".$sig."]";
+}
+
+sub funcSignature {
+ my %func = %{shift(@_)};
+ my $sig = "";
+ my @params = @{$func{arguments}};
+
+ for $pi (@params) {
+ my %param = %{$pi};
+
+ if ($param{deref}) {
+ # HACK: function to void
+ if ($param{debug} eq "function") {
+ $sig .= "u64:v";
+ } else {
+ $sig .= $param{deref};
+ }
+ } else {
+ if ($param{type} =~ m/struct:(.*)/) {
+ $sig .= "\${$1}";
+ } elsif ($param{type} =~ m/([iuf])(\d*)/) {
+ $sig .= $1;
+ $sig .= $2;
+ } elsif ($param{type} eq "void") {
+ $sig .= "v";
+ }
+ }
+ }
+
+ my %result = %{$func{result}};
+ my $ret = "";
+
+ if ($result{deref}) {
+ $ret .= $result{deref};
+ } else {
+ if ($result{type} =~ m/^struct:(.*)/) {
+ $ret .= "\${$1}";
+ } elsif ($result{type} =~ m/^([iuf])(\d+)/) {
+ $ret .= $1;
+ $ret .= $2;
+ } elsif ($result{type} eq "void") {
+ $ret .= "v";
+ }
+ }
+
+ return "($sig)$ret";
+}
+
+sub deref {
+ my $type = shift @_;
+ my $ref = shift @_;
+
+ while ($ref) {
+ if ($ref =~ m/\[\d*(.*)\]/) {
+ my $sub = deref($type, $1);
+
+ return "Array<$sub>";
+ } elsif ($ref =~ m/^u64:\$/) {
+ # ignore penultimate pointer?
+ last;
+ } elsif ($ref =~ m/^u64:(.*)/) {
+ $type = "Pointer<$type>";
+ $ref = $1;
+ } else {
+ last;
+ }
+ }
+ return $type;
+}
+
+sub typeToJava {
+ my %param = %{shift(@_)};
+ my $type = $param{type};
+ my $ref = $param{deref};
+
+ if ($type =~ m/^struct:(.*)/) {
+ $type = $replace{$1} ? $replace{$1} : StudlyCaps($1);
+ } elsif ($type =~ m/call:/) {
+ # this re-writes ref to remove one pointer-to as the Callback absorbs it.
+ $type = "Callback<".$callMap{$type}.">";
+ $type || die ("No mapping for type ".Dumper(\%param));
+ $ref =~ s/^u(32|64)://;
+ } elsif ($type =~ m/^enum:(.*)/) {
+ # TODO: other enum options
+ $type = "int";
+ } elsif ($type eq "void") {
+ $type = "void";
+ } elsif ($type =~ m/^([iu])(\d*)/) {
+ my $sign = $1;
+ my $size = $2;
+
+ if ($size <= 8) {
+ $type = "byte";
+ } elsif ($size <= 16) {
+ if ($sign eq "i") {
+ $type = "short";
+ } else {
+ $type = "char";
+ }
+ } elsif ($size <= 32) {
+ $type = "int";
+ } else {
+ $type = "long";
+ }
+ } elsif ($type =~ m/^[f](\d*)$/) {
+ my $size = $1;
+
+ if ($size == 32) {
+ $type = "float";
+ } elsif ($size == 64) {
+ $type = "double";
+ }
+ }
+
+ if ($ref) {
+ $type = $map_box{$type} if ($map_box{$type});
+ $type = deref($type, $ref);
+ }
+
+ return $type;
+}
+
+sub typeToRaw {
+ my %param = %{shift(@_)};
+ my $type = $param{type};
+ my $ref = $param{deref};
+
+ my $type = typeToJava(\%param);
+
+ if ($ref =~ m/^u64:/) {
+ return "MemoryAddress";
+ } elsif ($type =~ m/^(struct|union):/) {
+ return "MemorySegment";
+ } else {
+ return $type;
+ }
+
+ # hackity hack
+# if ($type =~ "(Pointer|Array|Callback)") {
+# return "MemoryAddress";
+# } elsif ($type =~ m/^[A-Z]/) {
+# return "MemorySegment";
+# } else {
+# return $type;
+# }
+}
+
+sub testMatch {
+ my $name = shift @_;
+
+ if (@_) {
+ for $pat (@_) {
+ if ($name =~ /$pat/) {
+ return 1;
+ }
+ }
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+# find all matching structures and then all that they require
+sub findStructs {
+ my %all = %{shift @_};
+ my @match = @_;
+ my @stack = grep {
+ my %e = %{$all{$_}};
+ $e{type} =~ m/(struct|union)/ && !$replace{$e{name}} && testMatch($e{name}, @match);
+ } keys %all;
+ my %visit = ();
+
+ while (@stack) {
+ my $test = shift @stack;
+
+ if (!$visit{$test}) {
+ my %struct = %{$all{$test}};
+
+ $visit{$test} = 1;
+
+ if (%struct) {
+ print "class: $struct{name}\n";
+ # find all types this one uses
+ for $f (@{$struct{fields}}) {
+ my %field = %{$f};
+
+ if ($field{type} =~ m/^(struct|union):(.*)/) {
+ if (!$replace{$1} && !$set{$field{type}}) {
+ $set{$field{type}} = $all{$field{type}};
+ push @stack, $field{type};
+ }
+ }
+ }
+ } else {
+ # this is an anon type, typically used for handles
+ $test =~ m/^(struct|union):(.*)/;
+ if (!$replace{$2}) {
+ print " anon: $2\n";
+ my %rec = (
+ type => 'struct',
+ name => $2,
+ size => 0
+ );
+ $data{$test} = \%rec;
+ }
+ }
+ }
+ }
+ return grep { !$replace{$_} } keys(%visit);
+}
+
+sub findDefinition {
+ my %all = %{shift @_};
+ my $type = shift @_;
+ my @match = @_;
+ my @stack = grep {
+ my %e = %{$all{$_}};
+ $e{type} eq $type && testMatch($e{name}, @match);
+ } keys %all;
+
+ return @stack;
+}
+
+sub arrayInfo {
+ my $ref = shift @_;
+ my %info = (
+ dims => [],
+ );
+
+ print "array $ref\n";
+ while ($ref =~ m/^\[(\d*)(.*)\]$/) {
+ push @{$info{dims}}, $1;
+ $ref = $2;
+ print "dim $1 -, '$2'\n";
+ }
+ $info{deref} = $ref;
+
+ return %info;
+}
+
+# ######################################################################
+
+# setup section
+
+# find all classes used by functions
+my %roots = ();
+for $c (@classes) {
+ my %class = %{$c};
+ my @libs = @{$class{libs}};
+ my @match = @{$class{match}};
+
+ for $k (findDefinition(\%data, 'func', @match)) {
+ my %func = %{$data{$k}};
+ my @params = @{$func{arguments}};
+
+ for $pi (@params) {
+ my %param = %{$pi};
+
+ if ($param{type} =~ m/^(struct|union):(.*)/) {
+ $roots{$2} = 1;
+ }
+ }
+
+ my %result = %{$func{result}};
+
+ if ($result{type} =~ m/^(struct|union):(.*)/) {
+ $roots{$2} = 1;
+ }
+ }
+}
+
+# add roots for any types used by calls
+# FIXME: only include ones used elsewhere
+for $k (grep { $_ =~ m/^call:/n } keys %data) {
+ my %func = %{$data{$k}};
+ my @params = @{$func{arguments}};
+
+ for $pi (@params) {
+ my %param = %{$pi};
+
+ if ($param{type} =~ m/^(struct|union):(.*)/) {
+ $roots{$2} = 1;
+ }
+ }
+
+ my %result = %{$func{result}};
+
+ if ($result{type} =~ m/^(struct|union):(.*)/) {
+ $roots{$2} = 1;
+ }
+}
+
+# Create anonymous structs for anything missing
+for $k (keys %roots) {
+ my $s = 'struct:'.$k;
+ my $u = 'union:'.$k;
+
+ if (!$data{$u} && !$data{$s} && !$replace{$k}) {
+ print " xanon: $s\n";
+ my %rec = (
+ type => 'struct',
+ name => $k,
+ size => 0
+ );
+ $data{$s} = \%rec;
+ }
+}
+
+$all = join ('|', keys %roots);
+if ($all) {
+ push @matchStruct, qr/^($all)$/;
+}
+print "structures:\n";
+print Dumper(@matchStruct);
+
+# make a map for all callbacks (call: type) to generated names
+for $c (grep { $_ =~ m/^call:/n } keys %data) {
+ my $name = $c;
+
+ print "$c\n";
+ # enum maybe to int?
+
+ $name =~ s/^call:/Call/;
+ if ($rawCalls) {
+ $name =~ s/\$\{([^\}]*)\}/L/g;
+ } else {
+ while ($name =~ m/\$\{([^\}]*)\}/) {
+ my $x = $1;
+ if ($replace{$x}) {
+ $x = $replace{$x};
+ } else {
+ $x = StudlyCaps($x);
+ }
+ $name =~ s/\$\{([^\}]*)\}/L$x/;
+ }
+ }
+ $name =~ s/[ui](64|32):/p/g;
+ $name =~ s/[ui]64/J/g;
+ $name =~ s/[ui]32/I/g;
+ $name =~ s/[ui]8/B/g;
+ $name =~ s/f32/F/g;
+ $name =~ s/f64/D/g;
+ $name =~ s/[\[\]\(\)]/_/g;
+
+ $callMap{$c} = "$name";
+}
+
+print "call mappings\n";
+print Dumper(\%callMap);
+
+# ######################################################################
+# Start output
+my $dst;
+
+use File::Basename;
+use File::Path qw(make_path);
+
+if ($package ne "") {
+ $packagePrefix = $package.".";
+}
+
+if ($enclosingType) {
+ my $classname = $packagePrefix.$enclosingType;
+
+ $classname =~ s@\.@/@g;
+
+ my $path = $output."/".$classname.".java";
+ my $dir = dirname($path);
+ my $class = basename($path, ".java");
+
+ print "path $path\n";
+ print "dirname $dir\n";
+
+ make_path($dir);
+ open ($dst, ">$path");
+
+ if ($package ne "") {
+ print $dst "package $package;\n";
+ }
+
+ print $dst <<END;
+import java.foreign.Libraries;
+import java.lang.invoke.MethodHandles;
+import jdk.incubator.foreign.*;
+import api.Native;
+$importPointer
+END
+ print $dst "public class $class {\n";
+}
+
+# ######################################################################
+# This is work in progress, aka a total fucking mess
+# Dump structures
+for $k (findStructs(\%data, @matchStruct)) {
+ my %struct = %{$data{$k}};
+ my @fields = @{$struct{fields}};
+ my $signature = structSignature(\%struct, ($struct{type} eq "union"));
+ my $name = StudlyCaps($struct{name});
+
+ if (!$enclosingType) {
+ my $classname = $packagePrefix.$name;
+
+ open ($dst, ">$path");
+ $classname =~ s@\.@/@g;
+
+ my $path = $output."/".$classname.".java";
+ my $dir = dirname($path);
+ my $class = basename($path, ".java");
+ make_path($dir);
+ open ($dst, ">$path");
+
+ if ($package ne "") {
+ print $dst "package $package;\n";
+ }
+ print $dst <<END;
+import jdk.incubator.foreign.*;
+import api.Native;
+$importPointer
+
+END
+ }
+
+ print $dst "public class $name extends Native {\n";
+
+ print $dst "\tpublic $name(MemoryAddress p) {\n";
+ print $dst "\t\tsuper(p);\n";
+ print $dst "\t}\n";
+
+ for $fi (@fields) {
+ my %field = %{$fi};
+ my $type = typeToJava(\%field);
+ my $cc = StudlyCaps($field{name});
+
+ if ($field{deref} =~ m/^\[/) {
+ # array
+ my %info = arrayInfo($field{deref});
+ my @dims = @{$info{dims}};
+ $info{type} = $field{type};
+ my $atype = typeToJava(\%info);
+ my @strides = ();
+
+ my $stride = 1;
+ for $dim (reverse(0 .. $#dims)) {
+ push @strides,$stride;
+ $stride *= $dims[$dim];
+ }
+
+ if ($field{type} =~ m/^(struct|union):(.*)/) {
+ for $dim (0 .. $#dims) {
+ print $dst "// $dims[$dim]\n";
+ }
+
+ print $dst "public $atype get$cc(";
+ for $dim (0 .. $#dims) {
+ print $dst ", " if ($dim != 0);
+ print $dst "int i$dim";
+ }
+ print $dst ") {\n";
+ print $dst "\tint i=";
+ for $dim (0 .. $#dims) {
+ print $dst " + " if ($dim != 0);
+ print $dst "(i$dim * $strides[$#dims - $dim])";
+ }
+ print $dst ";\n";
+ print $dst "return Native.Pointer.ofAddress(addr().addOffset(i * 8), 32, Data::new);\n";
+ print $dst "}\n";
+ } elsif ($field{type} =~ m/^call:/) {
+ } else {
+ }
+ } elsif ($field{deref} =~ m/^u64:\$/) {
+ # pointer-to-struct
+ if ($field{type} =~ m/^(struct|union):(.*)/) {
+ my $ltype = StudlyCaps($2);
+ my $offset = $field{offset} >> 3;
+ my $addr = $offset ? "addr().addOffset($offset)" : 'addr()';
+
+ my $size = %{$data{$field{type}}}{size} >> 3;
+
+ print $dst "\tpublic $ltype get$cc() {\n";
+ print $dst "\t\treturn $ltype.create(Native.getAddr($addr, $size));\n";
+ print $dst "\t}\n";
+
+ print $dst "\tpublic void set$cc($ltype v) {\n";
+ print $dst "\t\tNative.setAddr($addr, v.addr());\n";
+ print $dst "\t}\n";
+ }
+ } elsif ($field{deref} =~ m/^u64:u64:\$/) {
+ # pointer-to-pointer-to?
+ if ($field{type} =~ m/^(struct|union):(.*)/) {
+ my $ltype = StudlyCaps($2);
+ my $offset = $field{offset} >> 3;
+ my $addr = $offset ? "addr().addOffset($offset)" : 'addr()';
+
+ my $size = %{$data{$field{type}}}{size} >> 3;
+
+ print $dst "\tpublic $type get$cc() {\n";
+ print $dst "\t\treturn Native.Pointer.ofAddress($addr, $size, $ltype"."::new);\n";
+ print $dst "\t}\n";
+
+ print $dst "\tpublic void set$cc($type v) {\n";
+ print $dst "\t\tNative.setAddr($addr, v.addr());\n";
+ print $dst "\t}\n";
+ }
+ } elsif ($field{ctype} eq 'bitfield') {
+ my $alsr = $field{type} =~ m/^u/ ? '>>>' : '>>';
+ my $lshift = $field{size} <= 32 ? 5 : 6;
+ my $lbits = 1 << $lshift;
+ my $type = $lbits == 32 ? 'int' : 'long';
+ my $ltype = $lbits == 32 ? 'Int' : 'Long';
+
+ my $offset = ($field{offset} >> ($lshift)) * ($lbits / 8);
+ my $addr = $offset ? "addr().addOffset($offset)" : 'addr()';
+ my $shift = $field{offset} & ($lbits-1);
+ my $width = $field{size};
+ my $upshift = ($lbits-$width-$shift);
+ my $downshift = ($lbits-$width);
+ my $mask = sprintf("0x%x", ((1 << $width) - 1) << $shift);
+
+ print $dst "\tpublic $type get$cc() {\n";
+ print $dst "\t\treturn (($type)Native.get$ltype($addr)) << $upshift $alsr $downshift;\n";
+ print $dst "\t}\n";
+
+ print $dst "\tpublic void set$cc($type v) {\n";
+ print $dst "\t\tMemoryAddress addr = $addr;\n";
+ print $dst "\t\tNative.set$ltype(addr, ((($type)Native.get$ltype(addr)) & ~$mask) | ((v << $shift) & $mask));\n";
+ print $dst "\t}\n";
+ } elsif ($field{type} =~ m/^(struct|union):/) {
+ # embedded struct
+ } elsif ($field{type} =~ m/^call:/) {
+ # call, function?
+ print $dst "// call? $type $cc\n";
+ my $offset = $field{offset} >> 3;
+ my $addr = $offset ? "addr().addOffset($offset)" : 'addr()';
+ my $ltype = $type;
+
+ $type =~ s/Callback<(.*)>/$1/;
+
+ print $dst "\tprivate Pointer<$type> $cc;\n";
+
+ print $dst "\tpublic void set$cc($type v) {\n";
+ print $dst "\t\tif ($cc != null) $cc.close();\n";
+ print $dst "\t\tNative.setAddr($addr, ($cc = $type.call(v)).addr());\n";
+ print $dst "\t}\n";
+ } else {
+ my $offset = $field{offset} >> 3;
+ my $addr = $offset ? "addr().addOffset($offset)" : 'addr()';
+ my $ltype = $type;
+
+ $ltype =~ s/^(.)/uc($1)/e;
+
+ die("non-byte offset=$offset ".Dumper(\%field)) if ($field{offset} & 7);
+
+ print $dst "\tpublic $type get$cc() {\n";
+ print $dst "\t\treturn Native.get$ltype($addr);\n";
+ print $dst "\t}\n";
+
+ print $dst "\tpublic void set$cc($type v) {\n";
+ print $dst "\t\tNative.set$ltype($addr, v);\n";
+ print $dst "\t}\n";
+ }
+ }
+
+ my $byteSize = $struct{size} >> 3;
+ print $dst "\tpublic static final long sizeof = $byteSize;\n";
+
+ # TODO: optional just call new()
+ print $dst "\tpublic static $name create(MemoryAddress p) {\n";
+ print $dst "\t\treturn Native.resolve(p, $name"."::new);\n";
+ print $dst "\t}\n";
+
+ print $dst "\tpublic static $name alloc() {\n";
+ print $dst "\t\treturn $name.create(MemorySegment.allocateNative(sizeof).baseAddress());\n";
+ print $dst "\t}\n";
+ print $dst "\tpublic static Pointer<$name> alloc(int n) {\n";
+ print $dst "\t\treturn Pointer.alloc(n, sizeof, $name"."::new);\n";
+ print $dst "\t}\n";
+
+ if ($struct{type} eq "union") {
+ print $dst "\tpublic static MemoryLayout layout() { return Native.parseUnion(\"$signature\"); }\n";
+ } else {
+ print $dst "\tpublic static MemoryLayout layout() { return Native.parseStruct(\"$signature\"); }\n";
+ }
+
+ print $dst "}\n";
+
+ if (!$enclosingType) {
+ close($dst);
+ }
+}
+
+# ######################################################################
+# Dump classes for library linkage
+for $c (@classes) {
+ my %class = %{$c};
+ my @libs = @{$class{libs}};
+ my @match = @{$class{match}};
+
+ if (!$enclosingType) {
+ my $classname = $packagePrefix.$class{name};
+
+ open ($dst, ">$path");
+ $classname =~ s@\.@/@g;
+
+ my $path = $output."/".$classname.".java";
+ my $dir = dirname($path);
+ my $class = basename($path, ".java");
+ make_path($dir);
+ open ($dst, ">$path");
+
+ if ($package ne "") {
+ print $dst "package $package;\n";
+ }
+ print $dst <<END;
+import jdk.incubator.foreign.*;
+import java.lang.invoke.MethodHandle;
+import api.Native;
+$importPointer
+END
+ }
+
+ print $dst "public class $class{name} {\n";
+
+ print $dst "\tstatic final String[] libraries = {";
+ print $dst join(",", map { "\"$_\"" } @libs);
+ print $dst "};\n";
+
+ # enums to ints
+ # TODO: interfaces?
+ # TODO: static lib class?
+ # typedef enums might appear twice in the data, so ignore duplicates
+ # also, some api's have multiple definitions (?)
+ my %visited = ();
+ my @match_enum = @{$class{enum}};
+ for $k (sort(findDefinition(\%data, 'enum', @match_enum))) {
+ my %enum = %{$data{$k}};
+ my @values = @{$enum{values}};
+ my $type = "int";
+
+ if ($enum{value_type} =~ m/^[ui](\d+)/) {
+ $type = "long" if ($1 > 32)
+ }
+
+ print $dst "\n\t// enum $enum{name}\n";
+ for $vi (@values) {
+ my %value = %{$vi};
+
+ if (!$visited{$value{label}}) {
+ #print $dst "\tpublic static final $type $value{label} = ($type)$value{value};\n";
+ print $dst "\tpublic static final $type $value{label} = $value{value};\n";
+ $visited{$value{label}} = 1;
+ }
+ }
+ }
+
+ # function handles
+ print "class $class{name} -> match:\n".Dumper(\@match);
+
+ for $k (sort(findDefinition(\%data, 'func', @match))) {
+ my %func = %{$data{$k}};
+ my @params = @{$func{arguments}};
+ my $signature = funcSignature(\%func);
+ my $name = ($func{name});
+
+ print $dst "\tfinal static MethodHandle $name;\n";
+ }
+
+ # function handle init
+ print $dst "\tstatic {\n";
+ print $dst "\t\tLibraryLookup[] libs = Native.loadLibraries(libraries);\n";
+
+ for $k (sort(findDefinition(\%data, 'func', @match))) {
+ my %func = %{$data{$k}};
+ my @params = @{$func{arguments}};
+ my $signature = funcSignature(\%func);
+ my $name = ($func{name});
+
+ print $dst "\t\t$name = Native.downcallHandle(libs, \"$name\", \"$signature\");\n";
+ }
+ print $dst "\t}\n";
+
+ # function handle invocation
+ if ($rawCalls) {
+ for $k (sort(findDefinition(\%data, 'func', @match))) {
+ my %func = %{$data{$k}};
+ my @params = @{$func{arguments}};
+ my $signature = funcSignature(\%func);
+ my $name = ($func{name});
+ my %res = %{$func{result}};
+ my $result = typeToRaw(\%res);
+
+ print $dst "\tpublic static $result $name(";
+
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToRaw($pi);
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+
+ print $dst ") throws Throwable {\n";
+ if ($result ne "void") {
+ print $dst "return ($result)";
+ }
+ print $dst "$name.invokeExact(";
+ for $pi (@params) {
+ my %param = %{$pi};
+
+ print $dst "$param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ");\n";
+ print $dst "\t}\n\n";
+ }
+ print $dst "}\n";
+ } else {
+ for $k (sort(findDefinition(\%data, 'func', @match))) {
+ my %func = %{$data{$k}};
+ my @params = @{$func{arguments}};
+ my $signature = funcSignature(\%func);
+ my $name = ($func{name});
+ my %res = %{$func{result}};
+ my $result = typeToJava(\%{$func{result}});
+
+ print $dst "\tpublic static $result $name(";
+
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToJava($pi);
+
+ $type =~ s/Callback/Pointer/;
+
+ # HACK
+ $type =~ s/Pointer<Void>/Pointer<?>/;
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+
+ print $dst ") {\n";
+ # see also call below
+ print $dst "\t\ttry {\n";
+ print $dst "\t\t\t";
+ if ($res{type} =~ m/(struct|union)/n) {
+ if ($res{deref}) {
+ print $dst "MemoryAddress add = (MemoryAddress)";
+ } else {
+ print $dst "MemorySegment seg = (MemorySegment)";
+ }
+ } elsif ($result ne "void") {
+ print $dst "return ($result)";
+ }
+ print $dst "$name.invokeExact(";
+ for $pi (@params) {
+ my %param = %{$pi};
+
+ print $dst "$param{name}";
+ if ($param{deref}) {
+ print $dst ".addr()";
+ } elsif ($param{type} =~ m/^struct|union/) {
+ print $dst ".addr().segment()";
+ }
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ");\n";
+ if ($res{type} =~ m/(struct|union)/n) {
+ if ($res{deref}) {
+ print $dst "\t\t\treturn $result.create(add);\n";
+ } else {
+ print $dst "\t\t\treturn $result.create(seg.baseAddress());\n";
+ }
+ }
+ print $dst "\t\t}\n";
+ print $dst "\t\tcatch (Throwable t) { throw new RuntimeException(t); }\n";
+ print $dst "\t}\n\n";
+ }
+
+ print $dst "}\n";
+ }
+
+ if (!$enclosingType) {
+ close($dst);
+ }
+}
+
+# ######################################################################
+# Dump callbacks
+# TODO: only those used by classes and functions that were exported
+# TODO: yeah this is a total total fucking shitshow
+
+if ($rawCalls) {
+ for $c (keys %callMap) {
+ my %call = %{$data{$c}};
+ my $name = $callMap{$c};
+ my @params = @{$call{arguments}};
+ my %res = %{$call{result}};
+ my $result = typeToRaw(\%res);
+ my $signature = funcSignature(\%call);
+
+ if (!$enclosingType) {
+ my $classname = $packagePrefix.$name;
+
+ open ($dst, ">$path");
+ $classname =~ s@\.@/@g;
+
+ my $path = $output."/".$classname.".java";
+ my $dir = dirname($path);
+ my $class = basename($path, ".java");
+ make_path($dir);
+ open ($dst, ">$path");
+
+ if ($package ne "") {
+ print $dst "package $package;\n";
+ }
+ print $dst <<END;
+import jdk.incubator.foreign.*;
+import java.lang.invoke.MethodHandle;
+import java.lang.invoke.MethodHandles;
+import java.lang.reflect.Method;
+import api.Callback;
+import api.Native;
+$importPointer
+END
+ }
+
+ print $dst "\@FunctionalInterface\n";
+ print $dst "public interface $name {\n";
+ print $dst "\tpublic $result fn(";
+
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToRaw($pi);
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+
+ print $dst ") throws Throwable;\n";
+
+ # downcall
+ print $dst "\tstatic public $name of(MemoryAddress addr) {\n";
+ print $dst "\t\tMethodHandle func = Native.downcallHandle(addr, \"$signature\");\n";
+ print $dst "\t\treturn (";
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToRaw($pi);
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ") -> ";
+ if ($result ne "void") {
+ print $dst "($result)";
+ }
+ print $dst "func.invokeExact(";
+ for $pi (@params) {
+ my %param = %{$pi};
+
+ print $dst "$param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ");\n";
+ print $dst "\t}\n";
+
+ # upcall ##############################################################
+ # ??
+
+ print $dst "\tstatic MemoryAddress stub($name call) {\n";
+ print $dst "\t\treturn Native.upcallStub(MethodHandles.lookup(), call, \"$signature\");\n";
+ print $dst "\t}\n";
+
+ # # the raw interface as expected by the native code
+ # my $rawresult = typeToRaw(\%res);
+ # print $dst "\tpublic interface $rawName {\n";
+ # # fixme raw result
+ # print $dst "\t\tpublic $rawresult fn(";
+
+ # for $pi (@params) {
+ # my %param = %{$pi};
+ # my $type = typeToRaw($pi);
+
+ # print $dst "$type $param{name}";
+ # print $dst ", " if ($pi != $params[$#params]);
+ # }
+
+ # print $dst ");\n";
+ # print $dst "\t}\n";
+
+ # print $dst "\tstatic public Pointer<$name> call($name v) {\n";
+ # print $dst "\t\t$rawName func = (";
+ # for $pi (@params) {
+ # my %param = %{$pi};
+ # my $type = typeToRaw($pi);
+
+ # print $dst "$type $param{name}";
+ # print $dst ", " if ($pi != $params[$#params]);
+ # }
+ # print $dst ") -> {\n";
+ # print $dst "\t\t\t";
+ # if ($rawresult ne "void") {
+ # print $dst "return ";
+ # }
+ # print $dst "v.fn(";
+ # for $pi (@params) {
+ # my %param = %{$pi};
+ # my $type = typeToJava($pi);
+ # my $rawtype = typeToRaw($pi);
+
+ # print "type ='$type'\n";
+ # if ($type =~ m/^Pointer<[^>]*>$/) {
+ # print $dst "Pointer.ofAddress($param{name})";
+ # } elsif ($type eq "Pointer<Pointer<Void>>") {
+ # print $dst "Pointer.ofAddressP($param{name})";
+ # } elsif ($rawtype eq "MemoryAddress") {
+ # print $dst "$type.create($param{name})";
+ # } elsif ($rawtype eq "MemorySegment") {
+ # print $dst "$type.create($param{name}.baseAddress())";
+ # } else {
+ # print $dst "$param{name}";
+ # }
+ # print $dst ", " if ($pi != $params[$#params]);
+ # }
+ # print $dst ")";
+ # if ($rawresult eq "MemoryAddress") {
+ # print $dst ".addr()";
+ # } elsif ($rawresult eq "MemorySegment") {
+ # print $dst ".addr().segment()";
+ # }
+ # print $dst ";\n";
+
+ # print $dst "\t\t};\n";
+ # print $dst "\t\treturn Native.Pointer.ofCallback(MethodHandles.lookup(), v, func, \"$signature\");\n";
+ # print $dst "\t}\n";
+
+ print $dst "}\n";
+
+ if (!$enclosingType) {
+ close($dst);
+ }
+ }
+} else {
+ for $c (keys %callMap) {
+ my %call = %{$data{$c}};
+ my $name = $callMap{$c};
+ my @params = @{$call{arguments}};
+ my %res = %{$call{result}};
+ my $result = typeToJava(\%{$call{result}});
+ my $signature = funcSignature(\%call);
+
+ if (!$enclosingType) {
+ my $classname = $packagePrefix.$name;
+
+ open ($dst, ">$path");
+ $classname =~ s@\.@/@g;
+
+ my $path = $output."/".$classname.".java";
+ my $dir = dirname($path);
+ my $class = basename($path, ".java");
+ make_path($dir);
+ open ($dst, ">$path");
+
+ if ($package ne "") {
+ print $dst "package $package;\n";
+ }
+ print $dst <<END;
+import jdk.incubator.foreign.*;
+import java.lang.invoke.MethodHandle;
+import java.lang.invoke.MethodHandles;
+import java.lang.reflect.Method;
+import api.Native;
+$importPointer
+END
+ }
+
+ # any in-line structures need to be added to the resolutionContext
+ # TODO: only include actual inline, not pointers
+ #my %resolve = ();
+ #my @list = @params;
+ #unshift(@list,$call{result});
+ #for $pi (@list) {
+ # my %param = %{$pi};
+ #
+ # if ($param{type} =~ m/^(struct|union):(.*)/) {
+ # $resolve{StudlyCaps($2).".class"} = 1;
+ # }
+ # }
+ #my $resolve = join (",", keys %resolve);
+
+ print $dst "\@FunctionalInterface\n";
+ print $dst "public interface $name {\n";
+ print $dst "\tpublic $result fn(";
+
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToJava($pi);
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+
+ print $dst ");\n";
+
+ # downcall
+ print $dst "\tstatic public $name of(MemoryAddress addr) {\n";
+ print $dst "\t\tMethodHandle func = Native.downcallHandle(addr, \"$signature\");\n";
+ print $dst "\t\treturn (";
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToJava($pi);
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ") -> {\n";
+ print $dst "\t\t\ttry {\n";
+ print $dst "\t\t\t\t";
+ if (!$res{deref} && $res{type} =~ m/(struct|union)/n) {
+ print $dst "MemorySegment seg = (MemorySegment)";
+ } elsif ($result ne "void") {
+ print $dst "return ($result)";
+ }
+ print $dst "func.invokeExact(";
+ for $pi (@params) {
+ my %param = %{$pi};
+
+ print $dst "$param{name}";
+ if ($param{deref}) {
+ print $dst ".addr()";
+ } elsif ($param{type} =~ m/^struct|union/) {
+ print $dst ".addr().segment()";
+ }
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ");\n";
+ if (!$res{deref} && $res{type} =~ m/(struct|union)/n) {
+ print $dst "\t\t\t\treturn $result.create(seg.baseAddress());\n";
+ }
+ print $dst "\t\t\t} catch (Throwable t) { throw new RuntimeException(t); }\n";
+ print $dst "\t\t};\n";
+ print $dst "\t}\n";
+
+ # upcall ##############################################################
+ # the raw interface as expected by the native code
+ my $rawName = $name.'Raw';
+ my $rawresult = typeToRaw(\%res);
+ print $dst "\tpublic interface $rawName {\n";
+ # fixme raw result
+ print $dst "\t\tpublic $rawresult fn(";
+
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToRaw($pi);
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+
+ print $dst ");\n";
+ print $dst "\t}\n";
+
+ print $dst "\tstatic public Pointer<$name> call($name v) {\n";
+ print $dst "\t\t$rawName func = (";
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToRaw($pi);
+
+ print $dst "$type $param{name}";
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ") -> {\n";
+ print $dst "\t\t\t";
+ if ($rawresult ne "void") {
+ print $dst "return ";
+ }
+ print $dst "v.fn(";
+ for $pi (@params) {
+ my %param = %{$pi};
+ my $type = typeToJava($pi);
+ my $rawtype = typeToRaw($pi);
+
+ print "type ='$type'\n";
+ if ($type =~ m/^Pointer<[^>]*>$/) {
+ print $dst "Pointer.ofAddress($param{name})";
+ } elsif ($type eq "Pointer<Pointer<Void>>") {
+ print $dst "Pointer.ofAddressP($param{name})";
+ } elsif ($rawtype eq "MemoryAddress") {
+ print $dst "$type.create($param{name})";
+ } elsif ($rawtype eq "MemorySegment") {
+ print $dst "$type.create($param{name}.baseAddress())";
+ } else {
+ print $dst "$param{name}";
+ }
+ print $dst ", " if ($pi != $params[$#params]);
+ }
+ print $dst ")";
+ if ($rawresult eq "MemoryAddress") {
+ print $dst ".addr()";
+ } elsif ($rawresult eq "MemorySegment") {
+ print $dst ".addr().segment()";
+ }
+ print $dst ";\n";
+
+ print $dst "\t\t};\n";
+ print $dst "\t\treturn Native.Pointer.ofCallback(MethodHandles.lookup(), v, func, \"$signature\");\n";
+ print $dst "\t}\n";
+
+ print $dst "}\n";
+
+ if (!$enclosingType) {
+ close($dst);
+ }
+ }
+}
+
+# Finish off
+if ($enclosingType) {
+ print $dst "}\n";
+ close($dst);
+}