kernel/fiasco/tool/preprocess/src/preprocess

   1 #! /usr/bin/perl -w
   2 # -*- perl -*-
   3
   4 #
   5 # Please find extensive documentation of this program at
   6 # <http://os.inf.tu-dresden.de/~hohmuth/prj/preprocess/>
   7 #
   8
   9 # Things this script does:
  10 #
  11 # - Expand class declarations as necessary using member-function
  12 #   definitions found in the file.  Function labelled PUBLIC,
  13 #   PROTECTED and PRIVATE are put into the corresponding section of
  14 #   the class.
  15 #
  16 # - Put "INTERFACE:" regions in public header file.
  17 #
  18 # - Put "inline" functions and all types they need into public header
  19 #   file as well.
  20 #
  21 # - Put all remaining, private types and their inline functions into a
  22 #   separate header file.  This file can be used by a debugger
  23 #   interface to display the data.
  24 #
  25 # - Place include directives to top of public header file and private
  26 #   header file.
  27 #
  28
  29 #
  30 # Declarations
  31 #
  32
  33 require 5.006;
  34 use Getopt::Std;
  35 use strict;
  36
  37 sub print_expand($);
  38 sub print_funcdecl($);
  39 sub print_funcdef($);
  40 sub print_classdecl($);
  41 sub print_code($);
  42 sub func_prototype($);
  43
  44 #
  45 # Get options
  46 #
  47
  48 our $opt_c = '';                # Base name for generated include directives
  49 our $opt_o = '';                # Base name of output files (defaults to -c,
  50                                 # overrides -p)
  51 our $opt_p = '';                # Prepend to base name of output files (-c)
  52 our $opt_h = '';                # Name of public header; overrides -c
  53 our $opt_i = 0;                 # Doing inlines?
  54 our $opt_v = 0;                 # Verboseness?
  55 our $opt_l = 0;                 # Avoid generating #line directives?
  56 our $opt_L = 0;                 # Avoid generatung #line dirs in headers only?
  57 # Support for new style FIASCO config
  58 our $opt_e = '';                # List of part tags
  59 our $opt_s = 0;
  60 our $opt_d = 0;                 # verbose drop
  61
  62 our $opt_w = 0;                 # warn if no inline code for needs is found
  63
  64 # Added 2003.01.12  by RCB
  65 # Support for changing the names of headers
  66 our $opt_H = "h";               # Default extenstion for header files
  67 our $opt_C = "cc";              # Default extention for source files
  68 our $opt_t = 0;
  69
  70 getopts('e:o:c:p:h:H:C:ivlLsdwt');
  71
  72 sub usage
  73 {
  74   print <<EOF
  75 C and C++ preprocessor (c) by Michael Hohmuth
  76 Usage: preprocess [-dilLstvw] -c <base_name> [-C <source_ext>]
  77          [-e <tag_list>] [-h <head_name>] [-H <head_ext>]
  78          [-o <source_base>] [-p <prefix>] <files>
  79 OPTIONS
  80   -c <base_name>  Base name for generated include directives, generated
  81                   header files, and generated source files.
  82   -C <source_ext> File extension for generated source files (default 'cc').
  83   -d              Verbose drop sections (only in conjunction with -e).
  84   -e <tag_list>   Use explicit section selection, and set the given tag
  85                   list. <tag_list> is a qouted and space separated list of
  86                   tags that should be enabled. (Useful in conjunction
  87                   with -s)
  88   -h <head_name>  Name of generated public header (overrides -c)
  89   -H <head_ext>   File extension for generated header files (default 'h').
  90   -i              Do inlines, make inline functions real inline.
  91   -l              Avoid generating #line directives.
  92   -L              Avoid generating #line directives in headers only.
  93   -o <src_base>   Base name for generated source files (defaults to -c, and
  94                   overrides -p)
  95   -p              Prefix for names of output files.
  96   -s              Generate a single source file per .cpp file (not a file
  97                   per section).
  98   -t              Truncate empty implementation files to zero length (so
  99                   that even the includ directives are ommitted)
 100   -v              Be verbose (very).
 101   -w              Do warnings.
 102 EOF
 103 }
 104
 105 if ($opt_c eq '')
 106   {
 107     usage;
 108     die "Need to specify option -c Classfile_basename;";
 109   }
 110
 111 my $incfile_base = $opt_c;
 112 my $public_base = (($opt_h eq '') ? $incfile_base : $opt_h);
 113 my $outfile_base;
 114 my $headerfile_base;
 115 my $doing_inlines = $opt_i;
 116 my $verbose = $opt_v;
 117 my $doing_linenumbers = (! $opt_l) && (! $opt_L);
 118 my $wno_inline = $opt_w;
 119 my $status = 0;
 120
 121 my $parts_re = '';
 122 my %parts = ( '{' => '(',
 123               '}' => ')',
 124               ',' => '||',
 125               '-' => '&&',
 126               '|' => '|',
 127               '&' => '&',
 128               '(' => '(',
 129               ')' => ')',
 130               '!' => '!');
 131
 132 my $ARGV = $ARGV[0];
 133
 134 if ($opt_e ne '')
 135   {
 136     foreach my $p (split(' ',$opt_e))
 137       {
 138         $parts{$p} = '1';
 139       }
 140   }
 141
 142 # Added 2003.01.12  by RCB
 143 # Support for changing the names of headers
 144 my $source_ext = $opt_C;
 145 my $header_ext = $opt_H;
 146
 147 if ($opt_o eq '')
 148   {
 149     $outfile_base = $opt_p . $incfile_base;
 150     $headerfile_base = $opt_p . $public_base;
 151   }
 152 else
 153   {
 154     $outfile_base = $opt_o;
 155     $headerfile_base = $outfile_base;
 156   }
 157
 158 #
 159 # Variable initializations
 160 #
 161 parse_init();
 162
 163 our $print_indent = 0;
 164 clear_head();
 165
 166 my %classes = ();
 167 my %functions = ();
 168 my %sections = ();
 169 my %impl_parts = ();
 170 my %includes = ();
 171 my @comments = ();
 172 my %public_inline = ();
 173 my %private_inline = ();
 174 my %unit_inline = ();
 175 my @inline_order_public = ();
 176 my @inline_order_private = ();
 177 my @inline_order_unit = ();
 178
 179 #
 180 # Parse input file
 181 #
 182
 183 parse_file ();
 184
 185 #
 186 # Print header file
 187 #
 188
 189 # Fixup incfile_base preproc macro if it contains invalid chars.
 190 my $incfile_base_macro;
 191
 192 $incfile_base_macro = $incfile_base;
 193 $incfile_base_macro =~ s/[+-]/_/g;
 194
 195 open(OUT, ">${headerfile_base}.$header_ext")
 196   || die "Cannot open ${headerfile_base}.$header_ext for writing!";
 197 print OUT "// AUTOMATICALLY GENERATED -- DO NOT EDIT!         -*- c++ -*-\n\n";
 198 print OUT "#ifndef ${incfile_base_macro}_$header_ext\n" .
 199           "#define ${incfile_base_macro}_$header_ext\n";
 200
 201 foreach my $i (grep {$_->{type} eq 'include'} @{$sections{"INTERFACE"}})
 202   {
 203     print_code $i;
 204   }
 205
 206 print_head ("\n" .
 207             "//\n" .
 208             "// INTERFACE definition follows \n" .
 209             "//\n\n");
 210
 211 foreach my $i ( (grep {$_->{type} eq 'classdef'
 212                  && $_->{syntax} eq 'forwarddecl'}
 213                    @{$sections{"INTERFACE"}}),
 214              (grep {$_->{type} ne 'classdef' || $_->{syntax} ne 'forwarddecl'}
 215                    @{$sections{"INTERFACE"}}) )
 216   {
 217     if ($i->{type} eq 'code')
 218       {
 219         print_code $i;
 220       }
 221     elsif ($i->{type} eq 'classdef')
 222       {
 223         print_classdecl ($i);
 224       }
 225   }
 226
 227 foreach my $i (grep {$_->{type} eq 'function' && $_->{class} eq ''
 228                                               && ! $_->{static}}
 229                  @{$sections{"IMPLEMENTATION"}})
 230   {
 231     print_funcdecl $i;
 232   }
 233
 234 my @public_templates = grep
 235   {
 236     $_->{type} eq 'function' && $_->{template} ne '' # template func
 237     && $_->{fully_specialized_template} eq ''
 238     && ! defined $public_inline{$_} # not public inline -- handled elsewhere
 239     && ($_->{visibility} eq "free"  # free func
 240         || ($_->{class} ne ''   # or member func of public or published class
 241             && ($classes{$_->{class}}->{section} eq 'INTERFACE'
 242                 || defined $public_inline{$classes{$_->{class}}})))
 243   }
 244                     @{$sections{"IMPLEMENTATION"}};
 245
 246 my $impl_includes_imported = 0;
 247
 248 if (scalar keys %public_inline || scalar @public_templates)
 249   {
 250     if (scalar @public_templates)
 251       {
 252         $impl_includes_imported = 1;
 253       }
 254
 255     clear_head();
 256     print_head
 257       ("\n" .
 258        "//\n" .
 259        "// IMPLEMENTATION includes follow " .
 260        "(for use by inline functions/templates)\n" .
 261        "//\n\n");
 262
 263     foreach my $i (grep { $_->{type} eq 'include'
 264                             && ($impl_includes_imported || $_->{inline}) }
 265                    @{$sections{"IMPLEMENTATION"}})
 266       {
 267         print_code $i;
 268       }
 269
 270     clear_head();
 271     print_head
 272       ("\n" .
 273        "//\n" .
 274        "// IMPLEMENTATION of inline functions (and needed classes)\n" .
 275        "//\n\n");
 276
 277     print_inlines (@inline_order_public);
 278   }
 279
 280 clear_head();
 281 print_head ("\n" .
 282             "//\n" .
 283             "// IMPLEMENTATION of function templates\n" .
 284             "//\n\n");
 285 foreach my $i (@public_templates)
 286   {
 287     print_funcdef $i;
 288   }
 289
 290 clear_head();
 291
 292 print OUT "\n#endif // ${incfile_base_macro}_$header_ext\n";
 293 close OUT;
 294
 295 #
 296 # Print "internal data structures" header file
 297 #
 298
 299 open(OUT, ">${outfile_base}_i.$header_ext")
 300   || die "Cannot open ${outfile_base}_i.$header_ext for writing!";
 301 print OUT "// AUTOMATICALLY GENERATED -- DO NOT EDIT!         -*- c++ -*-\n\n";
 302 print OUT "#ifndef ${incfile_base_macro}_i_$header_ext\n" .
 303           "#define ${incfile_base_macro}_i_$header_ext\n";
 304
 305 foreach my $i (grep { $_->{type} eq 'include' }
 306                @{$sections{"IMPLEMENTATION"}})
 307   {
 308     print_code $i;
 309   }
 310
 311 foreach my $i
 312   ( (grep {$_->{type} eq 'classdef' && $_->{syntax} eq 'forwarddecl'}
 313      @{$sections{"IMPLEMENTATION"}}),  # first all forward declarations,
 314     (grep {$_->{type} eq 'classdef' && $_->{syntax} ne 'forwarddecl'}
 315      @{$sections{"IMPLEMENTATION"}}) ) # then all other class / type decls
 316   {
 317     print_classdecl ($i);
 318   }
 319
 320
 321 # XXX should we print #defines here?
 322
 323 print_head ("\n" .
 324             "//\n" .
 325             "// IMPLEMENTATION of inline functions follows\n".
 326             "//\n\n");
 327 print_inlines (@inline_order_private);
 328
 329 clear_head();
 330 print_head ("\n" .
 331             "//\n" .
 332             "// IMPLEMENTATION of function templates\n" .
 333             "//\n\n");
 334 foreach my $i (grep
 335               {
 336                 $_->{type} eq 'function' && $_->{template} ne ''
 337                 && $_->{fully_specialized_template} eq ''
 338                 && ! defined $public_inline{$_}
 339                 && ! defined $private_inline{$_}
 340                 && ($_->{visibility} eq 'static'
 341                     || ($_->{class} ne ''
 342                         && ($classes{$_->{class}}->{section} ne 'INTERFACE' &&
 343                             !defined $public_inline{$classes{$_->{class}}})))
 344               } @{$sections{"IMPLEMENTATION"}})
 345   {
 346     print_funcdef $i;
 347   }
 348
 349 clear_head();
 350
 351 print OUT "\n#endif // ${incfile_base_macro}_i_$header_ext\n";
 352 close OUT;
 353
 354 $doing_linenumbers = (! $opt_l);
 355
 356 #
 357 # Print implementation file(s)
 358 #
 359
 360 foreach my $part (keys %impl_parts)
 361   {
 362     my $filename = $outfile_base.($part eq '' ? '' : ('-' . $part)) . ".$source_ext";
 363     my $empty = 1;
 364     #print "==> $filename\n";
 365     open(OUT, ">$filename") || die "Could not open $filename for writing!";
 366     print OUT "// AUTOMATICALLY GENERATED -- DO NOT EDIT!         -*- c++ -*-\n\n";
 367     print OUT "#include \"${public_base}.$header_ext\"\n" .
 368               "#include \"${incfile_base}_i.$header_ext\"\n\n";
 369
 370     foreach my $i (grep {$_->{type} eq 'function' && $_->{class} eq ''
 371                         && $_->{static}}
 372                      grep {$_->{part_ext} eq $part} @{$sections{"IMPLEMENTATION"}})
 373       {
 374         print_funcdecl $i;
 375       }
 376
 377     # Print unparsed code first -- make private inline functions see
 378     # static variables
 379
 380     foreach my $i (grep {$_->{part_ext} eq $part
 381                          && $_->{type} eq 'code'}
 382                    @{$sections{"IMPLEMENTATION"}})
 383       {
 384         print_code $i;
 385         $empty = 0;
 386       }
 387
 388     print_inlines (grep {$_->{part_ext} eq $part} @inline_order_unit);
 389
 390     foreach my $i (grep {$_->{part_ext} eq $part
 391                          && $_->{type} eq 'function'}
 392                    @{$sections{"IMPLEMENTATION"}})
 393       {
 394         next if $i->{template} ne ''
 395           && $i->{fully_specialized_template} eq '';
 396
 397         print_funcdef $i;
 398         $empty = 0;
 399       }
 400
 401     truncate OUT,0 if $empty && $opt_t;
 402     close OUT;
 403   }
 404
 405
 406 exit 0;
 407
 408 #############################################################################
 409
 410 #
 411 # Parser code.
 412 #
 413
 414 my $s_once;          # Regexp for whitespace; the \001 stuff is for comments
 415 my $s;               # Zero or more whitespace
 416 my $identifier;      # Identifier
 417 my $operator_name;   # Operator name
 418 my $paren_group;
 419 my $paren_expr;
 420 my $tparen_group;
 421 my $template;        # Template declaration tag
 422 my $template_arg;    # Template argument list
 423
 424 my $lineno;          # current line to be parsed
 425 my $blockfile;       # file that contains the currently pares block
 426 my $blockstart;      # first line of the current block
 427 my $current_section; # current section
 428 my $current_part;
 429 my $current_part_ext;
 430 my @ifstack;         # stack of #if clauses
 431
 432
 433 sub parse_init                  # Initialize parser variables.
 434 {
 435   # Regexp for whitespace; the \001 stuff is for comments
 436   $s_once = '(?:[\n\s]|\001[0-9]+\001)';
 437
 438   # Zero or more whitespace
 439   $s = $s_once . '*';
 440
 441   # Identifier
 442   $identifier = "(?:[A-Za-z_][A-Za-z_0-9]*)";
 443
 444   # Operator name
 445   $operator_name = "(?:operator$s(?:"
 446                   .'(?:[~,]|[+\-*/%^&|!=<>]=?|[<>]{2}=?|[&|+\-]{2}|->\*?'
 447                   .'|\(\)|(?:new|delete)?'.$s.'\[\])'."|$identifier))";
 448
 449
 450   $paren_group = qr{
 451                       \(
 452                       (?:
 453                          (?> [^()]+ )    # Non-parens without backtracking
 454                        |
 455                          (??{ $paren_group })     # Group with matching parens
 456                       )*
 457                       \)
 458                   }x;
 459
 460   $paren_expr = qr{ (?> $paren_group | [^()]+ )* }x;
 461
 462   # Template argument list -- similar to paren_group above
 463   $tparen_group = qr { < (?: (?> [^<>]+ ) | (??{ $tparen_group }) )* > }x;
 464
 465   # Template argument list
 466   $template_arg = qr{ (?> $tparen_group) }x;
 467
 468   # Template declaration tag
 469   $template = qr{template$s$template_arg$s};
 470
 471 }
 472
 473 sub match_e_opt
 474 {
 475   my $tag = shift;
 476   my $cp = '';
 477
 478   my $t = '\(\)&|,\{\}!-';
 479   my $orig_tag = $tag;
 480
 481   while ($tag =~ /^\s*([$t]|(?:[^\s$t]+))\s*(.*?)$/)
 482     {
 483       my $r = $parts{$1};
 484       $cp .= defined $r ? $r : 0;
 485       $tag = $2;
 486     }
 487
 488   my $match = eval $cp;
 489   #print "TAG: $tag -> $cp = $match\n";
 490   if (!defined $match)
 491     {
 492       die "${ARGV}:$lineno: error: syntax error in tag '$tag'\n";
 493     }
 494
 495   if (($verbose || $opt_d) && (!defined $match || !$match))
 496     {
 497       print "Drop SECTION: [$orig_tag] from".
 498         " file ${ARGV}\n";
 499     }
 500
 501   return $match;
 502 }
 503
 504 sub parse_file
 505 {
 506   $lineno = 0;
 507   @ifstack = ();
 508
 509   $current_section = "IMPLEMENTATION";
 510   $current_part = "";
 511   my $skip_to_next_section = 0;
 512
 513  NEXTLINE:
 514   while (1)
 515     {
 516 #print "PARSED: $_\n";
 517       $_ = '';
 518       $blockstart = $lineno + 1;
 519       $blockfile = $ARGV;
 520
 521     MORE:
 522       while (1)
 523         {
 524           if (! read_more())
 525             {
 526               last NEXTLINE;
 527             }
 528
 529           if (/^$s\/\/-[\s\n]*$/s)
 530             {
 531               handle_source_code ();
 532               next NEXTLINE;
 533             }
 534
 535           if (s/^($s)
 536                 (?:(INTERFACE
 537                     | IMPLEMENTATION)
 538                       (?:$s \[ $s ([A-Za-z0-9_,\{\}!\s&|\(\)-]+) $s \] $s)? : )
 539                /$1/sx)
 540             {
 541               check_empty_ifstack();
 542               $skip_to_next_section = 0;
 543               $current_section = $2;
 544               if ($opt_e ne '' || $current_section eq "IMPLEMENTATION")
 545                 {
 546                   if (defined $3)
 547                     {
 548                       $current_part = $3;
 549                       if ($opt_e ne '')
 550                         {
 551                           $skip_to_next_section = !match_e_opt($current_part);
 552                           next NEXTLINE if $skip_to_next_section;
 553                         }
 554                     }
 555                   else
 556                     {
 557                       $current_part = '';
 558                     }
 559                 }
 560               else
 561                 {
 562                   if (defined $3 && $opt_h ne $3)
 563                     {
 564                       die "${ARGV}:${lineno}: all INTERFACE arguments and "
 565                         . "option -h must be consistent;"
 566                           if ($opt_h ne '');
 567
 568                       $public_base = $3;
 569                       $opt_h = $3;
 570                       if ($opt_o eq '')
 571                         {
 572                           $headerfile_base = $opt_p . $public_base
 573                         }
 574                     }
 575                 }
 576               handle_source_code ();
 577               next NEXTLINE;
 578             }
 579           elsif ($skip_to_next_section)
 580             {
 581               next NEXTLINE;
 582             }
 583
 584           # Preprocessor directive?
 585           if (/^$s\#/s)
 586             {
 587               while (/\\\n$/s)
 588                 {
 589                   last NEXTLINE if ! read_more();
 590                 }
 591
 592               handle_preproc();
 593               next NEXTLINE;
 594             }
 595
 596           next NEXTLINE if ignoring();
 597
 598           # Read until we can decide what we have: Read till next block end
 599           # or semicolon.
 600           if (/\{/)
 601             {
 602               # Have a block.
 603               my $foo = $_;
 604               do {} while ($foo =~ s/\{[^\{\}]*\}//sg); # kill blocks
 605               if ($foo =~ /\{/)
 606                 {
 607 #print "MORE: $foo\n";
 608                   next MORE;    # Still unfinished blocks.
 609                 }
 610             }
 611           elsif (! /;/) # no unclosed blocks & semicolon?
 612             {
 613               next MORE;
 614             }
 615
 616           # Type declaration?
 617           if (/^$s(?:$template)?(enum|struct|class|typedef)/s)
 618             {
 619               my $syntax = $1;
 620
 621               if (/^$s(?:$template)?
 622                     (?:enum|struct|class)
 623                     $s ($identifier (?:$s $template_arg)?)
 624                     $s (?::(?!:)|\{)/sx)
 625                 {
 626                   # Have a block -> this is a definition.
 627
 628                   my $name = $1;
 629
 630                   if (/^(.*)(\}.*)$/s)
 631                     {
 632                       my $class = { name => $name,
 633                                     syntax => $syntax,
 634                                     pretext => $1,
 635                                     posttext => $2 };
 636 #print "CLASS " . $class->{name} . ">" .$class->{pretext} . "###" . $class->{posttext};
 637                       handle_classdef ($class);
 638                     }
 639                 }
 640               else
 641                 {
 642                   # No block or no name -- handle as declaration.
 643                   if (/^$s(?:$template)?(?:enum|struct|class)$s\{/s)
 644                     {
 645                       # no name but block -- make this a global variable decl.
 646                       handle_source_code ();
 647                     }
 648                   elsif (/^$s(?:$template)?(?:enum|struct|class)/s)
 649                     {
 650                       # no block -- this seems to be a forward
 651                       # decl. or a variable decl.
 652
 653                       if (/^$s(?:$template)?(?:enum|struct|class)$s
 654                           ($identifier) $s ;/sx)
 655                         {
 656                           my $class = { syntax => 'forwarddecl',
 657                                         name => $1 };
 658                           handle_classdef ($class);
 659                         }
 660                       else
 661                         {
 662                           handle_source_code ();
 663                         }
 664                     }
 665                   elsif (/^${s} typedef \b /sx) # It's a typedef
 666                     {
 667                       # strip off function args and array spec
 668                       my $l = $_;
 669                       $l =~ s/; $s $//sx;
 670                       $l =~ s/\([^\)]*\) (?:${s}const)? $s $//sx;
 671                       $l =~ s/(?: \[ [^\[]* \] $s | \) $s )+ $//sx;
 672                       $l =~ m/($identifier) $s $/sx;
 673
 674                       my $class = { syntax => 'typedef',
 675                                     name => $1 };
 676                       handle_classdef ($class);
 677                     }
 678                   else
 679                     {
 680                       die "${ARGV}:$lineno: Parse error";
 681                     }
 682                 }
 683
 684               next NEXTLINE;
 685             }
 686
 687           # Type declaration extension?
 688           if (/^$s EXTENSION $s (?:struct|class) $s ($identifier)
 689                $s (?::(?!:) $s ([^\{]*))?\{ (.*) \} $s ; $s $/sx)
 690             {
 691               my $super = $2;
 692               my $name = $1;
 693               my $string = $3;
 694
 695               if (! exists $classes{$name})
 696                 {
 697                   die "${ARGV}:$lineno: Class extension for undefined class " .
 698                       $name;
 699                 }
 700
 701               # XXX XXX we should not handle line directives here --
 702               # this is the job of the output functions.  However, as
 703               # we don't generate a new codechunk for this extension,
 704               # we just add the extension's line number here.
 705
 706               if ($doing_linenumbers)
 707                 {
 708                   $classes{$name}->{pretext} .=
 709                     "\n#line " . $blockstart . " \"" . $ARGV . "\"\n";
 710                 }
 711
 712                 my $txt = \($classes{$name}->{pretext});
 713
 714                 if (defined $super)
 715                   {
 716                     if ($$txt =~ /^([^\{]*)/sx)
 717                       {
 718                         my $pre = $1;
 719                         if ($pre =~ /^.*:(?!:)(.*)$/sx)
 720                           {
 721                             $$txt =~ s/^$pre/$pre\n, $super/s;
 722 #                           print "ADD super classes: , $super\n";
 723                           }
 724                         else
 725                           {
 726                             $$txt =~ s/^$pre/$pre\n: $super/s;
 727                           }
 728                       }
 729                   }
 730
 731               $classes{$name}->{pretext} .= "private:\n" . $string;
 732
 733               next NEXTLINE;
 734             }
 735
 736           # Member function definition?
 737 #          if (/^([^\{\(]*?)             # pretext, maybe w template decl tag
 738           if (/^((?:[^\{\(]|\(\()*?)             # pretext, maybe w template decl tag
 739                \b ($identifier (?: $s :: $s $identifier)*) # class name
 740                ($s $template_arg)?      # optional class-template args
 741                $s :: $s
 742                ((?:$operator_name | (?: ~? $identifier )) # member name
 743                 (?:$s $template_arg)?)  # optional member-template args
 744                $s ( \( (?: [^\)] | \([^\)]*\) )* \) [^:\{=]* ) # arg list
 745                ((?:\{|:.*\{).* | (?:$s = $s 0 $s ;))$/sx)    # initializer ':' and body '{' or pure virtual
 746             {
 747               my ($pretext, $class, $templateargs, $name, $args, $posttext)
 748                 = ($1, $2, (defined $3 ? $3 : ''), $4, $5, $6);
 749 #print "Member: P<$pretext> C<$class> T<$templateargs> N<$name> A<$args> P<$posttext>\n";
 750               # Canonify operator names
 751               $name =~ s/(?<=\w)(?:$s_once)+(?=\W)//gs;
 752               $name =~ s/(?<=\W)(?:$s_once)+(?=\w)//gs;
 753               $name =~ s/(?:$s_once)+/ /gs;
 754               # Canonify class name
 755               $class =~ s/$s//gs;
 756               my $memberfunction = { class => $class,
 757                                      name => $name,
 758                                      templateargs => $templateargs,
 759                                      pretext => $pretext,
 760                                      args => $args,
 761                                      posttext => $posttext };
 762               handle_function ($memberfunction);
 763               next NEXTLINE;
 764             }
 765
 766           # Free function definition?
 767           if (/^([^\{]*)                # pretext, maybe w template decl tag
 768                \b ($operator_name | $identifier) # function name
 769                ($s $template_arg)?      # optional template args
 770                $s( \( $paren_expr \) [^:\{\(\)=]*) # arg list
 771                (\{.*)$/sx)              # body
 772             {
 773 #print "Free function: $2 T(" . (defined $3 ? $3 : "") . ") PRE($1) ARGS($4) POST($5)\n";
 774               my $function = { class => '',
 775                                name => $2,
 776                                templateargs => (defined $3
 777                                                 ? $3 : ''),
 778                                pretext => $1,
 779                                args => $4,
 780                                posttext => $5 };
 781               handle_function ($function);
 782               next NEXTLINE;
 783             }
 784
 785           handle_source_code ();
 786           next NEXTLINE;
 787         }
 788     }
 789
 790   if (! /^$s$/s)
 791     {
 792       $verbose && print "EOF: " . $_ . "\n";
 793       die "${blockfile}:$blockstart: Unexpected end of file in block starting here;";
 794     }
 795
 796 }
 797
 798 sub read_more ()        # Read one more line of code. Stow away
 799                         # comments and character constants
 800 {
 801   # Get a line without comments.
 802   while (1)
 803     {
 804       if (eof(INPUT))                   # Reset line numbering.
 805         {
 806           check_empty_ifstack();
 807           $lineno = 0;
 808           do
 809             {
 810               my $file;
 811               return 0 unless $file = shift @ARGV;
 812               $ARGV = $file;
 813               open(INPUT, $ARGV) || die "Cannot open $ARGV for reading!";
 814               if ($opt_s)
 815                 {
 816 #      print "FILE: $ARGV\n";
 817                   my $part_ext = '';
 818                   if ($ARGV =~ /^(?:.*\/)?(.+)$/ && $1 =~ /(?:[^-]*)-(.*)\..*/)
 819                     {
 820                       $part_ext = $1;
 821                     }
 822                   $current_part_ext = $part_ext;
 823                   $impl_parts{$part_ext} = 1;
 824 #      print "PART: '$part_ext'\n";
 825                 }
 826               print "read file: '$ARGV'\n" if $verbose;
 827             }
 828           while(eof(INPUT));
 829         }
 830
 831       $lineno++;
 832
 833       my $line = <INPUT>;
 834
 835       if (! defined $line)
 836         {
 837           return 0;
 838         }
 839
 840       $_ .= $line;
 841
 842       # Save comments and strings in @comments array.  Save strings
 843       # first to catch strings with comment-like contents.
 844       my $number = @comments;
 845
 846       # We don't touch strings in NEEDS[], neither #includes!  Save now --
 847       # restore later.
 848       my $saved = '';
 849       if (s/(^$s \# $s include.*$
 850              | NEEDS $s \[[^\]]* )
 851            /\003/sx)
 852         {
 853           $saved = $1;
 854         }
 855
 856       while (s,(\'(?:\\.|[^\']|\\[0-7]+)\'),\002$number\002,s)
 857         {
 858           push @comments, $1;
 859           $number++;
 860         }
 861
 862 #      while (s,(\"(?:[^\"]|(?<=\\)\")*\"),\002$number\002,s)
 863       while (s,(\"(?:[^\\\"]|\\.)*\"),\002$number\002,s)
 864         {
 865           push @comments, $1;
 866           $number++;
 867         }
 868
 869       if ($saved ne '')
 870         {
 871           s/\003/$saved/s;
 872         }
 873
 874       while (s|(//(?!-\s*\n).*\n)|\001$number\001|m) # Do not match magic "//-"
 875         {                       # The \001 signifies whitespace.
 876           push @comments, $1;
 877           $number++;
 878         }
 879
 880       while (s|(/\*.*\*/)|\001$number\001|s)
 881         {
 882           push @comments, $1;
 883           $number++;
 884         }
 885
 886       if (! /\/\*/)
 887         {
 888           last;
 889         }
 890     }
 891
 892   return 1;
 893 }
 894
 895 sub label_chunk
 896 {
 897   my ($codechunk,$type) = @_;
 898
 899   $codechunk->{type} = $type;
 900   $codechunk->{section} = $current_section;
 901   $codechunk->{string} = $_;
 902   $codechunk->{part} = $current_part;
 903   $codechunk->{part_ext} = $opt_s ? $current_part_ext : $current_part;
 904
 905   $impl_parts{$current_part} = 1 unless $opt_s;
 906
 907   $codechunk->{line} = $blockstart;
 908   $codechunk->{file} = $ARGV;
 909   $codechunk->{printed} = 0;
 910
 911   push @{$sections{$current_section}}, $codechunk;
 912 }
 913
 914 sub ignoring
 915 {
 916   foreach my $i (@ifstack)
 917     {
 918       if ($i->{value} == 1)
 919         {
 920           return 1;
 921         }
 922     }
 923
 924   return 0;
 925 }
 926
 927 sub handle_preproc
 928 {
 929 #   if ($codeblock->{string} =~ /^$s\#\s*(if|endif|else|elif)/)
 930 #     {
 931 #       die "${ARGV}:${lineno}: Conditional compilation not supported;";
 932 #     }
 933
 934   if (/^$s\#\s*if\s+0${s}$/)
 935     {
 936       push @ifstack, { value => 1, file => ${ARGV}, line => $lineno };
 937       $verbose && print "IF 0: " . ignoring() . "\n";
 938       return;
 939     }
 940   elsif (@ifstack && /^$s\#\s*if(def|ndef)?\s/)
 941     {
 942       push @ifstack, { value => 0, file => ${ARGV}, line => $lineno };
 943       $verbose && print "IF: " . ignoring() . "\n";
 944       return if ignoring();
 945     }
 946   elsif (@ifstack && /^$s\#\s*(else|elif)/)
 947     {
 948       my $ignoring = ignoring();
 949       my $i = pop @ifstack;
 950       $i->{value} = -$i->{value};
 951       push @ifstack, $i;
 952       $verbose && print "ELSE/ELIF: " . ignoring() . " ($ignoring)\n";
 953       return if $ignoring;
 954     }
 955   elsif (@ifstack && /^$s\#\s*endif/)
 956     {
 957       my $ignoring = pop @ifstack;
 958       $verbose && print "ENDIF: " . ignoring() . "\n";
 959       return if ignoring() || $ignoring->{value};
 960     }
 961   elsif (/^$s\#\s*include${s}([\"<][^\">]+[\">])/)
 962     {
 963       my $codeblock;
 964       $codeblock->{name} = $1;
 965       $codeblock->{inline} = 0;
 966
 967       $includes{$codeblock->{name}} = $codeblock;
 968
 969       label_chunk ($codeblock, "include");
 970
 971       $verbose && print "INCLUDE: " . $codeblock->{name} . "\n";
 972       return;
 973     }
 974
 975   # XXX: For now, treat preprocessor stuff besides #include, #if 0 as code.
 976   handle_source_code ();
 977 }
 978
 979 sub dump_ifstack
 980 {
 981   my $indent = '';
 982   foreach my $i (@ifstack)
 983     {
 984       print "$indent$i->{value}: $i->{file}:$i->{line}\n";
 985       $indent .= '  ';
 986     }
 987 }
 988
 989 sub check_empty_ifstack
 990 {
 991   if ($#ifstack >= 0)
 992   {
 993     my $i = pop @ifstack;
 994     print STDERR "${ARGV}:${lineno}: missing endif for $i->{file}:$i->{line}\n";
 995     die;
 996     $status = -1;
 997   }
 998 }
 999
1000 sub handle_source_code
1001 {
1002   return if /^[\s\n]*$/;
1003
1004   my $codeblock = {};
1005   label_chunk ($codeblock, "code");
1006
1007   $verbose && print "UNKNOWN: " . $codeblock->{string};
1008 }
1009
1010 sub handle_classdef
1011 {
1012   my $class = $_[0];
1013   label_chunk ($class, "classdef");
1014
1015   $class->{funcs} = [];
1016
1017   if ($class->{syntax} ne 'forwarddecl')
1018     {
1019       $classes{$class->{name}} = $class;
1020     }
1021
1022   $verbose && print "CLASSDEF: " . $class->{name} . " ["
1023     . $class->{syntax} . "]\n";
1024 }
1025
1026 sub handle_function
1027 {
1028   my $func = $_[0];
1029
1030   $func->{purevirtual} = 0;
1031
1032   if ($func->{class} ne '')
1033     {
1034       # Nested class hacks
1035       if ($func->{class} =~ /::/
1036           && ! defined $classes{$func->{class}})
1037         {
1038           # Define class along the way -- the dirty way.
1039           my $class = { name => $func->{class},
1040                         syntax => "class",
1041                         nested_class => 1 };
1042           my ($topclass, $rest) = split (/::/, $func->{class});
1043           my $save_sec = $current_section;
1044           $current_section = $classes{$topclass}->{section};
1045           handle_classdef ($class);
1046           $current_section = $save_sec;
1047         }
1048
1049       $func->{visibility} = "private";
1050       if (s/^($s)PRIVATE([\s\n])/$1$2/s)
1051         {
1052           $func->{visibility} = "private";
1053           $func->{pretext} =~ s|PRIVATE[ \t]*||s;
1054         }
1055       elsif (s/^($s)PUBLIC([\s\n])/$1$2/s)
1056         {
1057           $func->{visibility} = "public";
1058           $func->{pretext} =~ s|PUBLIC[ \t]*||s;
1059         }
1060       elsif (s/^($s)PROTECTED([\s\n])/$1$2/s)
1061         {
1062           $func->{visibility} = "protected";
1063           $func->{pretext} =~ s|PROTECTED[ \t]*||s;
1064         }
1065       elsif (s/^($s)IMPLEMENT([\s\n])/$1$2/s)
1066         {
1067           # Use a visibility attribute that is never used in adding
1068           # declarations to classes in print_classdecl.
1069           $func->{visibility} = "implementation_only";
1070           $func->{pretext} =~ s|IMPLEMENT[ \t]*||s;
1071         }
1072       elsif (s/^($s)IMPLEMENT_DEFAULT([\s\n])/$1$2/s)
1073         {
1074           # Use a visibility attribute that is never used in adding
1075           # declarations to classes in print_classdecl.
1076           $func->{visibility} = "implementation_only";
1077           $func->{default_impl} = 1;
1078           $func->{pretext} =~ s|IMPLEMENT_DEFAULT[ \t]*||s;
1079         }
1080
1081       if ($func->{posttext} =~ s/$s=${s}0$s;$s$//s)
1082         {
1083           $func->{purevirtual} = 1;
1084         }
1085
1086       if ($func->{class} =~ /::/
1087           && $func->{visibility} ne "implementation_only")
1088         {
1089           die "${ARGV}:${lineno}: Limitation: Only predeclared members " .
1090             "supported for nested classes.  Use IMPLEMENT;";
1091         }
1092
1093       if (! defined $classes{$func->{class}})
1094         {
1095           die "${ARGV}:${lineno}: Class " . $func->{class}
1096             . " has not been declared;";
1097         }
1098     }
1099   else
1100     {
1101       $func->{visibility} = "free";
1102     }
1103
1104   # Interprete more type attributes.
1105   $func->{inline} = 0;
1106   $func->{always_inline} = 0;
1107   $func->{static} = 0;
1108   $func->{hide} = 0;
1109   $func->{virtual} = 0;
1110   $func->{explicit} = 0;
1111   $func->{classtemplate} = '';
1112   $func->{funtemplate} = '';
1113   $func->{template} = '';
1114   $func->{fully_specialized_template} = '';
1115   while (1)
1116     {
1117       if (s/^($s)((?:$template)+)([\s\n])/$1$3/s)
1118         {
1119           my $match = $2;
1120           my @specs = split(/(?<= \>)(?= $s template)/sx, $match, 3);
1121
1122           if ($func->{class} eq '') # Free function?
1123             {
1124               $func->{funtemplate} = shift @specs;
1125             }
1126           else                  # Have a class
1127             {
1128               my $class = $classes{$func->{class}};
1129               my $istemplateclass = ($class->{pretext} =~ /^[^\{]*template/s);
1130
1131               if ($istemplateclass)
1132                 {
1133                   $func->{classtemplate} = shift @specs;
1134                   $func->{funtemplate} = shift @specs if scalar @specs;
1135                 }
1136               else              # Not a class template
1137                 {
1138                   $func->{funtemplate} = shift @specs;
1139                 }
1140             }
1141
1142           die "${ARGV}:$lineno: Too many template specs"
1143             if scalar @specs;
1144
1145           $func->{template} = 'yes';
1146           $func->{fully_specialized_template} = 'yes'
1147             if ($match =~ /^(?:${s}template$s<${s}>)+${s}$/s);
1148
1149           $func->{pretext} =~ s/\Q$match//s;
1150           next;
1151         }
1152
1153       if (s/^($s)inline([\s\n])/$1$2/si) # "inline" is case-insensitive.
1154         {
1155           $func->{inline} = 1 if $doing_inlines
1156                                  || $func->{fully_specialized_template} ne '';
1157           $func->{pretext} =~ s|inline[ \t]*||si;
1158           @{$func->{needs}} = ();
1159           while (1)
1160             {
1161               if (s/^($s)NEEDS\s*\[([^\]]+)\]([\s\n])/$1$3/s)
1162                 {
1163                   @{$func->{needs}} = split (/\s*,\s*/, $2);
1164                   # Delete NEEDS directive, but keep newlines
1165                   while ($func->{pretext} =~
1166                          s|NEEDS \s* \[ ( (?:[^\n\]]*\n)* )
1167                            [^\n\]]+ \n (\n*)
1168                            [^\n\]]* \]
1169                           |NEEDS[$1\n$2\]|sx) {}
1170                   $func->{pretext} =~ s|NEEDS\s*\[ (\n*) [^\n\]]*\]|$1|sx;
1171                   next;
1172                 }
1173               if (s/^($s)NOEXPORT([\s\n])/$1$2/si)
1174                 {
1175                   $func->{hide} = 1;
1176                   $func->{pretext} =~ s|NOEXPORT[ \t]*||s;
1177                   next;
1178                 }
1179               if (s/^($s)ALWAYS_INLINE([\s\n])/$1$2/si)
1180                 {
1181                   $func->{inline} = 1;
1182                   $func->{always_inline} = 1;
1183                   $func->{pretext} =~ s|ALWAYS_INLINE[ \t]*||s;
1184                   next;
1185                 }
1186               last;
1187             }
1188
1189           # Reset inline data if inline handling was not enabled by -i
1190           # or ALWAYS_INLINE.
1191           if (! $func->{inline})
1192             {
1193               undef $func->{needs};
1194             }
1195           next;
1196         }
1197
1198
1199       if (s/^($s)static([\s\n])/$1$2/s)
1200         {
1201           $func->{static} = 1;
1202           $func->{pretext} =~ s/static[ \t]*//s;
1203
1204           if ($func->{class} eq '')
1205             {
1206               $func->{visibility} = "static";
1207               $func->{hide} = 1;
1208             }
1209
1210           next;
1211         }
1212
1213       if (s/^($s)IMPLEMENT([\s\n])/$1$2/s)
1214         {
1215           $func->{pretext} =~ s/IMPLEMENT[ \t]*//s;
1216
1217           if ($func->{class} eq '')
1218             {
1219               $func->{visibility} = "implementation_only";
1220             }
1221
1222           next;
1223         }
1224       if (s/^($s)IMPLEMENT_DEFAULT([\s\n])/$1$2/s)
1225         {
1226           $func->{pretext} =~ s/IMPLEMENT_DEFAULT[ \t]*//s;
1227
1228           if ($func->{class} eq '')
1229             {
1230               $func->{visibility} = "implementation_only";
1231               $func->{default_impl} = 1;
1232             }
1233
1234           next;
1235         }
1236
1237       if (s/^($s)explicit([\s\n])/$1$2/s)
1238         {
1239           $func->{explicit} = 1;
1240           $func->{pretext} =~ s|explicit[ \t]*||s;
1241           next;
1242         }
1243
1244       if (s/^($s)virtual([\s\n])/$1$2/s)
1245         {
1246           $func->{virtual} = 1;
1247           $func->{pretext} =~ s|virtual[ \t]*||s;
1248           next;
1249         }
1250
1251       if (/^($s)(PRIVATE|PUBLIC|PROTECTED)([\s\n])/)
1252         {
1253           die "${blockfile}:$blockstart: only one visibility attribute allowed at start of declaration;";
1254         }
1255
1256       last;
1257   }
1258
1259   label_chunk ($func, "function");
1260
1261   if ($current_section eq 'INTERFACE')
1262     {
1263       die "${ARGV}:${lineno}: Function " . $func->{name}
1264           . " in INTERFACE section;";
1265     }
1266
1267   if (defined $functions{"$func->{class}::$func->{name}"})
1268     {
1269       my $f = $functions{"$func->{class}::$func->{name}"};
1270       if (defined $f->{default_impl})
1271         {
1272           $f->{printed} = 1;
1273         }
1274       elsif (defined $func->{default_impl})
1275         {
1276           $func->{printed} = 1;
1277         }
1278     }
1279   else
1280     {
1281       $functions{"$func->{class}::$func->{name}"} = $func;
1282     }
1283
1284   push @{$classes{$func->{class}}->{funcs}}, $func;
1285
1286   $verbose && print "FUNC: " . ($func->{class} ne ''
1287                                 ? ($func->{class} . "::")
1288                                 : "")
1289     . $func->{name}
1290     . ($func->{classtemplate} ne ''
1291        ? " T: " . $func->{classtemplate} : "")
1292     . ($func->{funtemplate} ne ''
1293        ? " M: " . $func->{funtemplate} : "")
1294     . ($func->{fully_specialized_template} ne ''
1295        ? " FULLY_SPEC" : "")
1296     . "\n";
1297 }
1298
1299 #############################################################################
1300
1301 #
1302 # Printing code.
1303 #
1304
1305 my $saved_head;
1306 my $saved_indent;
1307
1308 sub print_head                  # Save header.  Print it only if a
1309                                 # print_expand() follows
1310 {
1311   $saved_head .= $_[0];
1312   $saved_indent = $print_indent;
1313 }
1314
1315 sub clear_head
1316 {
1317   $saved_head = '';
1318 }
1319
1320 sub print_expand($)             # Expands comments and prints to OUT.
1321 {
1322   my $str = $_[0];
1323
1324   if ($saved_head ne '')
1325     {
1326       local $print_indent = $saved_indent;
1327       my $str = $saved_head;
1328       $saved_head = '';
1329
1330       print_expand $str;        # Recurse.
1331     }
1332
1333   $str =~ s/\n(?:[ \t]*\n)+/\n\n/sg if ! $doing_linenumbers;
1334
1335   while ( $str =~ s/([\001\002])([0-9]+)\1/$comments[$2]/sg )
1336     {}
1337
1338   if ($print_indent)
1339     {
1340       my $istr = " " x $print_indent;
1341       $str =~ s/^/$istr/mg;
1342     }
1343
1344   print OUT $str;
1345 }
1346
1347 sub print_lineno($)
1348 {
1349   return if ! $doing_linenumbers;
1350
1351   my $object = $_[0];
1352
1353   print_expand '';              # print headers we accumulated
1354   print OUT "#line " . $object->{line} . " \"" . $object->{file} . "\"\n";
1355 }
1356
1357 sub print_lineno_sans_empty_lines($)
1358 {
1359   return if ! $doing_linenumbers;
1360
1361   my $object = $_[0];
1362
1363   my $start_of_code = $object->{string};
1364   $start_of_code =~ s/^([\s\n]+).*$/$1/s;
1365
1366   my @startcomments = split /\n/, " $start_of_code ";
1367
1368   print OUT "#line " . ($object->{line} + @startcomments - 1)
1369     . " \"" . $object->{file} . "\"\n";
1370 }
1371
1372 sub weedout_whitespace          # Delete whitespace except on lines w/comments
1373 {
1374   my $str = $_[0];
1375
1376   $str =~ s/^[\s\n]+//s;
1377
1378   if (! $doing_linenumbers)     # more cosmetic changes if we do not
1379     {                           # have to be correct line-number-wise
1380       my @lines = split /\n/, $str;
1381       my $foundcode = 0;
1382       $str = '';
1383
1384       foreach my $line (@lines)
1385         {
1386           $line =~ s/^\s+//;
1387           $line =~ s/\s+$//;
1388
1389           if ($line =~ /\001/ || $line =~ /^\s*$/)
1390             {
1391               $line .= "\n";
1392             }
1393           else
1394             {
1395               if (! $foundcode)
1396                 {
1397                   $foundcode = 1;
1398
1399                   # Found something like code: Remove trailing whitespace
1400                   # from $str,
1401                   $str =~ s/\s+$//s;
1402                   $str .= "\n" if $str ne '';
1403                 }
1404
1405               $line =~ s/\s+/ /g;
1406               $line .= ' ';
1407             }
1408           $str .= $line;
1409         }
1410     }
1411
1412   $str =~ s/\s+$//;
1413
1414   return $str;
1415 }
1416
1417 sub func_prototype($)           # Return a function declaration from
1418                                 # func head.
1419 {
1420   my $func = $_[0];
1421   my $pretext = $func->{pretext};
1422
1423   if ($func->{inline})
1424     {
1425       $pretext =~ s/^($s)/${1}inline /s;
1426     }
1427
1428   if ($func->{explicit})
1429     {
1430       $pretext =~ s/^($s)/${1}explicit /s;
1431     }
1432
1433   if ($func->{static})
1434     {
1435       $pretext =~ s/^($s)/${1}static /s;
1436     }
1437
1438   if ($func->{virtual})
1439     {
1440       $pretext =~ s/^($s)/${1}virtual /s;
1441     }
1442
1443   if ($func->{funtemplate} ne '')
1444     {
1445       $pretext =~ s/^($s)/${1}$func->{funtemplate} /s;
1446     }
1447
1448   my $func_header = weedout_whitespace($pretext .
1449                                        $func->{name} . $func->{args});
1450
1451   # Insert ; at the correct place, that is, before any comments.
1452   my $e = $func->{purevirtual} ? ' = 0' : '';
1453   $func_header =~ s/($s)$/$e;$1/s;
1454
1455   return $func_header;
1456 }
1457
1458 sub print_funcdecl($)
1459 {
1460   my $function = $_[0];
1461
1462   if ($function->{visibility} ne "implementation_only")
1463     {
1464       print_expand "\n";
1465       print_lineno_sans_empty_lines $function;
1466       print_expand func_prototype($function) . "\n";
1467     }
1468
1469   # Handle inlines.
1470   if ($function->{inline})
1471     {
1472       handle_inline ($function);
1473     }
1474 }
1475
1476 sub print_classdecl($)
1477 {
1478   my $class = $_[0];
1479   return if check_if_printed ($class);
1480
1481   print_lineno $class;
1482
1483   if (defined $class->{nested_class})
1484     {
1485       # (This will not actually print anything, but do other processing.)
1486       foreach my $function (@{$class->{funcs}})
1487         {
1488           die "Assert failed"
1489             if $function->{visibility} ne "implementation_only";
1490           print_funcdecl $function;
1491         }
1492     }
1493   elsif ($class->{syntax} =~ /^(?:struct|class)$/)
1494     {
1495       if (! $doing_inlines)
1496         {
1497           $class->{pretext} =~ s/\binline\b[ \t]*//g;
1498         }
1499
1500       print_expand $class->{pretext};
1501
1502       print_head "\npublic:";
1503       $print_indent += 2;
1504       foreach my $function (grep {$_->{visibility} eq "public"}
1505                                  @{$class->{funcs}})
1506         {
1507           print_funcdecl $function;
1508         }
1509       $print_indent -= 2;
1510       clear_head();
1511       print_head "\nprotected:";
1512       $print_indent += 2;
1513       foreach my $function (grep {$_->{visibility} eq "protected"}
1514                                  @{$class->{funcs}})
1515         {
1516           print_funcdecl $function;
1517         }
1518       $print_indent -= 2;
1519       clear_head();
1520       print_head "\nprivate:";
1521       $print_indent += 2;
1522       foreach my $function (grep {$_->{visibility} eq "private"}
1523                                  @{$class->{funcs}})
1524         {
1525           print_funcdecl $function;
1526         }
1527       $print_indent -= 2;
1528       clear_head();
1529
1530       # Also, don't forget to "print" already-declared functions.
1531       # (This will not actually print anything, but do other processing.)
1532       foreach my $function (grep {$_->{visibility} eq "implementation_only"}
1533                                  @{$class->{funcs}})
1534         {
1535           print_funcdecl $function;
1536         }
1537
1538       print_expand $class->{posttext};
1539     }
1540   else
1541     {
1542       print_expand $class->{string};
1543     }
1544 }
1545
1546 my $parengroup;
1547 sub print_funcdef($)
1548 {
1549   my $function = $_[0];
1550   return if $function->{purevirtual};
1551   return if check_if_printed ($function);
1552
1553   my $pretext = $function->{pretext};
1554
1555   if ($function->{inline})
1556     {
1557       if ($function->{always_inline})
1558         {
1559           $pretext =~ s/^($s)/${1}ALWAYS_INLINE /s;
1560         }
1561       $pretext =~ s/^($s)/${1}inline /s;
1562     }
1563
1564   if ($function->{static} && $function->{class} eq '')
1565     {
1566       $pretext =~ s/^($s)/${1}static /s;
1567     }
1568
1569   if ($function->{funtemplate} ne '')
1570     {
1571       $pretext =~ s/^($s)/${1}$function->{funtemplate} /s;
1572     }
1573
1574   if ($function->{classtemplate} ne '')
1575     {
1576       $pretext =~ s/^($s)/${1}$function->{classtemplate} /s;
1577     }
1578
1579   # Remove default arguments from argument list
1580   my $args = $function->{args};
1581   $parengroup = qr{             # Matches correctly-nested groups of parens
1582                       \(
1583                       (?:
1584                        (?> [^()]* )        # Non-parens without backtracking
1585                        |
1586                        (??{ $parengroup }) # Backtrack: Group with parens
1587                       )*
1588                       \)
1589                      }x;
1590   my $expr = qr{ [^(),]* (?:$parengroup)? [^(),]* }x;
1591   $args =~ s/$s = $expr//gx;
1592
1593   print_expand "\n";
1594   print_lineno $function;
1595   print_expand $pretext
1596     . ($function->{class} ne ''
1597        ? $function->{class} . $function->{templateargs}
1598            . "::" . $function->{name}
1599        : $function->{name} . $function->{templateargs})
1600     . $args . $function->{posttext};
1601 }
1602
1603 sub print_code($)
1604 {
1605   my $codeblock = $_[0];
1606   return if check_if_printed ($codeblock);
1607   print_lineno $codeblock;
1608   print_expand $codeblock->{string};
1609 }
1610
1611 sub check_if_printed
1612 {
1613   my $codeblock = $_[0];
1614   return 1 if $codeblock->{printed};
1615   $codeblock->{printed} = 1;
1616   return 0;
1617 }
1618
1619 #############################################################################
1620
1621 #
1622 # Inline-function bookkeeping.
1623 #
1624
1625 sub lookup_by_name              # Return (list of) item(s) matching name.
1626 {
1627   my ($item, $context) = @_;
1628
1629   # Is it a class name?
1630   if (defined $classes{$item})
1631     {
1632       return $classes{$item};
1633     }
1634
1635   # Is it an include file?
1636   if (defined $includes{$item})
1637     {
1638       $includes{$item}->{inline} = 1;
1639       return $includes{$item};
1640     }
1641
1642   # Must be a function name!
1643   my ($classname, $funcname);
1644
1645   if ($item =~ /::/)
1646     {
1647       ($classname, $funcname) = split /::/, $item;
1648     }
1649   else
1650     {
1651       ($classname, $funcname) = ('' , $item);
1652     }
1653
1654   my @grepresult = grep {$_->{name} eq $funcname && $_->{inline}}
1655                          @{$classes{$classname}->{funcs}};
1656
1657   return shift @grepresult
1658     if (scalar @grepresult == 1);
1659
1660   if (scalar @grepresult == 0)
1661     {
1662       my @xgrepresult = grep {$_->{name} eq $funcname}
1663                               @{$classes{$classname}->{funcs}};
1664       die $context->{file} . ":" . $context->{line} . ": Cannot find $item;"
1665         if (scalar @xgrepresult == 0);
1666       $wno_inline && print STDERR $context->{file} . ":" . $context->{line} .
1667                                   ": warning: Cannot find inline code ".
1668                                   "for $item;\n";
1669     }
1670
1671   return @grepresult;   # Return list of matching function names.
1672 }
1673
1674 # Check if Function $function can already see Object $item in its context.
1675 sub inline_known
1676 {
1677   my ($item, $function) = @_;
1678
1679   if ($item->{type} eq "function"
1680       && $item->{hide}
1681       && ! $function->{hide})
1682     {
1683       die $function->{file} . ":" . $function->{line} .
1684         ": Nonhidden function " . funcname($function) .
1685         " depends on hidden function " . funcname($item) . " (" .
1686         ($item->{visibility} eq 'static' ? "static" : "NOEXPORT") . ")";
1687     }
1688
1689   return exists $public_inline{$item}
1690     || (($function->{visibility} eq 'private'
1691          || ($function->{class} ne ''
1692              && $classes{$function->{class}}->{section} eq "IMPLEMENTATION"))
1693         && exists $private_inline{$item})
1694     || ($function->{hide}
1695         && exists $unit_inline{$item});
1696 }
1697
1698 # Put inline function $1 and all its dependencies (given by NEEDS
1699 # directives) into @inline_order_[public/private/unit], depending on
1700 # visibility of $1.  Function handle_inline is called when printing
1701 # inline-function declarations, so the sequence of handle_inline calls
1702 # is determined by declaration-printing order.
1703 sub handle_inline
1704 {
1705   my $function = $_[0];
1706   my $class = $function->{class};
1707   my @needed = ();
1708
1709   $verbose &&
1710     print "INLINE " . funcname($function) . " NEEDS ";
1711
1712   # Add all needed items, then add my own name as well as my class
1713   # name for good measure.
1714   foreach my $item (@{$function->{needs}})
1715     {
1716       push @needed, lookup_by_name ($item, $function);
1717     }
1718
1719   push @needed, $function;
1720   unshift @needed, lookup_by_name ($class, $function)
1721     if ($class ne '');
1722
1723  NEEDEDLOOP:
1724   while (@needed)
1725     {
1726       my $object = $needed[0];
1727
1728       if (inline_known ($object, $function))
1729         {
1730           shift @needed;
1731           next;
1732         }
1733
1734       # Check for further dependencies.
1735       my @moreneeded = ();
1736
1737       if ($object->{type} eq "function" && $object->{class} ne '')
1738         {
1739           my $class = lookup_by_name ($object->{class}, $object);
1740           push @moreneeded, $class;
1741         }
1742
1743       if (defined $object->{needs})
1744         {
1745           foreach my $item (@{$object->{needs}})
1746             {
1747               my $o = lookup_by_name ($item, $object);
1748               next if ! ref $o; # Skip referenced but noninline objects
1749               push @moreneeded, $o;
1750             }
1751         }
1752
1753       # Check if we have everything that's needed for $item.
1754       foreach my $i (@moreneeded)
1755         {
1756           if (inline_known ($i, $function))
1757             {
1758               next;
1759             }
1760
1761           if ($i == $function)  # Function depends on itself!
1762             {
1763               my $callstack = "  " . funcname ($function) . "\n";;
1764               my $prev = $function;
1765               push @needed, $function;
1766               foreach my $j (@needed)
1767                 {
1768                   # $j is not part of call stack if it does not need $prev
1769                   next if ! grep {lookup_by_name ($_, $object) == $prev}
1770                                  @{$j->{needs}};
1771                   $callstack .= "  " . funcname ($j) . "\n";
1772                   $prev = $j;
1773                   last if $j == $function;
1774                 }
1775
1776               die $object->{file} . ":" . $object->{line} . ": Function " .
1777                 funcname ($object) . " NEEDS " . funcname ($i) .
1778                 ", which circularly depends on this function:\n" .
1779                 $callstack;
1780             }
1781
1782           unshift @needed, $i;
1783           next NEEDEDLOOP;
1784         }
1785
1786       $verbose && print &funcname ($object) . " ";
1787
1788       if ($function->{hide})
1789         {
1790           $unit_inline{$object} = 1;
1791           push @inline_order_unit, $object;
1792         }
1793       elsif ($function->{visibility} eq 'private'
1794              || ($class ne ''
1795                  && $classes{$class}->{section} eq "IMPLEMENTATION"))
1796         {
1797           $private_inline{$object} = 1;
1798           push @inline_order_private, $object;
1799         }
1800       else
1801         {
1802           $public_inline{$object} = 1;
1803           push @inline_order_public, $object;
1804         }
1805
1806       shift @needed;
1807     }
1808
1809   $verbose && print "\n";
1810 }
1811
1812 sub print_inlines
1813 {
1814   foreach my $object (grep {$_->{type} eq "classdef"} @_)
1815     {
1816       if ($object->{section} ne 'INTERFACE')
1817         {
1818           print_classdecl $object;
1819         }
1820     }
1821
1822   foreach my $object (grep {$_->{type} eq "function"} @_)
1823     {
1824       print_funcdef $object;
1825     }
1826 }
1827
1828 ######################################################################
1829 #
1830 # Utilities
1831 #
1832 sub funcname
1833 {
1834   my $function = $_[0];
1835
1836   return ($function->{class} ? ($function->{class} . "::") : "")
1837     . $function->{name};
1838 }