Updated for openjdk-19-internal
[panamaz] / src / generate-native
1 #!/usr/bin/perl
2
3 # -*- Mode:perl; perl-indent-level:4;tab-width:4; -*-
4
5 # TODO: get/set should take a typed field for struct/union *
6 # TODO: a flag for func_name to funcName option
7
8 use Data::Dumper;
9 use File::Basename;
10 use File::Path qw(make_path);
11
12 $scriptPath = dirname(__FILE__);
13
14 $package = "";
15 $output = "bin";
16 $verbose = 0;
17
18 # usage
19 #  -t package    target package
20 #  -d directory  output root
21 #  -v            verbose
22
23 my %typeSizes = (
24         i8 => 'byte', u8 => 'byte',
25         i16 => 'short', u16 => 'short',
26         i32 => 'int', u32 => 'int',
27         i64 => 'long', u64 => 'long',
28         f32 => 'float',
29         f64 => 'double',
30         );
31
32 my %intSizes = ( 8 => 'byte', 16 => 'short', 32 => 'int', 64 => 'long' );
33 my %typePrimitive = (
34         "byte" => 8,
35         "short" => 16,
36         "int" => 32,
37         "long" => 64,
38         "float" => 32,
39         "double" => 64,
40         );
41
42 my %typeSignature = (
43         "byte" => "B",
44         "short" => "S",
45         "int" => "I",
46         "long" => "J",
47         "float" => "F",
48         "double" => "D",
49         "MemorySegment" => "Ljdk/incubator/foreign/MemorySegment;",
50         "MemoryAddress" => "Ljdk/incubator/foreign/MemoryAddress;",
51         );
52
53 while (@ARGV) {
54         my $cmd = shift(@ARGV);
55
56         if ($cmd eq "-t") {
57                 $package = shift(@ARGV);
58     } elsif ($cmd eq "-d") {
59                 $output = shift(@ARGV);
60     } elsif ($cmd eq "-v") {
61                 $verbose++;
62         } else {
63                 $meta = $cmd;
64         }
65 }
66
67 # load in interface file
68 do $meta;
69
70 analyseAndFixTypes();
71
72 if ($verbose) {
73         print "Using:n";
74         print Dumper(\%data);
75 }
76
77 # anonymous structs
78 #  the exporter doesn't output anonymous structs as they might
79 #  just be forward references.  this fills in any missing types.
80 # anonymouse calls
81 #  anonymous functions are referenced by signature, convert any to an identifier
82 # typeInfo
83 #  setup typeInfo for all type references - memebers, fields, return values
84 sub analyseAndFixTypes {
85         my @replace = ();
86
87         # pass 1, fix call definition names and keys
88         foreach $old (keys %data) {
89                 if ($old =~ m/^call:/) {
90                         push @replace, $old;
91                 }
92         }
93         foreach $old (@replace) {
94                 my $new = $old;
95                 my $c;
96
97                 $new =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
98                 $data{$new} = $c = delete $data{$old};
99                 $c->{name} =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
100         }
101
102         # pass 2 add typeinfo and anonymous types, fix call types
103         foreach $n (keys %data) {
104                 my $s = $data{$n};
105                 my @list;
106
107
108                 if ($s->{type} =~ m/struct|union/) {
109                         @list = @{$s->{fields}};
110                 } elsif ($s->{type} =~ m/func|call/) {
111                         @list = @{$s->{arguments}};
112                         push @list, $s->{result};
113                 }
114
115                 foreach $a (@list) {
116                         if ($a->{type} =~ m/(struct|union):(.*)/ && !defined($data{$a->{type}})) {
117                                 print "Add anonymous $1 $2\n";
118                                 $data{$a->{type}} = {
119                                         name => $2,
120                                         type => $1,
121                                         size => 0
122                                 };
123                         }
124
125                         if ($a->{type} =~ m/^call:/) {
126                                 $a->{type} =~ s/(.*)\((.*)\)(.*)/$1Call_$2_$3/;
127                         }
128
129                         # must be last
130                         $a->{typeInfo} = queryTypeInfo($a);
131                 }
132         }
133
134         # pass 3 create java signatures
135         foreach $n (keys %data) {
136                 my $s = $data{$n};
137
138                 if ($s->{type} =~ m/^(call|func)$/) {
139                         $s->{signature} = formatSignature($s);
140                 }
141         }
142 }
143
144 sub isVoid {
145         my $m = shift @_;
146
147         return $m->{type} eq 'void' && !$m->{deref};
148 }
149
150 # format a single layout type item for non-bitfield types
151 # type - type record that contains type and deref
152 # withName - '.withName()' - empty, or really any other MemoryLayout adjustment functions.
153 sub formatTypeLayout {
154         my $m = shift @_;
155         my $withName = shift @_;
156         my $desc = "";
157
158         if ($m->{deref} =~ m/^(u64|u32):/) {
159                 $desc .= "Memory.POINTER$withName";
160         } elsif ($m->{type} =~ m/^([iuf]\d+)$/) {
161                 if ($m->{deref} =~ m/\[(\d*).*\]/) {
162                         $desc .= "MemoryLayout.sequenceLayout($1, Memory.".uc($typeSizes{$m->{type}}).")$withName";
163                 } else {
164                         $desc .= 'Memory.'.uc($typeSizes{$m->{type}})."$withName";
165                 }
166         } elsif ($m->{type} =~ m/^(struct|union):(.*)/) {
167                 my $type = $2;
168                 if ($m->{deref} =~ m/\[(\d*).*\]/) {
169                         $desc .= "MemoryLayout.sequenceLayout($1, $type.LAYOUT)$withName";
170                 } else {
171                         $desc .= "$type.LAYOUT$withName";
172                 }
173         } else {
174                 print Dumper($m);
175                 die ("unknown type");
176         }
177
178         return $desc;
179 }
180
181 sub formatFunctionDescriptor {
182         my $c = shift @_;
183         my @arguments = @{$c->{arguments}};
184         my $result = $c->{result};
185         my $desc;
186         my $index = 0;
187
188         if (!isVoid($result)) {
189                 $desc = "FunctionDescriptor.of(\n ";
190                 $desc .= formatTypeLayout($result);
191                 $index = 1;
192         } else {
193                 $desc = "FunctionDescriptor.ofVoid(\n ";
194         }
195
196         foreach $m (@arguments) {
197                 $desc .= ",\n " if ($index++ > 0);
198                 $desc .= formatTypeLayout($m, ".withName(\"$m->{name}\")");
199         }
200
201         $desc .= "\n)";
202
203         return $desc;
204 }
205
206 sub formatSignature {
207         my $c = shift @_;
208         my @arguments = @{$c->{arguments}};
209         my $desc = '(';
210
211         foreach $m (@arguments) {
212                 $desc .= $typeSignature{$m->{typeInfo}->{carrier}};
213         }
214         $desc .= ')';
215
216         if ($c->{result}->{typeInfo}->{type} ne 'void') {
217                 $desc .= $typeSignature{$c->{result}->{typeInfo}->{carrier}};
218         } else {
219                 $desc .= 'V';
220         }
221
222         return $desc;
223 }
224
225 sub queryTypeInfo {
226         my $m = shift @_;
227         my $info = {};
228
229         # default for everything not specifically handled
230         $info->{carrier} = "MemoryAddress";
231         $info->{resolve} = "(Addressable)Memory.address(\${value})";
232
233         if ($m->{deref} =~ m/^(u64:|u32:)\(/) {
234                 # This is a function pointer, type must be type = 'call:.*'
235                 if ($m->{type} =~ m/^call:(.*)/) {
236                         $info->{type} = "Memory.FunctionPointer<$1>";
237                         $info->{create} = "$1.downcall(\${result}, scope())";
238                 } else {
239                         die();
240                 }
241         } elsif ($m->{type} =~ m/^([iuf]\d+)$/) {
242                 if ($m->{deref} =~ m/\[(\d*).*\]/) {
243                         $info->{byValue} = 1;
244                         $info->{type} = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
245                         $info->{create} = $info->{type}.".create(\${result})";
246                 } elsif ($m->{deref} =~ m/^(u64:u64:|u32:u32:)/) {
247                         $info->{type} = "Memory.PointerArray";
248                         $info->{create} = $info->{type}.".create(\${result})";
249                 } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
250                         $info->{type} = "Memory.".ucfirst($typeSizes{$m->{type}})."Array";
251                         $info->{create} = $info->{type}.".create(\${result})";
252                 } else {
253                         $info->{type} = $typeSizes{$m->{type}};
254                         $info->{carrier} = $typeSizes{$m->{type}};
255                         $info->{resolve} = "($info->{type})(\${value})";
256                         $info->{create} = "\${result}";
257                 }
258         } elsif ($m->{type} =~ m/^(struct|union):(.*)/) {
259                 my $type = $2;
260                 if ($m->{deref} =~ m/\[(\d*).*\]/) {
261                         $info->{type} = $type;
262                         $info->{create} = $info->{type}.".createArray($1, \${result}, scope())";
263                 } elsif ($m->{deref} =~ m/^(u64:u64:|u32:u32:)/) {
264                         $info->{type} = "Memory.PointerArray";
265                         $info->{create} = $info->{type}.".create(\${result})";
266                 } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
267                         $info->{type} = $type;
268                         $info->{create} = $info->{type}.".create(\${result}, scope())";
269                 } else {
270                         $info->{type} = $type;
271                         $info->{create} = $info->{type}.".create(\${result})";
272                 }
273         } elsif ($m->{type} eq "void") {
274                 if ($m->{deref} =~ m/^(u64:u64:|u32:u32:)/) {
275                         $info->{type} = "Memory.PointerArray";
276                         $info->{create} = $info->{type}.".create(\${result})";
277                 } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
278                         $info->{type} = "MemoryAddress";
279                         $info->{create} = "\${result}";
280                         $info->{resolve} = "(Addressable)\${value}";
281                 } else {
282                         $info->{type} = "void";
283                         $info->{carrier} = "void";
284                         delete $info->{resolve};
285                 }
286         } else {
287                 print Dumper($m);
288                 die ("unknown type");
289         }
290
291         return $info;
292 }
293
294 sub formatFunction {
295         my $c = shift @_;
296         my @arguments = @{$c->{arguments}};
297         my $result = $c->{result};
298         my $desc;
299         my $index = 0;
300         my $desc;
301         my $name = $c->{name};
302
303         my $rtype = $result->{typeInfo}->{type};
304
305         #print Dumper($c);
306
307         $desc = $rtype;
308         $desc .= " $name(";
309
310         for $m (@arguments) {
311                 $desc .= ", " if ($index++ > 0);
312                 $desc .= $m->{typeInfo}->{type};
313                 $desc .= " $m->{name}"
314         }
315         $desc .=") {\n ";
316         $index = 0;
317
318         $desc .= "try {\n";
319         $desc .= "  $result->{typeInfo}->{carrier} res\$value = ($result->{typeInfo}->{carrier})" if ($rtype ne "void");
320         $desc .= "  " if ($rtype eq "void");
321
322         $desc .= "$name\$FH.invokeExact(\n   ";
323         for $m (@arguments) {
324                 my $resolve = $m->{typeInfo}->{resolve};
325
326                 $desc .= ",\n   " if ($index++ > 0);
327
328                 if ($resolve) {
329                         $resolve =~ s/\$\{value\}/$m->{name}/g;
330                         $desc .= $resolve;
331                 } else {
332                         $desc .= "$m->{name}"
333                 }
334         }
335         $desc .= ");\n";
336
337         if ($rtype ne "void") {
338                 my $create = $result->{typeInfo}->{create};
339
340                 # ooh, templates could insert other arguments or values as well?
341                 $create =~ s/\${result\}/res\$value/;
342
343                 $desc .= "  return $create;\n";
344         }
345         # throw Error()?
346         $desc .= " } catch (Throwable t) { throw new RuntimeException(t); }\n";
347
348         $desc .="}";
349
350         return $desc;
351 }
352
353 # create an interface for function pointers
354 # FiXME: this should be exportCallback to a file
355 sub formatCallback {
356         my $c = shift @_;
357         my @arguments = @{$c->{arguments}};
358         my $result = $c->{result};
359         my $desc;
360         my $index = 0;
361         my $desc;
362         my $name = $c->{name};
363
364         #print "\nCall\n";
365         #print Dumper($c);
366
367         my $rtype = $result->{typeInfo}->{type};
368
369         $desc  = "\@FunctionalInterface\n";
370         $desc .= "public interface $name {\n";
371
372         # the public (functional) interface
373         $index = 0;
374         $desc .= " $result->{typeInfo}->{type} call(";
375         for $m (@arguments) {
376                 $desc .= ", " if ($index++ > 0);
377                 $desc .= $m->{typeInfo}->{type};
378                 $desc .= " $m->{name}"
379         }
380         $desc .= ");\n";
381
382         # the internal interface
383         $index = 0;
384         $desc .= " \@FunctionalInterface\n";
385         $desc .= " interface Trampoline {\n  ";
386         $desc .=  $result->{typeInfo}->{carrier};
387         $desc .= " call(";
388         for $m (@arguments) {
389                 $desc .= ", " if ($index++ > 0);
390                 $desc .= $m->{typeInfo}->{carrier};
391                 $desc .= " $m->{name}"
392         }
393         $desc .= ");\n";
394         $desc .= " }\n\n";
395
396         # native descriptor
397         $desc .= " static FunctionDescriptor DESCRIPTOR() {\n";
398         $desc .= "  return ";
399         my $tmp = formatFunctionDescriptor($c);
400         $tmp =~ s/^/  /mg;
401         $tmp =~ s/^ *//;
402         $desc .= $tmp;
403         $desc .= ";\n }\n";
404
405         # Factory method for upcalls
406         # TODO: optional?
407         $desc .= " public static Memory.FunctionPointer<$name> upcall($name target, ResourceScope scope) {\n";
408         $desc .= "  Trampoline trampoline = (";
409         $index = 0;
410         for $m (@arguments) {
411                 $desc .= ", " if ($index++ > 0);
412                 $desc .= "$m->{name}"
413         }
414         $desc .= ") -> {\n";
415         #$desc .= "   try {\n";
416         $desc .= "   ";
417         $desc .= "return " if $rtype ne "void";
418         $desc .= "target.call(\n    ";
419         $index = 0;
420         for $m (@arguments) {
421                 my $create = $m->{typeInfo}->{create};
422
423                 $create =~ s/\$\{result\}/$m->{name}/g;
424
425                 $desc .= ",\n    " if ($index++ > 0);
426                 $desc .= "$create";
427         }
428         $desc .= ");\n";
429         #$desc .= "   } catch (Exception x) { }{\n";
430         # FIXME: or null for address
431         #$desc .= "   return 0;\n" if $rtype != "void";
432         #$desc .= "   }\n";
433         $desc .= "  };\n";
434
435         $desc .= "  return new Memory.FunctionPointer<>(\n";
436         $desc .= "    Memory.upcall(\n";
437         $desc .= "     trampoline,\n";
438         $desc .= "     \"call\",\n";
439         $desc .= "     \"$c->{signature}\",\n";
440         $desc .= "     DESCRIPTOR(),\n";
441         $desc .= "     scope),\n";
442         $desc .= "    target);\n";
443         $desc .= " }\n";
444
445         # downcalls
446         $desc .= " public static Memory.FunctionPointer<$name> downcall(MemoryAddress addr, ResourceScope scope) {\n";
447         $desc .= "  NativeSymbol symbol = NativeSymbol.ofAddress(\"$name\", addr, scope);\n";
448         $desc .= "  MethodHandle $name\$FH = Memory.downcall(symbol, DESCRIPTOR());\n";
449         $desc .= "  return new Memory.FunctionPointer<$name>(\n";
450         $desc .= "   symbol,\n";
451
452         # HACK: this is basically the same as any function call, just patch in the changes for now
453         $tmp = formatFunction($c);
454
455         $tmp =~ s/^(.*) ($name)\(/(/;
456         $tmp =~ s/\) \{/) -> {/;
457         $tmp =~ s/^/   /mg;
458         $desc .= $tmp;
459         $desc .= "\n";
460         $desc .= "  );\n";
461         $desc .= " }\n";
462         $desc .= "}\n";
463
464         # replace leading ' ' with '\t'
465         $desc =~ s/(?:\G|^) /\t/mg;
466
467         return $desc;
468 }
469
470 # some bitfield support stuff.
471 # maximum size allowed for field holder based on start offset
472 # offset
473 sub fieldMaxHolder {
474         my $offset = shift @_;
475
476         return 64 if ($offset & 63) == 0;
477         return 32 if ($offset & 31) == 0;
478         return 16 if ($offset & 15) == 0;
479         return 8 if ($offset & 7) == 0;
480         return 0;
481 }
482
483 sub fieldLimit {
484         my $size = shift @_;
485
486         return 64 if ($size > 32);
487         return 32 if ($size > 16);
488         return 16 if ($size > 8);
489         return 8;
490 }
491
492 # offset, size
493 # returns @sizes required to hold them, based on alignment rules
494 sub fieldHolders {
495         my $offset = shift @_;
496         my $bits = shift @_;
497         my $end = $offset + $bits;
498         my @sizes = ();
499
500         while ($offset < $end) {
501                 my $limit = fieldLimit($bits);
502                 my $max = fieldMaxHolder($offset);
503                 my $step = ($limit < $max) ? $limit : $max;
504
505                 push @sizes, $step;
506
507                 $offset += $step;
508                 $bits -= $step;
509         }
510
511         return @sizes;
512 }
513
514 sub formatLayout {
515         my $s = shift @_;
516         my @fields = @{$s->{fields}};
517         my $index = 0;
518         my $bitfieldIndex = 0;
519         my $desc;
520         my $last = 0;
521         my $maxSize = 8;
522
523         $desc = "MemoryLayout.$s->{type}Layout(\n ";
524
525         for (my $i = 0; $i <= $#fields; $i++) {
526                 my $f = $fields[$i];
527
528                 if ($f->{offset} > $last) {
529                         $desc .= ",\n" if ($index++ > 0);
530                         $desc .= ' MemoryLayout.paddingLayout('.($f->{offset} - $last).')';
531                 }
532
533                 $maxSize = fieldLimit($f->{size}) if (fieldLimit($f->{size}) > $maxSize);
534
535                 if ($f->{ctype} eq 'bitfield') {
536                         my $start = $f->{offset};
537                         my $end = $f->{size} + $f->{offset};
538                         my $j = $i + 1;
539                         my $max = fieldMaxHolder($start);
540
541                         # breaks bitfields into char/short/int/long blocks
542                         # TODO: need more info for mapping to get/settters
543
544                         #print "> $f->{name} $f->{size} @ $f->{offset}\n";
545
546                         while ($j <= $#fields && $fields[$j]->{ctype} eq "bitfield") {
547                                 my $g = $fields[$j];
548
549                                 #print "> $g->{name} $g->{size} @ $g->{offset}\n";
550
551                                 if ($g->{offset} > $end || ($g->{offset} - $start >= $max)) {
552                                         foreach $size (fieldHolders($start, $end - $start)) {
553                                                 $desc .= ",\n " if ($index++ > 0);
554                                                 $desc .= 'Memory.'.uc($intSizes{$size}).".withName(\"bitfield\$$bitfieldIndex\")";
555                                                 $bitfieldIndex++;
556                                         }
557                                         $desc .= ",\n " if ($index++ > 0);
558                                         $desc .= 'MemoryLayout.paddingLayout('.($g->{offset}-$end).')';
559                                         $start = $g->{offset};
560                                         $max = fieldMaxHolder($start);
561                                 }
562                                 $end = $g->{size} + $g->{offset};
563                                 $j++;
564                         }
565
566                         foreach $size (fieldHolders($start, $end - $start)) {
567                                 $desc .= ",\n " if ($index++ > 0);
568                                 $desc .= 'Memory.'.uc($intSizes{$size}).".withName(\"bitfield\$$bitfieldIndex\")";
569                                 $bitfieldIndex++;
570                         }
571
572
573                         $i = $j-1;
574                 } else {
575                         $desc .= ",\n " if ($index++ > 0);
576                         $desc .= formatTypeLayout($f, ".withName(\"$f->{name}\")");
577                 }
578
579                 $last = $fields[$i]->{offset} + $fields[$i]->{size};
580         }
581
582         if ($last < $s->{size}) {
583                 $desc .= ",\n " if ($index++ > 0);
584                 $desc .= 'MemoryLayout.paddingLayout('.($s->{size} - ${last}).')';
585         }
586
587         $desc .= "\n)";
588         $desc .= ".withBitAlignment($maxSize)";
589
590         return $desc;
591 }
592
593 sub formatGetSet {
594         my $s = shift @_;
595         my $m = shift @_;
596         my $desc = "";
597         my $info = $m->{typeInfo};
598         my $Name = ucfirst($m->{name});
599         my $tmp;
600
601         # info -> needsalloc?
602
603         # TODO: String
604         # TODO: embedded arrays are quite different setup
605
606         if ($info->{byValue}) {
607                 $tmp = $info->{create};
608                 $tmp =~ s/\$\{result\}/segment/g;
609
610                 $desc .= " public $info->{type} get$Name() {\n";
611                 $desc .= "  MemoryLayout.PathElement pe = MemoryLayout.PathElement.groupElement(\"$m->{name}\");\n";
612                 $desc .= "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteOffset(pe), LAYOUT.select(pe).byteSize());\n";
613                 $desc .= "  return $tmp;\n";
614                 $desc .= " }\n";
615
616                 $desc .= " public $info->{type} get$Name"."At(long index) {\n";
617                 $desc .= "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteSize() * index, LAYOUT.byteSize());\n";
618                 $desc .= "  MemoryLayout.PathElement pe = MemoryLayout.PathElement.groupElement(\"$m->{name}\");\n";
619                 $desc .= "  segment = this.segment.asSlice(LAYOUT.byteOffset(pe), LAYOUT.select(pe).byteSize());\n";
620                 $desc .= "  return $tmp;\n";
621                 $desc .= " }\n";
622         } else {
623                 $tmp = $info->{create};
624                 $tmp =~ s/\$\{result\}/($info->{carrier})$m->{name}\$VH.get(segment)/g;
625
626                 $desc .= " public $info->{type} get$Name() {\n";
627                 $desc .= "  return $tmp;\n";
628                 $desc .= " }\n";
629
630                 $desc .= " public $info->{type} get$Name"."At(long index) {\n";
631                 $desc .= "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteSize() * index, LAYOUT.byteSize());\n";
632                 $desc .= "  return $tmp;\n";
633                 $desc .= " }\n";
634         }
635
636         if (!($m->{deref} =~ m/\[(\d*).*\]/)) {
637                 $tmp = $info->{resolve};
638                 $tmp =~ s/\$\{value\}/value/g;
639
640                 $desc .=  " public void set$Name($info->{type} value) {\n";
641                 $desc .=  "  $m->{name}\$VH.set(segment, $tmp);\n";
642                 $desc .=  " }\n";
643
644                 $desc .=  " public void set$Name"."At(long index, $info->{type} value) {\n";
645                 $desc .=  "  MemorySegment segment = this.segment.asSlice(LAYOUT.byteSize() * index, LAYOUT.byteSize());\n";
646                 $desc .=  "  $m->{name}\$VH.set(segment, $tmp);\n";
647                 $desc .=  " }\n";
648         }
649
650         # indexed
651
652         return $desc;
653 }
654
655 sub exportStruct {
656         my $f = shift @_;
657         my $s = shift @_;
658         my @fields = @{$s->{fields}};
659         my $isHandle = $s->{size} == 0;
660         #my @functions = @{shift @_};
661
662         print $f "package $package;\n" if $package;
663
664         print $f "import jdk.incubator.foreign.*;\n";
665         print $f "import java.lang.invoke.*;\n";
666
667         print $f "public class $s->{name} implements Memory.Addressable {\n";
668
669         # TODO: parameterise and use typeInfo data.
670         if (!$isHandle) {
671                 print $f " MemorySegment segment;\n";
672                 # constructors
673                 print $f " private $s->{name}(MemorySegment segment) { this.segment = segment; }\n";
674                 print $f " public static $s->{name} create(MemorySegment segment) { return new $s->{name}(segment); }\n";
675                 print $f " public static $s->{name} create(MemoryAddress address, ResourceScope scope) {\n";
676                 print $f "  return create(MemorySegment.ofAddress(address, LAYOUT.byteSize(), scope));\n";
677                 print $f " }\n";
678                 print $f " public static $s->{name} createArray(MemoryAddress address, long size, ResourceScope scope) {\n";
679                 print $f "  return create(MemorySegment.ofAddress(address, size * LAYOUT.byteSize(), scope));\n";
680                 print $f " }\n";
681                 print $f " public static $s->{name} create(Frame frame) { return create(frame.allocate(LAYOUT)); }\n";
682                 print $f " public static $s->{name} create(ResourceScope scope) { return create(MemorySegment.allocateNative(LAYOUT, scope)); }\n";
683                 print $f " public MemoryAddress address() { return segment.address(); }\n";
684                 print $f " public ResourceScope scope() { return segment.scope(); }\n";
685         } else {
686                 # not sure if handles need scopes
687                 print $f " MemoryAddress address;\n";
688                 print $f " ResourceScope scope;\n";
689                 # constructors
690                 print $f " private $s->{name}(MemoryAddress address, ResourceScope scope) { this.address = address; this.scope = scope}\n";
691                 print $f " public static $s->{name} create(MemoryAddress address) { return new $s->{name}(address); }\n";
692                 print $f " public MemoryAddress address() { return address; }\n";
693                 print $f " public ResourceScope scope() { return scope; }\n";
694         }
695
696         # FIXME: use typeInfo
697         # TODO: indexed accessors
698         # accessors
699         if (1) {
700                 foreach $m (@fields) {
701                         print $f formatGetSet($s, $m);
702                 }
703         } else {
704                 foreach $m (@fields) {
705                         my $Name = ucfirst($m->{name});
706
707                         print $f " // [$m->{deref}] [$m->{type}] [$m->{ctype}]\n";
708
709                         if ($m->{deref} =~ m/^(u64:|u32:)\(/) {
710                                 # This is a function pointer, type must be type = 'call:.*'
711
712                                 if ($m->{type} =~ m/^call:(.*)/) {
713                                         my $jtype = $1;
714
715                                         $jtype =~ s/(.*)\((.*)\)(.*)/Call$1_$2_$3/;
716
717                                         print $f " public Memory.FunctionPointer<$jtype> get$Name() {\n";
718                                         print $f "  // FIXME: better scope\n";
719                                         print $f "  return $jtype.downcall((MemoryAddress)$m->{name}\$VH.get(segment), scope());\n";
720                                         print $f " }\n";
721
722                                         print $f " public void set$Name(Memory.FunctionPointer<$jtype> value) {\n";
723                                         print $f "  $m->{name}\$VH.set(segment, Memory.address(value));\n";
724                                         print $f " }\n";
725                                 }
726                         } elsif ($m->{deref} =~ m/^(u64:|u32:)/) {
727                                 # all other pointer types require extra context, e.g. a length or type
728                                 print $f " public MemoryAddress get$Name() {\n";
729                                 print $f "  return (MemoryAddress)$m->{name}\$VH.get(segment);\n";
730                                 print $f " }\n";
731
732                                 # FIXME: set could use the type though
733                                 print $f " public void set$Name(MemoryAddress value) {\n";
734                                 print $f "  $m->{name}\$VH.set(segment, Memory.address(value));\n";
735                                 print $f " }\n";
736                         } elsif ($m->{type} eq "bitfield") {
737                                 # TODO
738                         } elsif ($m->{type} =~ m/^struct|union:(.*)$/) {
739                                 my $jtype = $1;
740
741                                 $jtype = "Memory.HandleArray<$jtype>" if ($data{$m->{type}}->{size} == 0);
742
743                                 # embedded type including arrays
744                                 print $f " public $jtype get$Name() {\n";
745                                 print $f "  MemoryLayout.PathElement pe = MemoryLayout.PathElement.groupElement(\"$m->{name}\");\n";
746                                 print $f "  MemorySegment seg = segment.asSlice(LAYOUT.byteOffset(pe), LAYOUT.select(pe).byteSize());\n";
747                                 print $f "  return $jtype.create(seg, $jtype::new);\n" if ($data{$m->{type}}->{size} == 0);
748                                 print $f "  return $jtype.create(seg);\n" if ($data{$m->{type}}->{size} != 0);
749                                 print $f " }\n";
750                         } elsif ($m->{type} =~ m/^[uif]\d+$/) {
751                                 my $jtype = $typeSizes{$m->{type}};
752                                 my $Jtype = ucfirst($jtype);
753                                 my $JTYPE = uc($jtype);
754
755                                 if ($m->{deref} =~ m/\[(\d*).*\]/) {
756                                         # array type
757                                         print $f " public Memory.$Jtype"."Array get$Name() {\n";
758                                         print $f "  MemoryLayout.PathElement pe = MemoryLayout.PathElement.groupElement(\"$m->{name}\");\n";
759                                         print $f "  MemorySegment seg = segment.asSlice(LAYOUT.byteOffset(pe), LAYOUT.select(pe).byteSize());\n";
760                                         print $f "  return new Memory.$Jtype"."Array(seg);\n";
761                                         print $f " }\n";
762                                 } else {
763                                         # primitive type
764                                         print $f " public $jtype get$Name() {\n";
765                                         print $f "  return ($jtype)$m->{name}\$VH.get(segment);\n";
766                                         print $f " }\n";
767
768                                         print $f " public void set$Name($jtype value) {\n";
769                                         print $f "  $m->{name}\$VH.set(segment, ($jtype)value);\n";
770                                         print $f " }\n";
771                                 }
772                         }
773                         # struct                                print $f " MemoryLayout.PathElement pe = MemoryLayout.PathElement.groupElement(\"$m->{name}\");\n";
774
775                 }
776         }
777
778         # layout and varhandles
779         if ($#fields >= 0) {
780                 print $f "static final GroupLayout LAYOUT = ".formatLayout($s).";\n";
781
782                 foreach $m (@fields) {
783                         next if ($m->{typeInfo}->{byValue});
784                         print $f " static final VarHandle $m->{name}\$VH = LAYOUT.varHandle(MemoryLayout.PathElement.groupElement(\"$m->{name}\"));\n";
785                 }
786         }
787
788         print $f "}\n";
789 }
790
791 # copies a skeleton file and patches it to the target package
792 sub copySkeletonFile {
793         my $src = shift @_;
794         my $dst = shift @_;
795
796         open (my $d, ">", $dst) || die ("Cannot open '$src' for writing");
797         open (my $s, "<", $src) || die ("Cannot open '$dst' for reading");
798
799         while (<$s>) {
800                 s/^package .*;/package $package;/;
801                 print $d $_;
802         }
803
804         close $s;
805         close $d;
806
807 }
808
809 # init output
810 $outputPath = $package;
811 $outputPath =~ s@\.@/@g;
812 $outputPath = "$output/$outputPath";
813
814 make_path($outputPath);
815
816 copySkeletonFile("$scriptPath/template/Memory.java", "$outputPath/Memory.java");
817 copySkeletonFile("$scriptPath/template/Frame.java", "$outputPath/Frame.java");
818
819 sub nameToPath {
820         my $dir = shift @_;
821         my $name = shift @_;
822
823         $name =~ s@\.@/@g;
824         $name = "$dir/$name.java";
825         return $name;
826 }
827
828 foreach $x (grep { m/^(struct|union):/ } sort keys %data) {
829         my $s = $data{$x};
830         my $path = nameToPath($output, "$package.$s->{name}");
831
832         open (my $f, ">", $path) || die ("Cannot open '$path' for writing");
833
834         exportStruct($f, $s);
835
836         close $f;
837 }
838
839 foreach $x (grep { m/^call:/ } sort keys %data) {
840         my $c = $data{$x};
841         my $name = $c->{name};
842
843         my $path = nameToPath($output, "$package.$name");
844
845         open (my $f, ">", $path) || die ("Cannot open '$path' for writing");
846
847         print $f "package $package;\n";
848         print $f "import jdk.incubator.foreign.*;\n";
849         print $f "import java.lang.invoke.*;\n";
850
851         print $f formatCallback($c);
852
853         close $f;
854 }
855
856 # just quick and dirty for now
857 # may want a non-static version with a specific scope?
858 {
859         my @functions = grep { /^func:/ } keys %data;
860         my $lib = {
861                 name => "APILib",
862                 functions => \@functions
863         };
864
865
866         my $path = nameToPath($output, "$package.$lib->{name}");
867
868         open (my $f, ">", $path) || die ("Cannot open '$path' for writing");
869
870         print $f "package $package;\n";
871         print $f "import jdk.incubator.foreign.*;\n";
872         print $f "import java.lang.invoke.*;\n";
873
874         print $f "public class $lib->{name} {\n";
875
876         print $f " static ResourceScope scope() { return ResourceScope.globalScope(); }\n";
877         foreach $cname (@{$lib->{functions}}) {
878                 my $c = $data{$cname};
879                 my $tmp;
880
881                 print $f " static final MethodHandle $c->{name}\$FH = Memory.downcall(\"$c->{name}\",\n";
882                 $tmp = formatFunctionDescriptor($c);
883                 print $f "$tmp);\n";
884
885                 $tmp = formatFunction($c);
886                 print $f "public static ";
887                 print $f $tmp;
888         }
889
890         print $f "}\n";
891
892         close $f;
893 }