Remove some internal dumps.
[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
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 }