Now includes aliases for constants. Fixes some issues with the vulkan 1.3 registry.
[panamaz] / src / notzed.vulkan / gen / vulkan.pm
1
2 # Routines for working with vulkan registry
3
4 package vulkan;
5
6 use strict;
7
8 use Data::Dumper;
9 use XML::Parser;
10 use Time::HiRes qw(clock_gettime CLOCK_REALTIME);
11
12 sub new {
13         my $class = shift;
14         my $sys = shift;
15         my $self = {
16                 sys => $sys,
17                 data => {},
18                 extensions => [],
19                 handles => {},
20                 types => {},
21                 commands => {},
22                 features => [],
23                 funcpointers => {},
24         };
25
26         bless $self, $class;
27
28         my $now = clock_gettime(CLOCK_REALTIME);
29
30         loadRegistry($self);
31
32         $now = clock_gettime(CLOCK_REALTIME) - $now;
33         print "$now load registry\n";
34
35         # build various indices
36         my $data = $self->{data};
37         my $handles = $self->{handles};
38         my $types = $self->{types};
39         my $commands = $self->{commands};
40         my $extensions = $self->{extensions};
41         my $funcpointers = $self->{funcpointers};
42
43         foreach my $t (keys %{$data}) {
44                 my $v = $data->{$t};
45                 $handles->{$v->{name}} = $v if $v->{category} eq 'handle';
46                 $types->{$v->{name}} = $v if $v->{category} =~ m/struct|union|platform/;
47                 $commands->{$v->{name}} = $v if $v->{category} eq 'command';
48                 $funcpointers->{$v->{name}} = $v if $v->{category} eq 'funcpointer';
49         }
50
51         # mark extension functions?
52         foreach my $e (@{$extensions}) {
53                 foreach my $name (map { @{$_->{commands}} } @{$e->{require}}) {
54                         my $r = $data->{$name};
55
56                         die if !defined($r);
57
58                         push @{$r->{extensions}}, $e->{name};
59                 }
60         }
61
62         # Link up bitmask base types
63         foreach my $s (grep { $_->{category} eq 'enum' } values %{$data}) {
64                 if ($s->{requires}) {
65                         my $t = $data->{$s->{requires}};
66                         die Dumper($s) if !defined $t;
67                         die Dumper($s) if !defined $s->{fullType};
68                         $t->{uses} = $s;
69                         $t->{fullType} = $s->{fullType};
70                 } elsif ($s->{bitvalues}) {
71                         my $t = $data->{$s->{bitvalues}};
72                         die Dumper($s) if !defined $t;
73                         die Dumper($s) if !defined $s->{fullType};
74                         $t->{uses} = $s;
75                         $t->{fullType} = $s->{fullType};
76                 } elsif (!defined $s->{fullType}) {
77                         $s->{fullType} = 'VkFlags';
78                 }
79         }
80
81         $self;
82 }
83
84 sub buildRequirement {
85         my $vk = shift;
86         my $data = shift;
87         my $req = shift;
88         my $ext = shift;
89         my $outconst = $data->{'API Constants'};
90         my $allconst = $vk->{data}->{'API Constants'};
91
92         # Find included types in this requirement
93         foreach my $c (@{$req->{commands}}, @{$req->{types}}) {
94                 my $d = $vk->{data}->{$c};
95
96                 if (defined $d) {
97                         # for format change?
98                         if ($d->{category} eq 'enum') {
99                                 # Copy all aliases across to data
100                                 while ($d->{alias}) {
101                                         $data->{$d->{name}} = $d;
102                                         $d = $vk->{data}->{$d->{alias}};
103                                 }
104                                 $d = { %$d };
105                                 $d->{items} = [ @{$d->{items}} ] if defined($d->{items});
106                                 $data->{$d->{name}} = $d;
107                         } else {
108                                 $data->{$d->{name}} = $d;
109                         }
110                 } else {
111                         $data->{$c} = {
112                                 name => $c,
113                                 category => 'define',
114                         };
115                 }
116         }
117         foreach my $c (@{$req->{enums}}) {
118                 if ($c->{extends}) {
119                         my $d = $data->{$c->{extends}};
120
121                         if (defined($c->{value})) {
122                         } elsif (defined($c->{bitpos})) {
123                                 $c->{value} =  "".(1<<$c->{bitpos});
124                         } elsif (defined($c->{extnumber})) {
125                                 $c->{value} = "".(1000000000
126                                                                   + 1000 * ($c->{extnumber} - 1)
127                                                                   + $c->{offset});
128                         } elsif (defined($c->{offset})) {
129                                 $c->{value} = $c->{dir}."".(1000000000
130                                                                                         + 1000 * ($ext->{number} - 1)
131                                                                                         + $c->{offset});
132                         } elsif (defined($c->{alias})) {
133                         } else {
134                                 print Dumper($c);
135                                 die;
136                         }
137
138                         push @{$d->{items}}, $c;
139                 } elsif ($c->{value}) {
140                         if ($c->{value} =~ m/^"/) {
141                                 if (!defined $outconst->{index}->{$c->{name}}) {
142                                         my $v = { %$c, type=>'const char *' };
143                                         push @{$outconst->{items}}, $v;
144                                         $outconst->{index}->{$v->{name}} = $v;
145                                 }
146                         } else {
147                                 if (!defined $outconst->{index}->{$c->{name}}) {
148                                         my $v = { %$c, type=>'uint32_t' };
149                                         push @{$outconst->{items}}, $v;
150                                         $outconst->{index}->{$v->{name}} = $v;
151                                 }
152                         }
153                 } elsif (!$c->{alias}) {
154                         if (!defined $outconst->{index}->{$c->{name}}) {
155                                 my $v = $allconst->{index}->{$c->{name}};
156
157                                 die Dumper($c) if !defined $v;
158
159                                 push @{$outconst->{items}}, $v;
160                                 $outconst->{index}->{$c->{name}} = $v;
161                         }
162                 }
163         }
164 }
165
166 # Ideally this builds a 'view' of the features
167 # But it doesn't work properly if something is promoted and uses new names
168
169 sub buildFeatures {
170         my $vk = shift;
171         my $vers = shift;
172         my $plat = shift;
173         my $data = {};
174         my $versions = {};
175         my $platform = {};
176
177         map { $versions->{$_} = 1 } @$vers;
178         map { $platform->{$_} = 1 } @$plat;
179
180         #print Dumper($vk->{features});
181
182         $data->{'API Constants'} = {
183                 name => 'API Constants',
184                 category => 'define',
185                 items => [],
186                 index => {},
187         };
188
189         # add constants that the api's dont reference (only 1 so far)
190         my $outconst = $data->{'API Constants'};
191         my $allconst = $vk->{data}->{'API Constants'};
192         foreach my $v (map {$allconst->{index}->{$_}} qw(VK_UUID_SIZE)) {
193                 push @{$outconst->{items}}, $v;
194                 $outconst->{index}->{$v->{name}} = $v;
195         }
196
197         foreach my $feature (grep { $versions->{$_->{name}} } @{$vk->{features}}) {
198                 print "Feature $feature->{name}\n" if ($vk->{sys}->{verbose});
199                 foreach my $req (@{$feature->{require}}) {
200                         buildRequirement($vk, $data, $req);
201                 }
202         }
203
204         foreach my $extension (grep { $_->{supported} eq 'vulkan' && (!defined($_->{platform}) || $platform->{$_->{platform}})
205                                                    } @{$vk->{extensions}}) {
206                 foreach my $req (grep { (!defined($_->{feature})) || $versions->{$_->{feature}} }
207                                                  @{$extension->{require}}) {
208                         print "Extension $extension->{name} $req->{feature}\n" if ($vk->{sys}->{verbose});
209                         buildRequirement($vk, $data, $req, $extension);
210                 }
211         }
212
213         #print "rest\n";
214         #print Dumper($data);
215
216         # TODO: need to remove aliases here?
217         my $handles = {};
218         my $types = {};
219         my $commands = {};
220         my $enums = {};
221         my $funcpointers = {};
222         my $defines = {};
223
224         foreach my $t (keys %{$data}) {
225                 my $v = $data->{$t};
226                 $handles->{$v->{name}} = $v if $v->{category} eq 'handle';
227                 $types->{$v->{name}} = $v if $v->{category} =~ m/struct|union/on;
228                 $commands->{$v->{name}} = $v if $v->{category} eq 'command';
229                 $enums->{$v->{name}} = $v if $v->{category} eq 'enum';
230                 $funcpointers->{$v->{name}} = $v if $v->{category} eq 'funcpointer';
231                 $defines->{$v->{name}} = $v if $v->{category} eq 'define';
232         }
233
234         if (1) {
235                 open(my $f, '>', 'features.pm');
236                 print $f Dumper($data);
237                 close $f;
238
239                 open(my $f, '>', 'vk.pm');
240                 print $f Dumper($vk);
241                 close $f;
242         }
243
244         my $api = {
245                 data => $data,
246                 handles => $handles,
247                 types => $types,
248                 commands => $commands,
249                 funcpointers => $funcpointers,
250                 enums => $enums,
251                 defines => $defines,
252         };
253
254         # create sizes for every struct of interest
255         foreach my $s (values %$types) {
256                 next if $s->{alias};
257
258                 if ($s->{category} eq 'struct') {
259                         structSize($vk, $api, $s);
260                 } elsif ($s->{category} eq 'union') {
261                         unionSize($vk, $api, $s);
262                 } else {
263                         die;
264                 }
265         }
266
267         return $api;
268 }
269
270 my $typeInfo = {
271         'void *' => { bitSize => 64, bitAlign => 64 },
272         'int' => { bitSize => 32, bitAlign => 32 },
273         'char' => { bitSize => 8, bitAlign => 8 },
274         'uint8_t' => { bitSize => 8, bitAlign => 8 },
275         'uint16_t' => { bitSize => 16, bitAlign => 16 },
276         'int32_t' => { bitSize => 32, bitAlign => 32 },
277         'uint32_t' => { bitSize => 32, bitAlign => 32 },
278         'int64_t' => { bitSize => 64, bitAlign => 64 },
279         'uint64_t' => { bitSize => 64, bitAlign => 64 },
280         'size_t' => { bitSize => 64, bitAlign => 64 },
281         'float' => { bitSize => 32, bitAlign => 32 },
282         'double' => { bitSize => 64, bitAlign => 64 },
283         'size_t' => { bitSize => 64, bitAlign => 64 },
284         'Window' => { bitSize => 64, bitAlign => 64 },
285         'Display' => { bitSize => 64, bitAlign => 64 },
286         'xcb_window_t' => { bitSize => 32, bitAlign => 32 },
287         'xcb_connection_t' => { bitSize => 64, bitAlign => 64 },
288 #       'VkFlags' =>  { bitSize => 32, bitAlign => 32 },
289 #       'VkFlags64' =>  { bitSize => 64, bitAlign => 64 },
290 };
291
292 sub memberSize {
293         my $vk = shift;
294         my $api = shift;
295         my $m = shift;
296         my $t = $api->{data}->{$m->{baseType}};
297         my $nstar = $m->{fullType} =~ tr/*/*/;
298         my ($nbits) = $m->{fullType} =~ m/:(\d+)$/o;
299         my $array = 1;
300         my $info = $typeInfo->{'void *'};
301
302         # arrays and bitfields
303         if ($m->{fullType} =~ m/\[(.*)\]\[(.*)\]$/) {
304                 $array = $1 * $2;
305         } elsif ($m->{fullType} =~ m/\[(\d+)\]$/o) {
306                 $array = $1;
307         } elsif ($m->{fullType} =~ m/\[(.+)\]$/o) {
308                 $array = $vk->{data}->{'API Constants'}->{index}->{$1}->{value};
309         }
310
311         if (!defined($t)) {
312                 if ($nbits) {
313                         die Dumper($m) if $nstar > 0;
314                         $info = { bitSize => $nbits, bitAlign => 1 };
315                 } else {
316                         $info = $typeInfo->{$m->{baseType}} if ($nstar == 0);
317                 }
318         } else {
319                 while ($t->{alias}) {
320                         $t = $api->{data}->{$t->{alias}};
321                 }
322
323                 die Dumper($m) if !defined $t;
324
325                 if ($t->{category} =~ m/enum|bitmask/on) {
326                         if ($nbits) {
327                                 die Dumper($m) if $nstar > 0;
328                                 $info = { bitSize => $nbits, bitAlign => 1 };
329                         } else {
330                                 $t = $vk->{data}->{$t->{fullType}};
331                                 $info = $typeInfo->{$t->{type}} if ($nstar == 0);
332                         }
333                 } elsif ($t->{category} eq 'struct') {
334                         $info = structSize($vk, $api, $t) if ($nstar == 0);
335                 } elsif ($t->{category} eq 'union') {
336                         $info = unionSize($vk, $api, $t) if ($nstar == 0);
337                 } elsif ($t->{category} eq 'handle') {
338                         # already set
339                 } elsif ($t->{category} eq 'basetype') {
340                         $info = $typeInfo->{$t->{type}} if ($nstar == 0);
341                 } elsif ($t->{category} eq 'funcpointer') {
342                         # already set
343                 } else {
344                         die Dumper($m, $t);
345                 }
346         }
347
348         die Dumper($m, $t) if !defined($info);
349
350         #print Dumper($m, $t, $info);
351         #print "size $m->{name} $m->{fullType} = $info->{bitSize}\n";
352
353
354         return { bitSize => $info->{bitSize} * $array, bitAlign => $info->{bitAlign} };
355 }
356
357 sub align {
358         my $v = shift;
359         my $a = shift;
360
361         return ($v + $a - 1) & ~($a - 1);
362 }
363
364 sub structSize {
365         my $vk = shift;
366         my $api = shift;
367         my $s = shift;
368         my $bitSize = 0;
369         my $bitAlign = 8;
370
371         if (!defined($s->{bitSize})) {
372                 foreach my $m (@{$s->{items}}) {
373                         use integer;
374                         my $info = memberSize($vk, $api, $m);
375
376                         $bitSize = align($bitSize, $info->{bitAlign});
377
378                         $m->{bitOffset} = $bitSize;
379                         $m->{bitSize} = $info->{bitSize};
380
381                         $bitSize = $bitSize + $info->{bitSize};
382                         $bitAlign = $info->{bitAlign} if $info->{bitAlign} > $bitAlign;
383                 }
384
385                 $bitSize = align($bitSize, $bitAlign);
386
387                 $s->{bitSize} = $bitSize;
388                 $s->{bitAlign} = $bitAlign;
389         } else {
390                 $bitSize = $s->{bitSize};
391                 $bitAlign = $s->{bitAlign};
392         }
393
394         return { bitSize => $bitSize, bitAlign => $bitAlign };
395 }
396
397 sub unionSize {
398         my $vk = shift;
399         my $api = shift;
400         my $s = shift;
401         my $bitSize = 0;
402         my $bitAlign = 8;
403
404         if (!defined($s->{bitSize})) {
405                 foreach my $m (@{$s->{items}}) {
406                         use integer;
407                         my $info = memberSize($vk, $api, $m);
408
409                         $m->{bitOffset} = 0;
410                         $m->{bitSize} = $info->{bitSize};
411
412                         $bitSize = $info->{bitSize} if $info->{bitSize} > $bitSize;
413                         $bitAlign = $info->{bitAlign} if $info->{bitAlign} > $bitAlign;
414                 }
415
416                 $bitSize = align($bitSize, $bitAlign);
417
418                 $s->{bitSize} = $bitSize;
419                 $s->{bitAlign} = $bitAlign;
420         } else {
421                 $bitSize = $s->{bitSize};
422                 $bitAlign = $s->{bitAlign};
423         }
424
425         return { bitSize => $bitSize, bitAlign => $bitAlign };
426 }
427
428 sub loadRegistry {
429         my $vk = shift;
430
431         my $xml = XML::Parser->new(Style => 'Tree');
432         my $doc = $xml->parsefile('/usr/share/vulkan/registry/vk.xml') || die "unable to parse vulkan registry";
433
434         #print Dumper($doc);
435
436         my $root = $doc->[1];
437         my $roota = shift @{$root};
438
439         my $data = $vk->{data};
440         my $alias = $vk->{alias};
441         my $extensions = $vk->{extensions};
442         my $features = $vk->{features};
443
444         # This destructively consumes the whole tree so must be one pass
445         while ($#{$root} >= 0) {
446                 my $xt = shift @{$root};
447                 my $xn = shift @{$root};
448
449                 next if $xt eq '0';
450
451                 my $xa = shift @{$xn};
452
453                 if ($xt eq 'types') {
454                         while ($#{$xn} >= 0) {
455                                 my $yt = shift @{$xn};
456                                 my $yn = shift @{$xn};
457
458                                 next if $yt ne 'type';
459
460                                 my $ya = $yn->[0];
461
462                                 if ($ya->{category} =~ m/struct|union/) {
463                                         if (!defined($ya->{alias})) {
464                                                 my $s = $ya;
465
466                                                 $s->{items} = [];
467
468                                                 shift @{$yn};
469                                                 while ($#{$yn} >= 0) {
470                                                         my $mt = shift @{$yn};
471                                                         my $mm = shift @{$yn};
472
473                                                         push @{$s->{items}}, loadMember($mm) if $mt eq 'member';
474                                                 }
475
476                                                 $data->{$s->{name}} = $s;
477                                         } else {
478                                                 $alias->{$ya->{name}} = $ya->{alias};
479                                                 $data->{$ya->{name}} = $ya;
480                                         }
481                                 } elsif ($ya->{category} =~ m/^(handle|basetype|funcpointer|bitmask)$/n) {
482                                         if (!defined($ya->{alias})) {
483                                                 my $info = loadMember($yn);
484                                                 my $s = $ya;
485
486                                                 $s->{name} = $info->{name};
487                                                 $s->{type} = $info->{baseType} if defined $info->{baseType};
488
489                                                 $s->{category} = 'enum' if $s->{category} eq 'bitmask';
490                                                 analyseFunctionPointer($s) if ($s->{category} eq 'funcpointer');
491
492                                                 $data->{$s->{name}} = $s;
493                                         } else {
494                                                 $ya->{category} = 'enum' if $ya->{category} eq 'bitmask';
495                                                 $alias->{$ya->{name}} = $ya->{alias};
496                                                 $data->{$ya->{name}} = $ya;
497                                         }
498                                 } elsif ($ya->{category} eq 'enum') {
499                                         $data->{$ya->{name}} = $ya;
500                                 } elsif ($ya->{requires} eq 'vk_platform' || $ya->{name} eq 'int') {
501                                         # These are just primitive types, not sure what to do with them, could auto-map them to java i suppose
502                                         $ya->{category} = 'platform';
503                                         $data->{$ya->{name}} = $ya;
504                                 } else {
505                                         #noisy print "Unhandled: $ya->{name}\n";
506                                 }
507                         }
508                 } elsif ($xt eq 'enums') {
509                         if ($xa->{type} =~ m/enum|bitmask/o) {
510                                 #print "enum: $xa->{name}\n";
511                                 # these are forward referenced from <types> block so re-use, or just overwrite?
512                                 my $e = $data->{$xa->{name}};
513
514                                 $e = { %{$xa}, category => "enum" } if (!defined($e));
515                                 $e->{items} = [];
516
517                                 while ($#{$xn} >= 0) {
518                                         my $yt = shift @{$xn};
519                                         my $yn = shift @{$xn};
520
521                                         next if $yt ne 'enum';
522
523                                         my $ya = shift @{$yn};
524
525                                         #next if $ya->{alias};
526
527                                         push @{$e->{items}}, $ya;
528                                 }
529
530                                 $data->{$e->{name}} = $e;
531                         } elsif ($xa->{name} eq 'API Constants') {
532                                 my $d = { category => "define", name => $xa->{name}, items =>[], index=>{} };
533
534                                 $data->{$xa->{name}} = $d;
535
536                                 while ($#{$xn} >= 0) {
537                                         my $yt = shift @{$xn};
538                                         my $yn = shift @{$xn};
539
540                                         next if $yt ne 'enum';
541
542                                         my $ya = shift @{$yn};
543
544                                         #next if $ya->{alias};
545
546                                         push @{$d->{items}}, $ya;
547                                         $d->{index}->{$ya->{name}} = $ya;
548                                 }
549                         }
550                 } elsif ($xt eq 'commands') {
551                         while ($#{$xn} >= 0) {
552                                 my $yt = shift @{$xn};
553                                 my $yn = shift @{$xn};
554
555                                 next if $yt ne 'command';
556
557                                 my $ya = shift @{$yn};
558
559                                 if (!defined($ya->{alias})) {
560                                         my $cmd = $ya;
561
562                                         $cmd->{category} = 'command';
563                                         $cmd->{items} = [];
564                                         $cmd->{proto} = {};
565
566                                         while ($#{$yn} >= 0) {
567                                                 my $zt = shift @{$yn};
568                                                 my $zn = shift @{$yn};
569
570                                                 if ($zt eq 'proto') {
571                                                         $cmd->{proto} = loadMember($zn);
572                                                 } elsif ($zt eq 'param') {
573                                                         push @{$cmd->{items}}, loadMember($zn);
574                                                 }
575                                         }
576
577                                         my $name = $cmd->{proto}->{name};
578
579                                         # check we parsed it properly
580                                         if ($cmd->{proto}->{fullType} eq "") {
581                                                 print Dumper([$ya, $yn]);
582                                                 die();
583                                         }
584                                         $cmd->{name} = $name;
585
586                                         $data->{$name} = $cmd;
587                                 } else {
588                                         # want forward ref or not?
589                                         $alias->{$ya->{name}} = $ya->{alias};
590                                         $data->{$ya->{name}} = $ya;
591                                 }
592                         }
593                 } elsif ($xt eq 'feature') {
594                         my $feature = $xa;
595
596                         $feature->{require} = [];
597
598                         while ($#{$xn} >= 0) {
599                                 my $yt = shift @{$xn};
600                                 my $yn = shift @{$xn};
601
602                                 next if $yt ne 'require';
603
604                                 push @{$feature->{require}}, loadRequire($data, $alias, $yn);
605                         }
606
607                         push @{$features}, $feature;
608                 } elsif ($xt eq 'extensions') {
609                         while ($#{$xn} >= 0) {
610                                 my $yt = shift @{$xn};
611                                 my $yn = shift @{$xn};
612
613                                 next if $yt ne 'extension';
614
615                                 my $ext = shift @{$yn};
616
617                                 $ext->{require} = [];
618
619                                 while ($#{$yn} >= 0) {
620                                         my $zt = shift @{$yn};
621                                         my $zn = shift @{$yn};
622
623                                         next if $zt ne 'require';
624
625                                         push @{$ext->{require}}, loadRequire($data, $alias, $zn);
626                                 }
627
628                                 push @{$extensions}, $ext;
629                         }
630                 } else {
631                         print "vulkan.pm: Ignore node: $xt\n";
632                 }
633         }
634 }
635
636 # find an object including via alias
637 sub findData {
638         my $data = shift;
639         my $alias = shift;
640         my $name = shift;
641
642         do {
643                 my $s = $data->{$name};
644                 return $s if defined $s;
645                 #print "alias $name => $alias->{$name}\n";
646                 $name = $alias->{$name};
647         } while ($name);
648
649         die "No match for type '$name'";
650 }
651
652 sub makeParameter {
653         my $name = shift;
654         my $fullType = shift;
655         my $type = $fullType;
656
657         $type =~ s/const|\*|\s//gon;
658
659         $fullType =~ s/\s{2,}/ /go; # collapse all whitespace to ' '
660
661         # canonicalise spaces in c type
662         #$fullType =~ s/(?<!const)\s+//go; # strip all spaces except those following const
663         $fullType =~ s/(?<! )\*/ */go;   # insert a space before * if there isn't one
664         $fullType =~ s/(?<=\*)(\S)/ \1/go;# insert a space after * if there isn't one
665
666         # fix brackets and trailing spaces
667         #$fullType =~ s/\( /(/go;
668         #$fullType =~ s/ \)/)/go;
669         #$fullType =~ s/ \[/[/go;
670         $fullType =~ s/^\s+|\s+$//go;
671
672         return {
673                 name => $name,
674                 Name => ucfirst($name),
675                 fullType => $fullType,
676                 baseType => $type,
677                 type => $type,
678         };
679 }
680
681 # Convert function typedef into function info
682 sub analyseFunctionPointer {
683         my $s = shift;
684
685         if ($s->{fullType} =~ m/^(.+)\s+\(VKAPI_PTR \*\)\((.*)\)$/o) {
686                 my $rt = $1;
687                 my @args = split /,/,$2;
688
689                 $s->{proto} = makeParameter('result$', $rt);
690                 $s->{items} = [];
691
692                 if ($#args != 0 || $args[0] ne 'void') {
693                         foreach my $a (@args) {
694                                 if (my ($fullType, $name) = $a =~ m/^(.*)\s+(\S+)$/o) {
695                                         push @{$s->{items}}, makeParameter($name, $fullType);
696                                 } else {
697                                         die "Unable to parse function pointer argument '$a'\n";
698                                 }
699                         }
700                 }
701         } else {
702                 die "Unable to parse function pointer prototype '$s->{fullType}'\n";
703         }
704         $s->{Name} = $s->{name};
705
706         delete $s->{type};
707         delete $s->{baseType};
708         delete $s->{fullType};
709 }
710
711 sub loadMember {
712         my $nn = shift;
713         #my $x = (join '',split('\n',Dumper($nn)));     $x =~ s/ +/ /g; print "load: $x\n";
714         my $m = shift @{$nn};
715         my $baseType = "";
716         my $fullType = "";
717         my $name = "";
718
719         while ($#{$nn} >= 0) {
720                 my $pt = shift @{$nn};
721                 my $pn = shift @{$nn};
722
723                 if ($pt eq '0') {
724                         $fullType .= $pn;
725                 } elsif ($pt eq 'type') {
726                         die if $pn->[1] != 0;
727                         $baseType = $pn->[2];
728                         $fullType .= $baseType;
729                 } elsif ($pt eq 'name') {
730                         die if $pn->[1] != 0;
731                         $name = $pn->[2];
732                 } elsif ($pt eq 'enum') {
733                         die if $pn->[1] != 0;
734                         $fullType .= $pn->[2];
735                 }
736         }
737
738         $fullType =~ s/^typedef (.*);$/\1/os; # strip out 'typedef' part
739         $fullType =~ s/\s{2,}/ /go; # collapse all whitespace to ' '
740
741         # canonicalise spaces in c type
742         #$fullType =~ s/(?<!const)\s+//go; # strip all spaces except those following const
743         $fullType =~ s/(?<! )\*/ */go;   # insert a space before * if there isn't one
744         $fullType =~ s/(?<=\*)(\S)/ \1/go;# insert a space after * if there isn't one
745
746         # fix brackets and trailing spaces
747         $fullType =~ s/\( /(/go;
748         $fullType =~ s/ \)/)/go;
749         $fullType =~ s/ \[/[/go;
750     $fullType =~ s/^\s+|\s+$//go;
751     $fullType =~ s/ :/:/go;
752
753         $m->{name} = $name;
754         $m->{baseType} = $baseType;
755         $m->{fullType} = $fullType;
756
757     $m;
758 }
759
760 sub loadRequire {
761         my $data = shift;
762         my $alias = shift;
763         my $nn = shift;
764         my $r = shift @{$nn};
765
766         $r->{enums} = [];
767         $r->{types} = [];
768         $r->{commands} = [];
769
770         while ($#{$nn} >= 0) {
771                 my $mt = shift @{$nn};
772                 my $mn = shift @{$nn};
773
774                 if ($mt eq 'type') {
775                         my $ma = shift @{$mn};
776                         push @{$r->{types}}, $ma->{name};
777                 } elsif ($mt eq 'command') {
778                         my $ma = shift @{$mn};
779                         push @{$r->{commands}}, $ma->{name};
780                 } elsif ($mt eq 'enum') {
781                         my $ma = shift @{$mn};
782                         push @{$r->{enums}}, $ma;
783                 }
784         }
785
786         $r;
787 }
788
789 sub findElements {
790         my $n = shift;
791         my $name = shift;
792         my @list;
793
794         while ($#{$n} >= 0) {
795                 my $tag = shift @{$n};
796                 my $con = shift @{$n};
797
798                 if ($tag eq $name) {
799                         push @list, [$tag, $con];
800                 }
801         }
802         @list;
803 }
804
805 sub scanElements {
806         my $n = shift;
807
808         while ($#{$n} >= 0) {
809                 my $tag = shift @{$n};
810                 my $con = shift @{$n};
811
812                 print "$#{$n} ";
813                 print "tag $tag\n";
814         }
815 }
816
817 1;