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