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