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