From: Not Zed Date: Wed, 24 Nov 2021 23:34:39 +0000 (+1030) Subject: add api generator script X-Git-Url: https://code.zedzone.au/cvs?a=commitdiff_plain;h=cb6bc7914272d648427aef4beb646905dafcbacc;p=panamaz add api generator script checkpoint the rest --- diff --git a/src/export-defines b/src/export-defines new file mode 100755 index 0000000..ece2b0e --- /dev/null +++ b/src/export-defines @@ -0,0 +1,91 @@ +#!/usr/bin/perl + +# the gcc plugin doesn't have access to the #defines, so this is a 'simple' way to get them. + +@matchDefine = (); +@matchInclude = (); + +@includes = (); + +while (@ARGV) { + my $cmd = shift(@ARGV); + + if ($cmd eq "-d") { + my $v = shift(@ARGV); + push @matchDefine, $v; + } elsif ($cmd eq "--define-file") { + my $file = shift(@ARGV); + push @matchDefine, readMatchFile($file); + } elsif ($cmd eq "-i") { + my $v = shift(@ARGV); + push @matchInclude, $v; + } elsif ($cmd eq "-I") { + my $v = shift(@ARGV); + push @includes, $v; + } elsif ($cmd =~ "-I(.*)") { + push @includes, $1; + } else { + $header = $cmd; + } +} + +my $all = join ('|', @matchDefine); + +$matchDefine = qr/($all)/; + +$all = join('|', @matchInclude); + +$matchInclude = qr/($all)/; + +print "all: $all\n"; +print "$matchDefine\n"; + +sub readMatchFile { + my $path = shift @_; + my @lines = (); + + open(my $f,"<$path"); + while (<$f>) { + chop; + next if m/^#/; + + push @lines, $_; + } + close($f); + + my $all = join ('|', @lines); + + return qr/^($all)$/; +} + +$dump = 0; + +$args = join("", map { "\"-I$_\"" } @includes); + +open IN,"gcc -C -E -dD $args $header|"; +# only #defines that are defined in the same directory or file as header? +while () { + if (m/^# (\d*) \"(.*)\"/) { + $dump = ($2 =~ /$matchInclude/); + } + if ($dump) { + if (m/^#define\s+(\w*)\s+(.*)/) { + my $name = $1; + my $def = $2; + + if ($name =~ /$matchDefine/) { + if ($def =~ m/L$/) { + print "public static final long $name = (long)$def;\n"; if ($def =~ m/L$/); + } elsif ($def =~ m/^(0x)?[0-9]*$/) { + print "public static final long $name = (int)$def;\n"; if ($def =~ m/L$/); + } elsif ($def =~ m/f$/) { + print "public static final float $name = $def;\n"; if ($def =~ m/L$/); + } elsif ($def =~ m/^[\.E-+0-9]*$/) { + } + #if ($def =~ m/^0x/) { + #} + } + } + } +} +close IN; diff --git a/src/generate-api b/src/generate-api new file mode 100755 index 0000000..86f5296 --- /dev/null +++ b/src/generate-api @@ -0,0 +1,1395 @@ +#!/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 <$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 <> 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 < 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/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 < "; + 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>") { + # 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 < {\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>") { + 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); +}