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
  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 (1) {
 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;