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