NotZed's Source Code Repository - panamaz/blob - src/generate-native

   1 #!/usr/bin/perl
   2
   3 # -*- Mode:perl; perl-indent-level:4;tab-width:4; -*-
   4
   5 # TODO: global defaults and/or pattern matching on api targets, partially done
   6 # TODO: perhaps an option which just dumps everything it finds at some level
   7 # TODO: the code here isn't a complete mess but could be improved
   8 #       - parameterise some functions
   9 # TODO: map int to boolean where appropriate
  10 # TODO: arrays with specified lengths passed as arguments could be size-checked in function stubs.
  11 # TODO: error codes -> exceptions?
  12 # TODO: auto-loading of libraries (library xx load=blah) option.
  13
  14 use Data::Dumper;
  15 use File::Basename;
  16 use File::Path qw(make_path);
  17
  18 $scriptPath = dirname(__FILE__);
  19
  20 $package = "";
  21 $output = "bin";
  22 $verbose = 0;
  23 $apidef = "api.def";
  24
  25 # usage
  26 #  -t package    target package
  27 #  -d directory  output root
  28 #  -v            verbose
  29 #  -a datafile   add datafile to the dataset, can be from export.so or export-defines, etc
  30
  31 my %typeSizes = (
  32         i8 => 'byte', u8 => 'byte',
  33         i16 => 'short', u16 => 'short',
  34         i32 => 'int', u32 => 'int',
  35         i64 => 'long', u64 => 'long',
  36         f32 => 'float',
  37         f64 => 'double',
  38         );
  39
  40 # or just use some formatting function table
  41 my %defineType = (
  42         %typeSizes,
  43         string => 'String'
  44         );
  45
  46 my %definePrefix = (
  47         i8 => '(byte)',
  48         u8 => '(byte)',
  49         i16 => '(short)',
  50         u16 => '(short)',
  51         string => '"'
  52         );
  53 my %defineSuffix = (
  54         u64 => 'L',
  55         i64 => 'L',
  56         f32 => 'f',
  57         string => '"'
  58         );
  59
  60 my %intSizes = ( 8 => 'byte', 16 => 'short', 32 => 'int', 64 => 'long' );
  61 my %typePrimitive = (
  62         "byte" => 8,
  63         "short" => 16,
  64         "int" => 32,
  65         "long" => 64,
  66         "float" => 32,
  67         "double" => 64,
  68         );
  69
  70 my %typeSignature = (
  71         "byte" => "B",
  72         "short" => "S",
  73         "int" => "I",
  74         "long" => "J",
  75         "float" => "F",
  76         "double" => "D",
  77         "MemorySegment" => "Ljdk/incubator/foreign/MemorySegment;",
  78         "MemoryAddress" => "Ljdk/incubator/foreign/MemoryAddress;",
  79         );
  80
  81 my %renameTable = (
  82         'studly-caps' => sub { my $s = shift; $s =~ s/(?:^|_)(.)/\U$1/g; return $s; },
  83         'camel-case' => sub { my $s = shift; $s =~ s/(?:_)(.)/\U$1/g; return $s; },
  84         'upper-leadin' => sub { my $s = shift; $s =~ s/^([^_]+)/\U$1/; return $s; },
  85         'identity' => sub {     return $_[0]; },
  86         );
  87
  88 my %data = ();
  89
  90 while (@ARGV) {
  91         my $cmd = shift;
  92
  93         if ($cmd eq "-t") {
  94                 $package = shift;
  95     } elsif ($cmd eq "-d") {
  96                 $output = shift;
  97     } elsif ($cmd eq "-v") {
  98                 $verbose++;
  99     } elsif ($cmd eq "-a") {
 100                 my $file = shift;
 101                 my $info;
 102
 103                 print "Add $file\n";
 104
 105                 unless ($info = do $file) {
 106                         die "couldn't parse $file: $@" if $@;
 107                         die "couldn't import $file: $!"    unless defined $info;
 108                         die "couldn't run $file"       unless $info;
 109                 }
 110
 111                 %data = (%data, %{$info});
 112         } else {
 113                 $apidef = $cmd;
 114         }
 115 }
 116
 117 my $api = loadControlFile($apidef);
 118
 119 analyseAPI($api);
 120 analyseAndFixTypes();
 121
 122 if (0) {
 123         $s = $data{'struct:AVCodecContext'};
 124         $obj = findAPIObject($api, 'struct', $s->{name});
 125         print Dumper($obj);
 126
 127         foreach $m (@{$s->{fields}}) {
 128                 $inc = findAPIField($obj, $m->{name});
 129                 print " $m->{name} - $inc\n";
 130         }
 131 }
 132
 133 my $toDump = analyseDependencies(\%data, findRoots($api));
 134
 135 if ($verbose > 1) {
 136         print "Using:n";
 137         print Dumper(\%data);
 138         print "API:n";
 139         print Dumper($api);
 140 }
 141
 142 # find api.struct that matches a given struct name
 143 sub findAPIObject {
 144         my $api = shift;
 145         my $type = shift;
 146         my $name = shift;
 147
 148         print "find api for $type:$name\n" if $verbose;
 149         foreach $obj ( @{$api->{$type}} ) {
 150                 next if $obj->{name} eq '<default>';
 151                 print " $obj->{name} ? $name\n" if $verbose;
 152                 if ($obj->{name} =~ m@/(.*)/@) {
 153                         my $rx = qr/$1/;
 154                         return $obj if ($name =~ m/$rx/);
 155                 } elsif ($obj->{name} eq $name) {
 156                         return $obj;
 157                 }
 158         }
 159
 160         print " -> fallback=$type:<default>\n" if $verbose && $api->{"$type:<default>"};
 161         return $api->{"$type:<default>"};
 162 }
 163
 164 # sub findAPIStruct {
 165 #       my $api = shift;
 166 #       my $name = shift;
 167
 168 #       foreach $obj ( @{$api->{struct}} ) {
 169 #               next if $obj->{name} eq '<default>';
 170 #               print "$obj->{name} ? $name\n" if $verbose;
 171 #               if ($obj->{name} =~ m@/(.*)/@) {
 172 #                       my $rx = qr/$1/;
 173 #                       return $obj if ($name =~ m/$rx/);
 174 #               } elsif ($obj->{name} eq $name) {
 175 #                       return $obj;
 176 #               }
 177 #       }
 178
 179 #       return $api->{'struct:<default>'};
 180 # }
 181
 182 sub findAPIField {
 183         my $obj = shift;
 184         my $name = shift;
 185
 186         foreach $inc (grep { $_->{mode} eq 'field' } @{$obj->{items}}) {
 187                 return $inc if $name =~ m/$inc->{regex}/;
 188         }
 189 }
 190
 191 # find all directly referenced types and field types from api
 192 sub findRoots {
 193         my $api = shift;
 194         my %seen;
 195
 196         foreach $obj ( @{$api->{library}} ) {
 197                 foreach $inc ( @{$obj->{items}} ) {
 198                         if ($inc->{mode} eq 'func') {
 199                                 my @list = grep { $_->{type} eq $inc->{mode} && $_->{name} =~ m/$inc->{regex}/ } values %data;
 200
 201                                 foreach $func (@list) {
 202                                         $seen{"func:$func->{name}"} ++;
 203                                 }
 204                         }
 205                 }
 206         }
 207
 208         # all defines included
 209         foreach $def ( @{$api->{define}} ) {
 210                 $seen{"define:$def->{name}"} ++;
 211         }
 212
 213         foreach $obj ( @{$api->{struct}}, @{$api->{func}}) {
 214                 my @list;
 215
 216                 if ($obj->{name} =~ m@/(.*)/@) {
 217                         my $rx = "$obj->{type}:$1";
 218                         push @list, grep { $_ =~ m/$rx/ } keys %data;
 219                 } else {
 220                         push @list, "$obj->{type}:$obj->{name}";
 221                 }
 222
 223                 foreach $n (@list) {
 224                         $seen{$n} ++;
 225                 }
 226
 227         }
 228
 229         delete $seen{'struct:<default>'};
 230         delete $seen{'func:<default>'};
 231         delete $seen{'call:<default>'};
 232
 233         my @list = sort keys %seen;
 234
 235         return \@list;
 236 }
 237
 238 # analyse dependencies of the supplied roots
 239 # only fields actually referenced in the api.def file are included
 240 # \%seen = \%data, \@roots
 241 sub analyseDependencies {
 242         my $data = shift;
 243         my @roots = @{shift @_};
 244         my %seen;
 245
 246         print "Finding dependencies of $#roots roots\n";
 247
 248         while ($#roots >= 0) {
 249                 my $name = shift @roots;
 250                 my $s = $data{$name};
 251                 my @list;
 252
 253                 next if $seen{$name}++;
 254
 255                 print "visit $name $s->{name}\n" if $verbose;
 256
 257                 if ($s->{type} =~ m/struct|union/) {
 258                         my $obj = findAPIObject($api, 'struct', $s->{name});
 259                         if ($obj->{default} eq 'all') {
 260                                 push @list, @{$s->{fields}};
 261                         } else {
 262                                 push @list, grep { findAPIField($obj, $_->{name}) } @{$s->{fields}};
 263                         }
 264                 } elsif ($s->{type} =~ m/func|call/) {
 265                         @list = @{$s->{arguments}};
 266                         push @list, $s->{result};
 267                 }
 268
 269                 foreach $m (@list) {
 270                         my $type = $m->{type};
 271
 272                         print " item $m->{name} '$type'\n" if $verbose;
 273                         if ($m->{ctype} =~ m/enum (.*)/) {
 274                                 $type = "enum:$1";
 275                         }
 276
 277                         push @roots,$type if $data{$type};
 278                 }
 279         }
 280
 281         foreach $name (sort grep { m/:/ } keys %seen) {
 282                 print " $name\n";
 283         }
 284         print "\n";
 285         return \%seen;
 286 }
 287
 288 # find which api->thing->items applies to a given field name, if any
 289 sub findAPIItem {
 290         my $api = shift;
 291         my $type = shift;
 292         my $target = shift;
 293         my $mode = shift;
 294         my $name = shift;
 295
 296         #print "search for $target.$name in $type.$mode\n";
 297         # what about exclude?
 298         foreach $obj ( @{$api->{$type}} ) {
 299                 if ($obj->{name} eq $target) {
 300                         #print " found $target\n";
 301                         foreach $inc (grep { $_->{mode} eq $mode } @{$obj->{items}}) {
 302                                 #print "  check $inc->{match}\n";
 303                                 return $inc if $name =~ m/$inc->{regex}/;
 304                         }
 305                 }
 306         }
 307 }
 308
 309 sub analyseAPI {
 310         my $api = shift;
 311
 312         foreach $obj ( @{$api->{struct}}, @{$api->{library}}, @{$api->{func}}) {
 313                 $obj->{access} = 'rw';
 314                 $obj->{default} = 'all';
 315                 $obj->{rename} = $renameTable{'identity'};
 316                 $obj->{'func:rename'} = $renameTable{'identity'};
 317                 $obj->{'field:rename'} = $renameTable{'identity'};
 318                 foreach $o (@{$obj->{options}}) {
 319                         if ($o =~ m/^default=(none|all)$/) {
 320                                 $obj->{default} = $1;
 321                         } elsif ($o =~ m/^access=([rwi]+)$/) {
 322                                 $obj->{access} = $1;
 323                         } elsif ($o =~ m@^(rename|field:rename|func:rename)=(.*)@) {
 324                                 my $target = $1;
 325
 326                                 if ($obj->{name} eq 'SwsContext') {
 327                                         print "SwsContext rename = $o\n";
 328                                 }
 329
 330                                 foreach $n (split /,/,$2) {
 331                                         my $old = $obj->{$target};
 332                                         my $new = $renameTable{$n};
 333
 334                                         if ($n =~ m@^s/(.*)/(.*)/$@) {
 335                                                 my $rx = qr/$1/;
 336                                                 my $rp = $2;
 337                                                 $obj->{$target} = sub { my $s=shift; $s = $old->($s); $s =~ s/$rx/$rp/; return $s;};
 338                                         } elsif ($new) {
 339                                                 $obj->{$target} = sub { my $s=shift; $s = $old->($s); return $new->($s); };
 340                                         }
 341                                 }
 342                         }
 343                 }
 344
 345                 my $defmode = $obj->{type} eq 'library' ? 'func' : 'field';
 346
 347                 foreach $inc (@{$obj->{items}}) {
 348                         if ($inc->{match} =~ m@^(field|func|define|struct|enum):/(.*)/$@) {
 349                                 $inc->{regex} = qr/$2/;
 350                                 $inc->{mode} = $1; # ?? "$1-include";
 351                         } elsif ($inc->{match} =~ m@^(field|func|define|struct|enum):(.*)$@) {
 352                                 $inc->{regex} = qr/^$2$/;
 353                                 $inc->{mode} = $1;
 354                         } elsif ($inc->{match} =~ m@^/(.*)/$@) {
 355                                 $inc->{regex} = qr/$1/;
 356                                 $inc->{mode} = $defmode;
 357                         } else {
 358                                 $inc->{regex} = qr/^$inc->{match}$/;
 359                                 $inc->{mode} = $defmode;
 360                         }
 361
 362                         $inc->{rename} = $renameTable{'identity'};
 363                         $inc->{scope} = 'static' if $obj->{type} eq 'library';
 364
 365                         # maybe depends on mode above
 366                         foreach $o (@{$inc->{options}}) {
 367                                 if ($o =~ m/^access=([rwi])+/) {
 368                                         $inc->{access} = $1;
 369                                 } elsif ($o =~ m/^rename=(.*)/) {
 370                                         foreach $n (split /,/,$1) {
 371                                                 my $old = $inc->{rename};
 372                                                 my $new = $renameTable{$n};
 373
 374                                                 if ($n =~ m@^s/(.*)/(.*)/$@) {
 375                                                         my $rx = qr/$1/;
 376                                                         my $rp = $2;
 377                                                         $inc->{rename} = sub { my $s=shift; $s = $old->($s); $s =~ s/$rx/$rp/; return $s;};
 378                                                 } elsif ($new) {
 379                                                         $inc->{rename} = sub { my $s=shift; $s = $old->($s); return $new->($s); };
 380                                                 } else {
 381                                                         my $x = $n;
 382                                                         $inc->{rename} = sub { return $x; };
 383                                                 }
 384                                         }
 385                                 } elsif ($o =~ m/^array-size=(.*)/) {
 386                                         $inc->{'array_size'} = $1;
 387                                 } elsif ($o =~ m/^array$/) {
 388                                         $inc->{'array'} = 1;
 389                                 } elsif ($o =~ m/^instance=(.*)/) {
 390                                         $inc->{instance} = $1;
 391                                 } elsif ($o =~ m/^static$/) {
 392                                         $inc->{scope} = 'static';
 393                                 } elsif ($o =~ m/^constructor=(.*)$/) {
 394                                         $inc->{constructor} = $1;
 395                                 } elsif ($o =~ m/^constructor-result=(.*)$/) {
 396                                         $inc->{constructor_result} = $1;
 397                                 } elsif ($o =~ m/^success=(.*)$/) {
 398                                         $inc->{success} = $1;
 399                                 }
 400                                 # exclude mode, etc
 401                         }
 402
 403                         $inc->{rename} = $obj->{"$inc->{mode}:rename"} if $inc->{rename} == $renameTable{'identity'} && $obj->{"$inc->{mode}:rename"};
 404                 }
 405
 406                 if ($obj->{name} eq '<default>') {
 407                         $api->{"$obj->{type}:<default>"} = $obj;
 408                 }
 409         }
 410
 411         $api->{'call:<default>'} = { rename => $renameTable{'identity'}, scope => 'static'} if !$api->{'call:<default>'};
 412 }
 413
 414 # anonymous structs
 415 #  the exporter doesn't output anonymous structs as they might
 416 #  just be forward references.  this fills in any missing types.
 417 # anonymouse calls
 418 #  anonymous functions are referenced by signature, convert any to an identifier
 419 # typeInfo
 420 #  setup typeInfo for all type references - memebers, fields, return values
 421 sub analyseAndFixTypes {
 422         my @replace = ();
 423
 424         # pass 1, fix call definition names and keys
 425         foreach $old (keys %data) {
 426                 if ($old =~ m/^call:/) {
 427                         push @replace, $old;
 428                 }
 429         }
 430         foreach $old (@replace) {
 431                 my $new = $old;
 432                 my $c;
 433
 434                 $new =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
 435                 $data{$new} = $c = delete $data{$old};
 436                 $c->{name} =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
 437         }
 438
 439         # pass 2 add typeinfo and anonymous types, fix call types
 440         foreach $n (keys %data) {
 441                 my $s = $data{$n};
 442                 my @list;
 443
 444                 if ($s->{type} =~ m/struct|union/) {
 445                         @list = @{$s->{fields}};
 446                 } elsif ($s->{type} =~ m/func|call/) {
 447                         @list = @{$s->{arguments}};
 448                         push @list, $s->{result};
 449                 }
 450
 451                 foreach $a (@list) {
 452                         if ($a->{type} =~ m/(struct|union):(.*)/ && !defined($data{$a->{type}})) {
 453                                 print "Add anonymous $1 $2\n";
 454                                 $data{$a->{type}} = {
 455                                         name => $2,
 456                                         type => $1,
 457                                         size => 0
 458                                 };
 459                         }
 460
 461                         if ($a->{type} =~ m/^call:/) {
 462                                 $a->{type} =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
 463                         }
 464
 465                         # must be last
 466                         $a->{typeInfo} = analyseTypeInfo($s, $a);
 467                 }
 468         }
 469
 470         # pass 3 create java signatures
 471         foreach $n (keys %data) {
 472                 my $s = $data{$n};
 473
 474                 if ($s->{type} =~ m/^(call|func)$/) {
 475                         $s->{signature} = formatSignature($s);
 476                 }
 477         }
 478 }
 479
 480 sub isVoid {
 481         my $m = shift @_;
 482
 483         return $m->{type} eq 'void' && !$m->{deref};
 484 }
 485
 486 # format a single layout type item for non-bitfield types
 487 # type - type record that contains type and deref
 488 # withName - '.withName()' - empty, or really any other MemoryLayout adjustment functions.
 489 sub formatTypeLayout {
 490         my $m = shift @_;
 491         my $withName = shift @_;
 492         my $desc = "";
 493
 494         if ($m->{deref} =~ m/^(u64|u32):/) {
 495                 $desc .= "Memory.POINTER$withName";
 496         } elsif ($m->{type} =~ m/^([iuf]\d+)$/) {
 497                 if ($m->{deref} =~ m/\[(\d*)u64:.*\]/) {
 498                         $desc .= "MemoryLayout.sequenceLayout($1, Memory.POINTER)$withName";
 499                 } elsif ($m->{deref} =~ m/\[(\d*).*\]/) {
 500                         $desc .= "MemoryLayout.sequenceLayout($1, Memory.".uc($typeSizes{$m->{type}}).")$withName";
 501                 } else {
 502                         $desc .= 'Memory.'.uc($typeSizes{$m->{type}})."$withName";
 503                 }
 504         } elsif ($m->{type} =~ m/^(struct|union):(.*)/) {
 505                 my $type = $2;
 506                 if ($m->{deref} =~ m/\[(\d*)u64:.*\]/) {
 507                         $desc .= "MemoryLayout.sequenceLayout($1, Memory.POINTER)$withName";
 508                 } elsif ($m->{deref} =~ m/\[(\d*).*\]/) {
 509                         $desc .= "MemoryLayout.sequenceLayout($1, $type.LAYOUT)$withName";
 510                 } else {
 511                         $desc .= "$type.LAYOUT$withName";
 512                 }
 513         } else {
 514                 print Dumper($m);
 515                 die ("unknown type");
 516         }
 517
 518         return $desc;
 519 }
 520
 521 sub formatFunctionDescriptor {
 522         my $c = shift @_;
 523         my @arguments = @{$c->{arguments}};
 524         my $result = $c->{result};
 525         my $desc;
 526         my $index = 0;
 527
 528         if (!isVoid($result)) {
 529                 $desc = "FunctionDescriptor.of(\n ";
 530                 $desc .= formatTypeLayout($result);
 531                 $index = 1;
 532         } else {
 533                 $desc = "FunctionDescriptor.ofVoid(\n ";
 534         }
 535
 536         foreach $m (@arguments) {
 537                 $desc .= ",\n " if ($index++ > 0);
 538                 $desc .= formatTypeLayout($m, ".withName(\"$m->{name}\")");
 539         }
 540
 541         $desc .= "\n)";
 542
 543         return $desc;
 544 }
 545
 546 sub formatSignature {
 547         my $c = shift @_;
 548         my @arguments = @{$c->{arguments}};
 549         my $desc = '(';
 550
 551         foreach $m (@arguments) {
 552                 $desc .= $typeSignature{$m->{typeInfo}->{carrier}};
 553         }
 554         $desc .= ')';
 555
 556         if ($c->{result}->{typeInfo}->{type} ne 'void') {
 557                 $desc .= $typeSignature{$c->{result}->{typeInfo}->{carrier}};
 558         } else {
 559                 $desc .= 'V';
 560         }
 561
 562         return $desc;
 563 }
 564
 565 # TODO: perhaps ByteArray should just be MemorySegment, kinda painful to wrap them all the time
 566 sub analyseTypeInfo {
 567         my $s = shift;
 568         my $m = shift;
 569         my $info = {};
 570         my $inc;
 571
 572         #print " query $s->{name} $s->{type} '$m->{name}', '$m->{type}'\n";
 573         if ($s->{type} eq 'struct') {
 574                 $inc = findAPIItem($api, 'struct', $s->{name}, 'field', $m->{name});
 575         } elsif ($s->{type} eq 'func') {
 576                 $inc = findAPIItem($api, 'func', $s->{name}, 'field', $m->{name});
 577         }
 578
 579         # default for everything not specifically handled
 580         $info->{carrier} = "MemoryAddress";
 581         $info->{resolve} = "(Addressable)Memory.address(\${value})";
 582
 583         if ($m->{deref} =~ m/^(u64:|u32:)\(/) {
 584                 # This is a function pointer, type must be type = 'call:.*'
 585                 if ($m->{type} =~ m/^call:(.*)/) {
 586                         $info->{type} = "Memory.FunctionPointer<$1>";
 587                         $info->{create} = "$1.downcall(\${result}, \${scope})";
 588                 } else {
 589                         die();
 590                 }
 591         } elsif ($m->{type} =~ m/^([iuf]\d+)$/) {
 592                 if ($m->{deref} =~ m/\[(\d*)u64:.*\]/) {
 593                         $info->{byValue} = 1;
 594                         $info->{type} = "Memory.PointerArray";
 595                         $info->{create} = $info->{type}.".create(\${result})";
 596                 } elsif ($m->{deref} =~ m/\[(\d*).*\]/) {
 597                         # TODO: some mode thing rather than byvalue?
 598                         $info->{byValue} = 1;
 599                         $info->{type} = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
 600                         $info->{create} = $info->{type}.".create(\${result})";
 601                 } elsif ($m->{deref} =~ m/^(u64:u64:|u32:u32:)/) {
 602                         $info->{type} = "Memory.PointerArray";
 603                         $info->{create} = $info->{type}.".createArray(\${result}, Long.MAX_VALUE, \${scope})";
 604                 } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
 605                         # assume any char * is a string unless an array-size or array is specified
 606                         if ($inc->{array}) {
 607                                 $info->{type} = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
 608                                 $info->{create} = $info->{type}.".createArray(\${result}, Long.MAX_VALUE, \${scope})";
 609                         } elsif ($inc->{array_size}) {
 610                                 $info->{type} = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
 611                                 $info->{create} = $info->{type}.".createArray(\${result}, \${array_size}, \${scope})";
 612                         } elsif ($typeSizes{$m->{type}} eq 'byte') {
 613                                 $info->{type} = 'String';
 614                                 $info->{resolve} = "(Addressable)Memory.address(frame.copy(\${value}))";
 615                                 $info->{create} = "(\${result}).getUtf8String(0)";
 616                                 $info->{resolveFrame} = 1;
 617                                 # for a function or a constructor that uses this element
 618                                 $s->{resolveFrame} = 1;
 619                         } else {
 620                                 # ideally length 0 but panama-foreign doesn't grok that so fuckit
 621                                 $info->{type} = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
 622                                 $info->{create} = $info->{type}.".createArray(\${result}, Long.MAX_VALUE, \${scope})";
 623                         }
 624                 } else {
 625                         $info->{type} = $typeSizes{$m->{type}};
 626                         $info->{carrier} = $typeSizes{$m->{type}};
 627                         $info->{resolve} = "($info->{type})(\${value})";
 628                         $info->{create} = "\${result}";
 629                 }
 630         } elsif ($m->{type} =~ m/^(struct|union):(.*)/) {
 631                 my $type = $2;
 632                 if ($m->{deref} =~ m/\[(\d*)(.*)\]/) {
 633                         $info->{byValue} = 1;
 634                         # handle  'type name[x]' and  'type *name[x]'
 635                         my $count = $1;
 636                         my $deref = $2;
 637                         if ($deref =~ m/^u64:u64:/) {
 638                                 die("can't handle double-deref array");
 639                         } elsif ($deref =~ m/^u64:/) {
 640                                 $info->{type} = "Memory.HandleArray<$type>";
 641                                 $info->{create} = "Memory.HandleArray.create(\${result}, $type\:\:create, \${scope})";
 642                         } else {
 643                                 $info->{type} = $type;
 644                                 #$info->{create} = $info->{type}.".create(\${result}, \${scope})";
 645                                 $info->{create} = $info->{type}.".create(\${result})";
 646                         }
 647                 } elsif ($m->{deref} =~ m/^(u64:u64:|u32:u32:)/) {
 648                         # this assumes ** is as far as it gets
 649                         $info->{type} = "Memory.HandleArray<$type>";
 650                         if ($inc->{array_size}) {
 651                                 $info->{create} = "Memory.HandleArray.createArray(\${result}, \${array_size}, $type\:\:create, \${scope})";
 652                         } else {
 653                                 $info->{create} = "Memory.HandleArray.createArray(\${result}, Long.MAX_VALUE, $type\:\:create, \${scope})";
 654                         }
 655                 } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
 656                         $info->{type} = $type;
 657                         $info->{create} = $info->{type}.".create(\${result}, \${scope})";
 658                 } else {
 659                         # FIXME: change this to a reftype or something
 660                         $info->{byValue} = 1;
 661                         $info->{type} = $type;
 662                         $info->{create} = $info->{type}.".create(\${result})";
 663                 }
 664         } elsif ($m->{type} eq "void") {
 665                 if ($m->{deref} =~ m/^(u64:u64:|u32:u32:)/) {
 666                         $info->{type} = "Memory.PointerArray";
 667                         $info->{create} = $info->{type}.".createArray(\${result}, Long.MAX_VALUE, \${scope})";
 668                 } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
 669                         $info->{type} = "MemoryAddress";
 670                         $info->{create} = "\${result}";
 671                         $info->{resolve} = "(Addressable)\${value}";
 672                 } else {
 673                         $info->{type} = "void";
 674                         $info->{carrier} = "void";
 675                         delete $info->{resolve};
 676                 }
 677         } else {
 678                 print Dumper($m);
 679                 die ("unknown type");
 680         }
 681
 682         return $info;
 683 }
 684
 685 # TODO: see if this can be merged with formatFunction
 686 # TODO: should constructor take a resourcescope always?
 687 # TODO: exceptions for errors
 688 sub formatConstructor {
 689         my $c = shift;
 690         my $inc = shift;
 691         my @arguments = @{$c->{arguments}};
 692         my $result = $c->{result};
 693         my $desc;
 694         my $index = 0;
 695         my $count = 0;
 696         my $desc = "";
 697         my $name = $c->{name};
 698         my $rtype = $result->{typeInfo}->{type};
 699         my $otype = $data{$arguments[$inc->{constructor_result}]->{type}}->{name};
 700
 701
 702         $name = $inc->{rename}->($name);
 703
 704         $desc .= "static " if $inc->{scope} eq 'static';
 705         $desc .= $otype;
 706         $desc .= " $name(";
 707
 708         for $m (@arguments) {
 709                 if (($inc->{constructor} && $index != $inc->{constructor_result})) {
 710                         $desc .= ", " if ($count++ > 0);
 711                         $desc .= $m->{typeInfo}->{type};
 712                         $desc .= " $m->{name}"
 713                 }
 714                 $index++;
 715         }
 716         if ($inc->{constructor}) {
 717                 $desc .= ", " if ($count++ > 0);
 718                 $desc .= "ResourceScope scope";
 719         }
 720         $desc .=") {\n ";
 721
 722         $desc .= "$result->{typeInfo}->{carrier} res\$value;\n" if ($rtype ne "void");
 723
 724         $desc .= " try ";
 725         $desc .= "(Frame frame = Memory.createFrame()) " if ($c->{resolveFrame});
 726         $desc .= "{\n";
 727         $desc .= "   Memory.HandleArray<$otype> res\$holder = Memory.HandleArray.createArray(1, frame, $otype\:\:create, scope);\n" if ($inc->{constructor});
 728         $desc .= "   res\$value = ($result->{typeInfo}->{carrier})" if ($rtype ne "void");
 729         $desc .= "   " if ($rtype eq "void");
 730
 731         $index = 0;
 732         $desc .= "$c->{name}\$FH.invokeExact(\n   ";
 733         for $m (@arguments) {
 734                 my $resolve = $m->{typeInfo}->{resolve};
 735
 736                 if ($inc->{constructor} && $index == $inc->{instance}) {
 737                         $desc .= ",\n    " if ($index++ > 0);
 738                         $desc .= "(Addressable)res\$holder.address()";
 739                 } elsif ($inc->{scope} ne 'static' && $index == $inc->{instance}) {
 740                         $desc .= ",\n    " if ($index++ > 0);
 741                         $desc .= "(Addressable)address()";
 742                 } else {
 743                         $desc .= ",\n    " if ($index++ > 0);
 744
 745                         if ($resolve) {
 746                                 $resolve =~ s/\$\{value\}/$m->{name}/g;
 747                                 $desc .= $resolve;
 748                         } else {
 749                                 $desc .= "$m->{name}";
 750                         }
 751                 }
 752         }
 753         $desc .= ");\n";
 754
 755         if ($rtype ne "void" && defined $inc->{success}) {
 756         #       my $create = $result->{typeInfo}->{create};
 757
 758         #       # ooh, templates could insert other arguments or values as well?
 759         #       $create =~ s/\$\{result\}/res\$value/;
 760         #       if ($inc->{scope} eq 'static') {
 761         #               $create =~ s/\$\{scope\}/ResourceScope.globalScope()/;
 762         #       } else {
 763         #               $create =~ s/\$\{scope\}/scope()/;
 764         #       }
 765
 766                 foreach $code (split /,/,$inc->{success}) {
 767                         $desc .= "   if (res\$value == $code) return res\$holder.getAtIndex(0);\n";
 768                 }
 769         } else {
 770                 $desc .= "   return res\$holder.getAtIndex(0);\n";
 771         }
 772         # throw Error()?
 773         $desc .= " } catch (Throwable t) { throw new RuntimeException(t); }\n";
 774
 775         # throw failures here based on res$value
 776         $desc .= " return null;\n";
 777
 778         $desc .="}";
 779
 780         #print "$desc\n";
 781         return $desc;
 782 }
 783
 784 sub formatFunction {
 785         my $c = shift;
 786         my $inc = shift;
 787         my @arguments = @{$c->{arguments}};
 788         my $result = $c->{result};
 789         my $desc;
 790         my $index = 0;
 791         my $count = 0;
 792         my $desc = "";
 793         my $name = $c->{name};
 794         my $rtype = $result->{typeInfo}->{type};
 795
 796         if ($inc->{constructor}) {
 797                 return formatConstructor($c, $inc);
 798         }
 799
 800         $name = $inc->{rename}->($name);
 801
 802         $desc .= "static " if $inc->{scope} eq 'static';
 803         $desc .= $rtype;
 804         $desc .= " $name(";
 805
 806         for $m (@arguments) {
 807                 if ($inc->{scope} eq 'static' || $index != $inc->{instance}) {
 808                         $desc .= ", " if ($count++ > 0);
 809                         $desc .= $m->{typeInfo}->{type};
 810                         $desc .= " $m->{name}"
 811                 }
 812                 $index++;
 813         }
 814         $desc .=") {\n ";
 815
 816         $desc .= "try ";
 817         $desc .= "(Frame frame = Memory.createFrame()) " if ($c->{resolveFrame});
 818         $desc .= "{\n";
 819         $desc .= "  $result->{typeInfo}->{carrier} res\$value = ($result->{typeInfo}->{carrier})" if ($rtype ne "void");
 820         $desc .= "  " if ($rtype eq "void");
 821
 822         $index = 0;
 823         $desc .= "$c->{name}\$FH.invokeExact(\n   ";
 824         for $m (@arguments) {
 825                 my $resolve = $m->{typeInfo}->{resolve};
 826
 827                 if ($inc->{scope} ne 'static' && $index == $inc->{instance}) {
 828                         $desc .= ",\n   " if ($index++ > 0);
 829                         $desc .= "(Addressable)address()";
 830                 } else {
 831                         $desc .= ",\n   " if ($index++ > 0);
 832
 833                         if ($resolve) {
 834                                 $resolve =~ s/\$\{value\}/$m->{name}/g;
 835                                 $desc .= $resolve;
 836                         } else {
 837                                 $desc .= "$m->{name}";
 838                         }
 839                 }
 840         }
 841         $desc .= ");\n";
 842
 843         if ($rtype ne "void") {
 844                 my $create = $result->{typeInfo}->{create};
 845
 846                 # ooh, templates could insert other arguments or values as well?
 847                 $create =~ s/\$\{result\}/res\$value/;
 848                 if ($inc->{scope} eq 'static') {
 849                         $create =~ s/\$\{scope\}/ResourceScope.globalScope()/;
 850                 } else {
 851                         $create =~ s/\$\{scope\}/scope()/;
 852                 }
 853
 854                 $desc .= "  return $create;\n";
 855         }
 856         # throw Error()?
 857         $desc .= " } catch (Throwable t) { throw new RuntimeException(t); }\n";
 858
 859         $desc .="}";
 860
 861         return $desc;
 862 }
 863
 864 # create an interface for function pointers
 865 # FiXME: this should be exportCallback to a file?
 866 sub formatCallback {
 867         my $c = shift;
 868         my $obj = shift;
 869         my @arguments = @{$c->{arguments}};
 870         my $result = $c->{result};
 871         my $desc;
 872         my $index = 0;
 873         my $desc;
 874         my $name = $c->{name};
 875
 876         #print "\nCall\n";
 877         #print Dumper($c);
 878
 879         my $rtype = $result->{typeInfo}->{type};
 880
 881         $desc  = "\@FunctionalInterface\n";
 882         $desc .= "public interface $name {\n";
 883
 884         # the public (functional) interface
 885         $index = 0;
 886         $desc .= " $result->{typeInfo}->{type} call(";
 887         for $m (@arguments) {
 888                 $desc .= ", " if ($index++ > 0);
 889                 $desc .= $m->{typeInfo}->{type};
 890                 $desc .= " $m->{name}"
 891         }
 892         $desc .= ");\n";
 893
 894         # the internal interface
 895         $index = 0;
 896         $desc .= " \@FunctionalInterface\n";
 897         $desc .= " interface Trampoline {\n  ";
 898         $desc .=  $result->{typeInfo}->{carrier};
 899         $desc .= " call(";
 900         for $m (@arguments) {
 901                 $desc .= ", " if ($index++ > 0);
 902                 $desc .= $m->{typeInfo}->{carrier};
 903                 $desc .= " $m->{name}"
 904         }
 905         $desc .= ");\n";
 906         $desc .= " }\n\n";
 907
 908         # native descriptor
 909         $desc .= " static FunctionDescriptor DESCRIPTOR() {\n";
 910         $desc .= "  return ";
 911         my $tmp = formatFunctionDescriptor($c);
 912         $tmp =~ s/^/  /mg;
 913         $tmp =~ s/^ *//;
 914         $desc .= $tmp;
 915         $desc .= ";\n }\n";
 916
 917         # Factory method for upcalls
 918         # TODO: optional?
 919         $desc .= " public static Memory.FunctionPointer<$name> upcall($name target, ResourceScope scope) {\n";
 920         $desc .= "  Trampoline trampoline = (";
 921         $index = 0;
 922         for $m (@arguments) {
 923                 $desc .= ", " if ($index++ > 0);
 924                 $desc .= "$m->{name}"
 925         }
 926         $desc .= ") -> {\n";
 927         #$desc .= "   try {\n";
 928         $desc .= "   ";
 929         $desc .= "return " if $rtype ne "void";
 930         $desc .= "target.call(\n    ";
 931         $index = 0;
 932         for $m (@arguments) {
 933                 my $create = $m->{typeInfo}->{create};
 934
 935                 $create =~ s/\$\{result\}/$m->{name}/g;
 936                 $create =~ s/\$\{scope\}/scope/g;
 937
 938                 $desc .= ",\n    " if ($index++ > 0);
 939                 $desc .= "$create";
 940         }
 941         $desc .= ");\n";
 942         #$desc .= "   } catch (Exception x) { }{\n";
 943         # FIXME: or null for address
 944         #$desc .= "   return 0;\n" if $rtype != "void";
 945         #$desc .= "   }\n";
 946         $desc .= "  };\n";
 947
 948         $desc .= "  return new Memory.FunctionPointer<>(\n";
 949         $desc .= "    Memory.upcall(\n";
 950         $desc .= "     trampoline,\n";
 951         $desc .= "     \"call\",\n";
 952         $desc .= "     \"$c->{signature}\",\n";
 953         $desc .= "     DESCRIPTOR(),\n";
 954         $desc .= "     scope),\n";
 955         $desc .= "    target);\n";
 956         $desc .= " }\n";
 957
 958         # downcalls
 959         $desc .= " public static Memory.FunctionPointer<$name> downcall(MemoryAddress addr, ResourceScope scope) {\n";
 960         $desc .= "  NativeSymbol symbol = NativeSymbol.ofAddress(\"$name\", addr, scope);\n";
 961         $desc .= "  MethodHandle $name\$FH = Memory.downcall(symbol, DESCRIPTOR());\n";
 962         $desc .= "  return new Memory.FunctionPointer<$name>(\n";
 963         $desc .= "   symbol,\n";
 964
 965         # HACK: this is basically the same as any function call, just patch in the changes for now
 966         $tmp = formatFunction($c, $obj);
 967
 968         $tmp =~ s/^(.*) ($name)\(/(/;
 969         $tmp =~ s/\) \{/) -> {/;
 970         $tmp =~ s/^/   /mg;
 971         $desc .= $tmp;
 972
 973         $desc .= "\n";
 974         $desc .= "  );\n";
 975         $desc .= " }\n";
 976         $desc .= "}\n";
 977
 978         # replace leading ' ' with '\t'
 979         $desc =~ s/(?:\G|^) /\t/mg;
 980
 981         return $desc;
 982 }
 983
 984 # some bitfield support stuff.
 985 # maximum size allowed for field holder based on start offset
 986 # offset
 987 sub fieldMaxHolder {
 988         my $offset = shift @_;
 989
 990         return 64 if ($offset & 63) == 0;
 991         return 32 if ($offset & 31) == 0;
 992         return 16 if ($offset & 15) == 0;
 993         return 8 if ($offset & 7) == 0;
 994         return 0;
 995 }
 996
 997 sub fieldLimit {
 998         my $size = shift @_;
 999
1000         return 64 if ($size > 32);
1001         return 32 if ($size > 16);
1002         return 16 if ($size > 8);
1003         return 8;
1004 }
1005
1006 # offset, size
1007 # returns @sizes required to hold them, based on alignment rules
1008 sub fieldHolders {
1009         my $offset = shift @_;
1010         my $bits = shift @_;
1011         my $end = $offset + $bits;
1012         my @sizes = ();
1013
1014         while ($offset < $end) {
1015                 my $limit = fieldLimit($bits);
1016                 my $max = fieldMaxHolder($offset);
1017                 my $step = ($limit < $max) ? $limit : $max;
1018
1019                 push @sizes, $step;
1020
1021                 $offset += $step;
1022                 $bits -= $step;
1023         }
1024
1025         return @sizes;
1026 }
1027
1028 sub formatLayout {
1029         my $s = shift @_;
1030         my @fields = @{$s->{fields}};
1031         my $index = 0;
1032         my $bitfieldIndex = 0;
1033         my $desc;
1034         my $last = 0;
1035         my $maxSize = 8;
1036
1037         $desc = "MemoryLayout.$s->{type}Layout(\n ";
1038
1039         for (my $i = 0; $i <= $#fields; $i++) {
1040                 my $f = $fields[$i];
1041
1042                 if ($f->{offset} > $last) {
1043                         $desc .= ",\n" if ($index++ > 0);
1044                         $desc .= ' MemoryLayout.paddingLayout('.($f->{offset} - $last).')';
1045                 }
1046
1047                 $maxSize = fieldLimit($f->{size}) if (fieldLimit($f->{size}) > $maxSize);
1048
1049                 if ($f->{ctype} eq 'bitfield') {
1050                         my $start = $f->{offset};
1051                         my $end = $f->{size} + $f->{offset};
1052                         my $j = $i + 1;
1053                         my $max = fieldMaxHolder($start);
1054
1055                         # breaks bitfields into char/short/int/long blocks
1056                         # TODO: need more info for mapping to get/settters
1057
1058                         #print "> $f->{name} $f->{size} @ $f->{offset}\n";
1059
1060                         while ($j <= $#fields && $fields[$j]->{ctype} eq "bitfield") {
1061                                 my $g = $fields[$j];
1062
1063                                 #print "> $g->{name} $g->{size} @ $g->{offset}\n";
1064
1065                                 if ($g->{offset} > $end || ($g->{offset} - $start >= $max)) {
1066                                         foreach $size (fieldHolders($start, $end - $start)) {
1067                                                 $desc .= ",\n " if ($index++ > 0);
1068                                                 $desc .= 'Memory.'.uc($intSizes{$size}).".withName(\"bitfield\$$bitfieldIndex\")";
1069                                                 $bitfieldIndex++;
1070                                         }
1071                                         $desc .= ",\n " if ($index++ > 0);
1072                                         $desc .= 'MemoryLayout.paddingLayout('.($g->{offset}-$end).')';
1073                                         $start = $g->{offset};
1074                                         $max = fieldMaxHolder($start);
1075                                 }
1076                                 $end = $g->{size} + $g->{offset};
1077                                 $j++;
1078                         }
1079
1080                         foreach $size (fieldHolders($start, $end - $start)) {
1081                                 $desc .= ",\n " if ($index++ > 0);
1082                                 $desc .= 'Memory.'.uc($intSizes{$size}).".withName(\"bitfield\$$bitfieldIndex\")";
1083                                 $bitfieldIndex++;
1084                         }
1085
1086
1087                         $i = $j-1;
1088                 } else {
1089                         $desc .= ",\n " if ($index++ > 0);
1090                         $desc .= formatTypeLayout($f, ".withName(\"$f->{name}\")");
1091                 }
1092
1093                 $last = $fields[$i]->{offset} + $fields[$i]->{size};
1094         }
1095
1096         if ($last < $s->{size}) {
1097                 $desc .= ",\n " if ($index++ > 0);
1098                 $desc .= 'MemoryLayout.paddingLayout('.($s->{size} - ${last}).')';
1099         }
1100
1101         $desc .= "\n)";
1102         $desc .= ".withBitAlignment($maxSize)";
1103
1104         return $desc;
1105 }
1106
1107 sub formatGetSet {
1108         my $s = shift;
1109         my $m = shift;
1110         my $rename = shift;
1111         my $access = shift;
1112         my $inc = shift;
1113         my $desc = "";
1114         my $info = $m->{typeInfo};
1115         my $Name = ucfirst($rename);
1116         my $tmp;
1117
1118         # info -> needsalloc?
1119
1120         # TODO: embedded arrays are quite different setup
1121
1122         if ($info->{byValue}) {
1123                 $tmp = $info->{create};
1124                 $tmp =~ s/\$\{result\}/segment/g;
1125                 $tmp =~ s/\$\{scope\}/scope()/g;
1126
1127                 $desc .= " public $info->{type} get$Name() {\n";
1128                 #$desc .= "  MemoryLayout.PathElement pe = MemoryLayout.PathElement.groupElement(\"$m->{name}\");\n";
1129                 #$desc .= "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteOffset(pe), LAYOUT.select(pe).byteSize());\n";
1130                 $desc .= "  MemorySegment segment = this.segment.asSlice($m->{name}\$byteOffset, $m->{name}\$byteSize);\n";
1131                 $desc .= "  return $tmp;\n";
1132                 $desc .= " }\n";
1133
1134                 if ($access =~ m/i/) {
1135                         $desc .= " public $info->{type} get$Name"."At(long index) {\n";
1136                         #$desc .= "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteSize() * index, LAYOUT.byteSize());\n";
1137                         #$desc .= "  MemoryLayout.PathElement pe = MemoryLayout.PathElement.groupElement(\"$m->{name}\");\n";
1138                         #$desc .= "  segment = this.segment.asSlice(LAYOUT.byteOffset(pe), LAYOUT.select(pe).byteSize());\n";
1139                         $desc .= "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteSize() * index + $m->{name}\$byteOffset, $m->{name}\$byteSize);\n";
1140                         $desc .= "  return $tmp;\n";
1141                         $desc .= " }\n";
1142                 }
1143         } elsif ($access =~ /r/) {
1144                 $tmp = $info->{create};
1145
1146                 $tmp =~ s/\$\{result\}/($info->{carrier})$m->{name}\$VH.get(segment)/g;
1147                 $tmp =~ s/\$\{scope\}/scope()/g;
1148                 # fixme: lookup type of array size? somewhere?  doesn't matter i think
1149                 $tmp =~ s/\${array_size}/(long)$inc->{array_size}\$VH.get(segment)/g;
1150
1151                 $desc .= " public $info->{type} get$Name() {\n";
1152                 $desc .= "  return $tmp;\n";
1153                 $desc .= " }\n";
1154
1155                 if ($access =~ m/i/) {
1156                         $desc .= " public $info->{type} get$Name"."At(long index) {\n";
1157                         $desc .= "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteSize() * index, LAYOUT.byteSize());\n";
1158                         $desc .= "  return $tmp;\n";
1159                         $desc .= " }\n";
1160                 }
1161         }
1162
1163         if ($access =~ m/w/ && !$info->{byValue}) {
1164                 $tmp = $info->{resolve};
1165                 $tmp =~ s/\$\{value\}/value/g;
1166
1167                 $desc .=  " public void set$Name($info->{type} value) {\n";
1168                 $desc .=  " try (Frame frame = Memory.createFrame()) {\n" if ($info->{resolveFrame});
1169                 $desc .=  "  $m->{name}\$VH.set(segment, $tmp);\n";
1170                 $desc .=  " }\n" if ($info->{resolveFrame});
1171                 $desc .=  " }\n";
1172
1173                 if ($access =~ m/i/) {
1174                         $desc .=  " public void set$Name"."At(long index, $info->{type} value) {\n";
1175                         $desc .=  " try (Frame frame = Memory.createFrame()) {\n" if ($info->{resolveFrame});
1176                         $desc .=  "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteSize() * index, LAYOUT.byteSize());\n";
1177                         $desc .=  "  $m->{name}\$VH.set(segment, $tmp);\n";
1178                         $desc .=  " }\n" if ($info->{resolveFrame});
1179                         $desc .=  " }\n";
1180                 }
1181         }
1182
1183         return $desc;
1184 }
1185
1186 sub exportStruct {
1187         my $f = shift;
1188         my $s = shift;
1189         my $obj = shift;
1190         my @fields = @{$s->{fields}};
1191         my $isHandle = $s->{size} == 0;
1192         my $doArray = $obj->{access} =~ m/i/;
1193         #my @functions = @{shift @_};
1194
1195         print $f "package $package;\n" if $package;
1196
1197         print $f "import jdk.incubator.foreign.*;\n";
1198         print $f "import java.lang.invoke.*;\n";
1199
1200         print $f "public class $s->{name} implements Memory.Addressable {\n";
1201
1202         # TODO: parameterise and use typeInfo data.
1203         if (!$isHandle) {
1204                 print $f " MemorySegment segment;\n";
1205                 # constructors
1206                 print $f " private $s->{name}(MemorySegment segment) { this.segment = segment; }\n";
1207                 print $f " public static $s->{name} create(MemorySegment segment) { return new $s->{name}(segment); }\n";
1208                 print $f " public static $s->{name} create(MemoryAddress address, ResourceScope scope) {\n";
1209                 print $f "  return MemoryAddress.NULL != address ? create(MemorySegment.ofAddress(address, LAYOUT.byteSize(), scope)) : null;\n";
1210                 print $f " }\n";
1211                 if ($doArray) {
1212                         print $f " public static $s->{name} createArray(MemoryAddress address, long size, ResourceScope scope) {\n";
1213                         print $f "  return MemoryAddress.NULL != address ? create(MemorySegment.ofAddress(address, size * LAYOUT.byteSize(), scope)) : null;\n";
1214                         print $f " }\n";
1215                 }
1216                 print $f " public static $s->{name} create(Frame frame) { return create(frame.allocate(LAYOUT)); }\n";
1217                 print $f " public static $s->{name} create(ResourceScope scope) { return create(MemorySegment.allocateNative(LAYOUT, scope)); }\n";
1218                 print $f " public MemoryAddress address() { return segment.address(); }\n";
1219                 print $f " public ResourceScope scope() { return segment.scope(); }\n";
1220         } else {
1221                 # not sure if handles need scopes
1222                 print $f " MemoryAddress address;\n";
1223                 print $f " ResourceScope scope;\n";
1224                 # constructors
1225                 print $f " private $s->{name}(MemoryAddress address, ResourceScope scope) { this.address = address; this.scope = scope;}\n";
1226                 print $f " public static $s->{name} create(MemoryAddress address, ResourceScope scope) { return MemoryAddress.NULL != address ? new $s->{name}(address, scope) : null; }\n";
1227                 print $f " public MemoryAddress address() { return address; }\n";
1228                 print $f " public ResourceScope scope() { return scope; }\n";
1229         }
1230
1231         my %seen;
1232
1233         # Any defines
1234         foreach $inc (grep { $_->{mode} eq 'define' } @{$obj->{items}}) {
1235                 my $def = $data{$inc->{match}};
1236
1237                 die ("unknown define $inc->{match} in $s->{name}\n") if !$def;
1238
1239                 delete $toDump->{$inc->{match}};
1240
1241                 foreach $m (@{$def->{values}}) {
1242                         print $f " /**\n ($m->{comment}) */\n" if ($m->{comment});
1243                         print $f " public static final $defineType{$m->{type}} $m->{name} = $definePrefix{$m->{type}}$m->{value}$defineSuffix{$m->{type}};\n";
1244                 }
1245         }
1246
1247         # TODO: any enums we want to include here I suppose?
1248
1249         # Accessors
1250         foreach $m (@fields) {
1251                 my $access = $obj->{access};
1252                 my $rename = $obj->{'field:rename'};
1253                 my $matches = 0;
1254                 my $matchinc;
1255
1256                 # check for match
1257                 foreach $inc (grep { $_->{mode} eq 'field' } @{$obj->{items}}) {
1258                         $matches = $m->{name} =~ m/$inc->{regex}/;
1259
1260                         if ($matches) {
1261                                 $access = $inc->{access} if $inc->{access};
1262                                 $rename = $inc->{rename} if $inc->{rename} != $renameTable{'identity'};
1263                                 $matchinc = $inc;
1264                                 last;
1265                         }
1266                 }
1267
1268                 my $output = $matches || ($obj->{default} eq 'all');
1269
1270                 if ($output) {
1271                         my $name = $rename ? $rename->($m->{name}) : $m->{name};
1272
1273                         print $f formatGetSet($s, $m, $name, $access, $matchinc);
1274                 }
1275         }
1276
1277         # Functions
1278         foreach $inc (grep { $_->{mode} eq 'func' } @{$obj->{items}}) {
1279                 my @list;
1280
1281                 print "$obj->{name} match $inc->{match} regex $inc->{regex}\n" if $verbose;
1282
1283                 if ($data{$inc->{match}}) {
1284                         push @list, $data{$inc->{match}};
1285                 } else {
1286                         @list = grep { $_->{name} =~ m/$inc->{regex}/ } values %data;
1287                 }
1288
1289                 foreach $c (@list) {
1290                         my $tmp;
1291
1292                         next if $seen{$c->{name}}++;
1293
1294                         print $f " static final MethodHandle $c->{name}\$FH = Memory.downcall(\"$c->{name}\",\n";
1295                         $tmp = formatFunctionDescriptor($c);
1296                         print $f "$tmp);\n";
1297
1298                         $tmp = formatFunction($c, $inc);
1299                         print $f 'public '.$tmp."\n\n";
1300                 }
1301         }
1302
1303         # layout and varhandles
1304         if ($#fields >= 0) {
1305                 print $f "static final GroupLayout LAYOUT = ".formatLayout($s).";\n";
1306
1307                 foreach $m (@fields) {
1308                         print $f " // type='$m->{type}' deref='$m->{deref}'  info->type ='$m->{typeInfo}->{type}'\n";
1309                         if ($m->{typeInfo}->{byValue}) {
1310                                 print $f " static final long $m->{name}\$byteOffset = "
1311                                         ." LAYOUT.byteOffset(MemoryLayout.PathElement.groupElement(\"$m->{name}\"));\n";
1312                                 print $f " static final long $m->{name}\$byteSize = "
1313                                         ."LAYOUT.select(MemoryLayout.PathElement.groupElement(\"$m->{name}\")).byteSize();\n";
1314                         } else {
1315                                 print $f " static final VarHandle $m->{name}\$VH = "
1316                                         ."LAYOUT.varHandle(MemoryLayout.PathElement.groupElement(\"$m->{name}\"));\n";
1317                         }
1318                 }
1319         }
1320
1321         # verification?
1322         if (!$isHandle) {
1323                 print $f <<END;
1324                 static void check\$offset(String name, long bitoffset) {
1325                         long byteoffset = bitoffset/8;
1326                         long offset = LAYOUT.byteOffset(MemoryLayout.PathElement.groupElement(name));
1327                         if (offset != byteoffset)
1328                                 throw new AssertionError(String.format("%s.offset %d != %d", name, byteoffset, offset), null);
1329                 }
1330                 {
1331 END
1332                 foreach $m (@fields) {
1333                         print $f "check\$offset(\"$m->{name}\", $m->{offset});\n";
1334                 }
1335 my $bytes = $s->{size}/8;
1336         print $f <<END;
1337                 if (LAYOUT.byteSize() != $bytes)
1338                         throw new AssertionError(String.format("$s->{name}.sizeof = %d != $bytes", LAYOUT.byteSize()), null);
1339         }
1340 END
1341         }
1342         print $f "}\n";
1343 }
1344
1345 # file,enum
1346 sub exportEnum {
1347         my $f = shift;
1348         my $s = shift;
1349         my @values = @{$s->{values}};
1350         my $jtype = $typeSizes{$s->{value_type}};
1351         my $prefix = $definePrefix{$s->{value_type}};
1352         my $suffix = $definePrefix{$s->{value_type}};
1353         print $f "package $package;\n" if $package;
1354
1355         print $f "public interface $s->{name} {\n";
1356
1357         foreach $v (@values) {
1358                 print $f " public static final $jtype $v->{name} = $prefix$v->{value}$suffix;\n";
1359         }
1360
1361         print $f "}\n";
1362 }
1363
1364 # copies a skeleton file and patches it to the target package
1365 sub copySkeletonFile {
1366         my $src = shift @_;
1367         my $dst = shift @_;
1368
1369         open (my $d, ">", $dst) || die ("Cannot open '$src' for writing");
1370         open (my $s, "<", $src) || die ("Cannot open '$dst' for reading");
1371
1372         while (<$s>) {
1373                 s/^package .*;/package $package;/;
1374                 print $d $_;
1375         }
1376
1377         close $s;
1378         close $d;
1379
1380 }
1381
1382 # init output
1383 $outputPath = $package;
1384 $outputPath =~ s@\.@/@g;
1385 $outputPath = "$output/$outputPath";
1386
1387 make_path($outputPath);
1388
1389 copySkeletonFile("$scriptPath/template/Memory.java", "$outputPath/Memory.java");
1390 copySkeletonFile("$scriptPath/template/Frame.java", "$outputPath/Frame.java");
1391
1392 sub nameToPath {
1393         my $dir = shift @_;
1394         my $name = shift @_;
1395
1396         $name =~ s@\.@/@g;
1397         $name = "$dir/$name.java";
1398         return $name;
1399 }
1400
1401 #print "api\n";
1402 #print Dumper($api);
1403
1404 # Dump struct type
1405 foreach $obj ( @{$api->{struct}} ) {
1406         my @list;
1407
1408         next if $obj->{name} eq '<default>';
1409
1410         if ($obj->{name} =~ m@/(.*)/@) {
1411                 my $rx = qr/struct:$1/;
1412
1413                 @list = map { s/struct://; $_ } grep { $_ =~ m/$rx/ } keys %data;
1414         } else {
1415                 push @list, $obj->{name};
1416         }
1417
1418         foreach $name (@list) {
1419                 my $path = nameToPath($output, "$package.$name");
1420                 my $s = $data{"struct:$name"};
1421
1422                 #print Dumper($obj);
1423
1424                 delete $toDump->{"struct:$name"};
1425
1426                 if ($s) {
1427                         open (my $f, ">", $path) || die ("Cannot open '$path' for writing");
1428
1429                         exportStruct($f, $s, $obj);
1430
1431                         close $f;
1432                 } else {
1433                         print "No struct $name\n";
1434                 }
1435         }
1436 }
1437
1438 # Dump library type
1439 foreach $lib ( @{$api->{library}} ) {
1440         my $path = nameToPath($output, "$package.$lib->{name}");
1441
1442         open (my $f, ">", $path) || die ("Cannot open '$path' for writing");
1443
1444         print $f "package $package;\n";
1445         print $f "import jdk.incubator.foreign.*;\n";
1446         print $f "import java.lang.invoke.*;\n";
1447
1448         print $f "public class $lib->{name} {\n";
1449
1450         print $f " static ResourceScope scope() { return ResourceScope.globalScope(); }\n";
1451
1452         # scan for matches
1453         foreach $inc (@{$lib->{items}}) {
1454                 if ($inc->{mode} eq 'func') {
1455                         my @list = grep { $_->{type} eq $inc->{mode} && $_->{name} =~ m/$inc->{regex}/ } values %data;
1456                         foreach $c (@list) {
1457                                 my $tmp;
1458
1459                                 print $f " static final MethodHandle $c->{name}\$FH = Memory.downcall(\"$c->{name}\",\n";
1460                                 $tmp = formatFunctionDescriptor($c);
1461                                 print $f $tmp.");\n";
1462
1463                                 $tmp = formatFunction($c, $inc);
1464                                 print $f "public ";
1465                                 print $f $tmp."\n\n";
1466                         }
1467                 } elsif ($inc->{mode} eq 'define') {
1468                         my @list = grep { $_->{type} eq $inc->{mode} && $_->{name} =~ m/$inc->{regex}/ } values %data;
1469                         foreach $c (@list) {
1470                                 delete $toDump->{"define:$c->{name}"};
1471                                 foreach $m (@{$c->{fields}}) {
1472                                         print $f " /**\n ($m->{comment}) */\n" if ($m->{comment});
1473                                         print $f " public static final $defineType{$m->{type}} $m->{name} = $definePrefix{$m->{type}}$m->{value}$defineSuffix{$m->{type}};\n";
1474                                 }
1475                         }
1476                 }
1477         }
1478
1479         print $f "}\n";
1480
1481         close $f;
1482 }
1483
1484 print "remaining dependent types\n";
1485 foreach $k (sort grep { !m/func:/ } keys %{$toDump}) {
1486         print " $k\n";
1487 }
1488 print "\n";
1489
1490 # Calls referenced
1491 foreach $k (sort keys %{$toDump}) {
1492         next if (!($k =~ m/call:(.+)/));
1493
1494         my $name = $1;
1495         my $c = $data{$k};
1496         my $obj = findAPIObject($api, 'call', $name);
1497
1498         my $path = nameToPath($output, "$package.$name");
1499
1500         open (my $f, ">", $path) || die ("Cannot open '$path' for writing");
1501
1502         print $f "package $package;\n";
1503         print $f "import jdk.incubator.foreign.*;\n";
1504         print $f "import java.lang.invoke.*;\n";
1505
1506         print $f formatCallback($c, $obj);
1507
1508         close $f;
1509 }
1510
1511 # any struct remaining in toDump (but not in api)
1512 # FIXME: how to lookup obj?
1513 foreach $k (sort keys %{$toDump}) {
1514         if ($k =~ m/struct:(.*)/) {
1515                 my $name = $1;
1516                 my $s = $data{$k};
1517                 my $path = nameToPath($output, "$package.$name");
1518
1519                 die("missing struct $name") if !$s;
1520
1521                 delete $toDump->{$k};
1522
1523                 my $obj = findAPIObject($api, 'struct', $name);
1524
1525                 open (my $f, ">", $path) || die ("Cannot open '$path' for writing");
1526                 exportStruct($f, $s, $obj);
1527                 close $f;
1528         }
1529 }
1530
1531 # Dump enum types used by everything and not dumped elsehwere
1532 foreach $k (sort keys %{$toDump}) {
1533         if ($k =~ m/enum:(.*)/) {
1534                 my $name = $1;
1535                 my $s = $data{$k};
1536                 my $path = nameToPath($output, "$package.$name");
1537
1538                 die("missing enum $name") if !$s;
1539
1540                 open(my $f, ">", $path) || die ("Cannot open '$path' for writing");
1541
1542                 exportEnum($f, $s);
1543
1544                 close $f;
1545         }
1546 }
1547
1548 # Dump define types not dumped elsehwere
1549 foreach $k (sort keys %{$toDump}) {
1550         if ($k =~ m/define:(.*)/) {
1551                 my $name = $1;
1552                 my $s = $data{$k};
1553                 my $path = nameToPath($output, "$package.$name");
1554
1555                 die("missing define $name") if !$s;
1556
1557                 open(my $f, ">", $path) || die ("Cannot open '$path' for writing");
1558
1559                 print $f "package $package;\n" if $package;
1560                 print $f "public interface $s->{name} {\n";
1561
1562                 foreach $m (@{$s->{values}}) {
1563                         # some parsing problem here
1564                         next if !$m->{value};
1565
1566                         print $f " /**\n ($m->{comment}) */\n" if ($m->{comment});
1567                         print $f " public static final $defineType{$m->{type}} $m->{name} = $definePrefix{$m->{type}}$m->{value}$defineSuffix{$m->{type}};\n";
1568                 }
1569
1570                 print $f "}\n";
1571
1572                 close $f;
1573         }
1574 }
1575
1576 # and we're done
1577 exit 0;
1578
1579 sub loadControlFile {
1580         my $path = shift @_;
1581         my %def = ();
1582         my $target;
1583
1584         open (my $d,"<",$path);
1585
1586         while (<$d>) {
1587                 next if /\s*\#/;
1588
1589                 chop;
1590
1591                 if ($target) {
1592                         if (m/\s*\}\s*$/) {
1593                                 undef $target;
1594                         } elsif (/^\s*(\S+)\s*(.*)/) {
1595                                 my @options = split(/\s+/,$2);
1596                                 push @{$target->{items}}, {
1597                                         match => $1,
1598                                         options => \@options
1599                                 };
1600                         }
1601                 } elsif (/^(\w+)\s+(\S*)\s*(.*)\s+\{/) {
1602                         my @options = split(/\s+/,$3);
1603
1604                         $target = {
1605                                 type => $1,
1606                                 name => $2,
1607                                 options => \@options,
1608                                 items => []
1609                         };
1610                         push @{$def{$1}}, $target;
1611                 } elsif (/\S/) {
1612                         die("invalid line: %_");
1613                 }
1614         }
1615
1616         close $d;
1617
1618         return \%def;
1619 }