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