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