tools/winapi/c_parser.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17 #
  18
  19 package c_parser;
  20
  21 use strict;
  22
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw();
  28 @EXPORT_OK = qw();
  29
  30 use options qw($options);
  31 use output qw($output);
  32
  33 use c_function;
  34 use c_type;
  35
  36 # Defined a couple common regexp tidbits
  37 my $CALL_CONVENTION="__cdecl|__stdcall|" .
  38                     "__RPC_API|__RPC_STUB|__RPC_USER|" .
  39                     "CALLBACK|CDECL|NTAPI|PASCAL|RPC_ENTRY|RPC_VAR_ENTRY|" .
  40                     "SEC_ENTRY|VFWAPI|VFWAPIV|WINGDIPAPI|WMIAPI|WINAPI|WINAPIV|APIENTRY|";
  41
  42
  43 sub parse_c_function($$$$$);
  44 sub parse_c_function_call($$$$$$$$);
  45 sub parse_c_preprocessor($$$$);
  46 sub parse_c_statements($$$$);
  47 sub parse_c_tuple($$$$$$$);
  48 sub parse_c_type($$$$$);
  49 sub parse_c_typedef($$$$);
  50 sub parse_c_variable($$$$$$$);
  51
  52
  53 sub new($$)
  54 {
  55     my ($proto, $filename) = @_;
  56     my $class = ref($proto) || $proto;
  57     my $self  = {FILE => $filename,
  58                  CREATE_FUNCTION => sub { return new c_function; },
  59                  CREATE_TYPE => sub { return new c_type; },
  60                  FOUND_COMMENT => sub { return 1; },
  61                  FOUND_DECLARATION => sub { return 1; },
  62                  FOUND_FUNCTION => sub { return 1; },
  63                  FOUND_FUNCTION_CALL => sub { return 1; },
  64                  FOUND_LINE => sub { return 1; },
  65                  FOUND_PREPROCESSOR => sub { return 1; },
  66                  FOUND_STATEMENT => sub { return 1; },
  67                  FOUND_TYPE => sub { return 1; },
  68                  FOUND_VARIABLE => sub { return 1; }
  69     };
  70     bless ($self, $class);
  71     return $self;
  72 }
  73
  74
  75 #
  76 # Callback setters
  77 #
  78
  79 sub set_found_comment_callback($$)
  80 {
  81     my ($self, $found_comment) = @_;
  82     $self->{FOUND_COMMENT} = $found_comment;
  83 }
  84
  85 sub set_found_declaration_callback($$)
  86 {
  87     my ($self, $found_declaration) = @_;
  88     $self->{FOUND_DEClARATION} = $found_declaration;
  89 }
  90
  91     sub set_found_function_callback($$)
  92 {
  93     my ($self, $found_function) = @_;
  94     $self->{FOUND_FUNCTION} = $found_function;
  95 }
  96
  97 sub set_found_function_call_callback($$)
  98 {
  99     my ($self, $found_function_call) = @_;
 100     $self->{FOUND_FUNCTION_CALL} = $found_function_call;
 101 }
 102
 103 sub set_found_line_callback($$)
 104 {
 105     my ($self, $found_line) = @_;
 106     $self->{FOUND_LINE} = $found_line;
 107 }
 108
 109 sub set_found_preprocessor_callback($$)
 110 {
 111     my ($self, $found_preprocessor) = @_;
 112     $self->{FOUND_PREPROCESSOR} = $found_preprocessor;
 113 }
 114
 115 sub set_found_statement_callback($$)
 116 {
 117     my ($self, $found_statement) = @_;
 118     $self->{FOUND_STATEMENT} = $found_statement;
 119 }
 120
 121 sub set_found_type_callback($$)
 122 {
 123     my ($self, $found_type) = @_;
 124     $self->{FOUND_TYPE} = $found_type;
 125 }
 126
 127 sub set_found_variable_callback($$)
 128 {
 129     my ($self, $found_variable) = @_;
 130     $self->{FOUND_VARIABLE} = $found_variable;
 131 }
 132
 133
 134 ########################################################################
 135 # _format_c_type
 136 sub _format_c_type($$)
 137 {
 138     my ($self, $type) = @_;
 139
 140     $type =~ s/^\s*(.*?)\s*$/$1/;
 141
 142     if ($type =~ /^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
 143         my $return_type = $1;
 144         my @arguments = split(/\s*,\s*/, $2);
 145         foreach my $argument (@arguments) {
 146             if ($argument =~ s/^(\w+(?:\s*\*)*)\s*\w+$/$1/) {
 147                 $argument =~ s/\s+/ /g;
 148                 $argument =~ s/\s*\*\s*/*/g;
 149                 $argument =~ s/(\*+)$/ $1/;
 150             }
 151         }
 152
 153         $type = "$return_type (*)(" . join(", ", @arguments) . ")";
 154     }
 155
 156     return $type;
 157 }
 158
 159
 160 ########################################################################
 161 # _parse_c_warning
 162 #
 163 # FIXME: Use caller (See man perlfunc)
 164 sub _parse_c_warning($$$$$$)
 165 {
 166     my ($self, $curlines, $line, $column, $context, $message) = @_;
 167
 168     $message = "warning" if !$message;
 169
 170     my $current = "";
 171     if ($curlines) {
 172         my @lines = split(/\n/, $curlines);
 173
 174         $current .= $lines[0] . "\n" if $lines[0];
 175         $current .= $lines[1] . "\n" if $lines[1];
 176     }
 177
 178     if($current) {
 179         $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message: \\\n$current");
 180     } else {
 181         $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message\n");
 182     }
 183 }
 184
 185 ########################################################################
 186 # _parse_c_error
 187
 188 sub _parse_c_error($$$$$$)
 189 {
 190     my ($self, $curlines, $line, $column, $context, $message) = @_;
 191
 192     $message = "parse error" if !$message;
 193
 194     # Why did I do this?
 195     if($output->prefix) {
 196         # $output->write("\n");
 197         $output->prefix("");
 198     }
 199
 200     $self->_parse_c_warning($curlines, $line, $column, $context, $message);
 201
 202     exit 1;
 203 }
 204
 205 ########################################################################
 206 # _update_c_position
 207
 208 sub _update_c_position($$$$)
 209 {
 210     my ($self, $source, $refline, $refcolumn) = @_;
 211     my $line = $$refline;
 212     my $column = $$refcolumn;
 213
 214     while ($source)
 215     {
 216         if ($source =~ s/^[^\n\t\'\"]*//s)
 217         {
 218             $column += length($&);
 219         }
 220
 221         if ($source =~ s/^\'//)
 222         {
 223             $column++;
 224             while ($source =~ /^./ && $source !~ s/^\'//)
 225             {
 226                 $source =~ s/^([^\'\\]*)//s;
 227                 $column += length($1);
 228                 if ($source =~ s/^\\//)
 229                 {
 230                     $column++;
 231                     if ($source =~ s/^(.)//s)
 232                     {
 233                         $column += length($1);
 234                         if ($1 eq "0")
 235                         {
 236                             $source =~ s/^(\d{0,3})//s;
 237                             $column += length($1);
 238                         }
 239                     }
 240                 }
 241             }
 242             $column++;
 243         }
 244         elsif ($source =~ s/^\"//)
 245         {
 246             $column++;
 247             while ($source =~ /^./ && $source !~ s/^\"//)
 248             {
 249                 $source =~ s/^([^\"\\]*)//s;
 250                 $column += length($1);
 251                 if ($source =~ s/^\\//)
 252                 {
 253                     $column++;
 254                     if ($source =~ s/^(.)//s)
 255                     {
 256                         $column += length($1);
 257                         if ($1 eq "0")
 258                         {
 259                             $source =~ s/^(\d{0,3})//s;
 260                             $column += length($1);
 261                         }
 262                     }
 263                 }
 264             }
 265             $column++;
 266         }
 267         elsif ($source =~ s/^\n//)
 268         {
 269             $line++;
 270             $column = 0;
 271         }
 272         elsif ($source =~ s/^\t//)
 273         {
 274             $column = $column + 8 - $column % 8;
 275         }
 276     }
 277
 278     $$refline = $line;
 279     $$refcolumn = $column;
 280 }
 281
 282 ########################################################################
 283 # __parse_c_until_one_of
 284
 285 sub __parse_c_until_one_of($$$$$$$) {
 286     my $self = shift;
 287
 288     my $characters = shift;
 289     my $on_same_level = shift;
 290     my $refcurrent = shift;
 291     my $refline = shift;
 292     my $refcolumn = shift;
 293     my $match = shift;
 294
 295     local $_ = $$refcurrent;
 296     my $line = $$refline;
 297     my $column = $$refcolumn;
 298
 299
 300     if(!defined($match)) {
 301         my $blackhole;
 302         $match = \$blackhole;
 303     }
 304
 305     my $level = 0;
 306     $$match = "";
 307     while(/^[^$characters]/s || $level > 0) {
 308         my $submatch = "";
 309
 310         if ($level > 0) {
 311             if(s/^[^\(\)\[\]\{\}\n\t\'\"]*//s) {
 312                 $submatch .= $&;
 313             }
 314         } elsif ($on_same_level) {
 315             if(s/^[^$characters\(\)\[\]\{\}\n\t\'\"]*//s) {
 316                 $submatch .= $&;
 317             }
 318         } else {
 319             if(s/^[^$characters\n\t\'\"]*//s) {
 320                 $submatch .= $&;
 321             }
 322         }
 323
 324         if(s/^\'//) {
 325             $submatch .= "\'";
 326             while(/^./ && !s/^\'//) {
 327                 s/^([^\'\\]*)//s;
 328                 $submatch .= $1;
 329                 if(s/^\\//) {
 330                     $submatch .= "\\";
 331                     if(s/^(.)//s) {
 332                         $submatch .= $1;
 333                         if($1 eq "0") {
 334                             s/^(\d{0,3})//s;
 335                             $submatch .= $1;
 336                         }
 337                     }
 338                 }
 339             }
 340             $submatch .= "\'";
 341
 342             $$match .= $submatch;
 343             $column += length($submatch);
 344         } elsif(s/^\"//) {
 345             $submatch .= "\"";
 346             while(/^./ && !s/^\"//) {
 347                 s/^([^\"\\]*)//s;
 348                 $submatch .= $1;
 349                 if(s/^\\//) {
 350                     $submatch .= "\\";
 351                     if(s/^(.)//s) {
 352                         $submatch .= $1;
 353                         if($1 eq "0") {
 354                             s/^(\d{0,3})//s;
 355                             $submatch .= $1;
 356                         }
 357                     }
 358                 }
 359             }
 360             $submatch .= "\"";
 361
 362             $$match .= $submatch;
 363             $column += length($submatch);
 364         } elsif($on_same_level && s/^[\(\[\{]//) {
 365             $level++;
 366
 367             $submatch .= $&;
 368             $$match .= $submatch;
 369             $column++;
 370         } elsif($on_same_level && s/^[\)\]\}]//) {
 371             if ($level > 0) {
 372                 $level--;
 373
 374                 $submatch .= $&;
 375                 $$match .= $submatch;
 376                 $column++;
 377             } else {
 378                 $_ = "$&$_";
 379                 $$match .= $submatch;
 380                 last;
 381             }
 382         } elsif(s/^\n//) {
 383             $submatch .= "\n";
 384
 385             $$match .= $submatch;
 386             $line++;
 387             $column = 0;
 388         } elsif(s/^\t//) {
 389             $submatch .= "\t";
 390
 391             $$match .= $submatch;
 392             $column = $column + 8 - $column % 8;
 393         } else {
 394             $$match .= $submatch;
 395             $column += length($submatch);
 396         }
 397     }
 398
 399     $$refcurrent = $_;
 400     $$refline = $line;
 401     $$refcolumn = $column;
 402     return 1;
 403 }
 404
 405 sub _parse_c_until_one_of($$$$$$)
 406 {
 407     my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
 408     return $self->__parse_c_until_one_of($characters, 0, $refcurrent, $refline, $refcolumn, $match);
 409 }
 410
 411 sub _parse_c_on_same_level_until_one_of($$$$$$)
 412 {
 413     my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
 414     return $self->__parse_c_until_one_of($characters, 1, $refcurrent, $refline, $refcolumn, $match);
 415 }
 416
 417 ########################################################################
 418 # parse_c_block
 419
 420 sub parse_c_block($$$$$$$) {
 421     my $self = shift;
 422
 423     my $refcurrent = shift;
 424     my $refline = shift;
 425     my $refcolumn = shift;
 426
 427     my $refstatements = shift;
 428     my $refstatements_line = shift;
 429     my $refstatements_column = shift;
 430
 431     local $_ = $$refcurrent;
 432     my $line = $$refline;
 433     my $column = $$refcolumn;
 434
 435     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 436
 437     my $statements;
 438     if(s/^\{//) {
 439         $column++;
 440         $statements = "";
 441     } else {
 442         return 0;
 443     }
 444
 445     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 446
 447     my $statements_line = $line;
 448     my $statements_column = $column;
 449
 450     my $plevel = 1;
 451     while($plevel > 0) {
 452         my $match;
 453         $self->_parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
 454
 455         $column++;
 456
 457         $statements .= $match;
 458         if(s/^\}//) {
 459             $plevel--;
 460             if($plevel > 0) {
 461                 $statements .= "}";
 462             }
 463         } elsif(s/^\{//) {
 464             $plevel++;
 465             $statements .= "{";
 466         } else {
 467             return 0;
 468         }
 469     }
 470
 471     $$refcurrent = $_;
 472     $$refline = $line;
 473     $$refcolumn = $column;
 474     $$refstatements = $statements;
 475     $$refstatements_line = $statements_line;
 476     $$refstatements_column = $statements_column;
 477
 478     return 1;
 479 }
 480
 481 sub parse_c_declaration($$$$)
 482 {
 483     my ($self, $refcurrent, $refline, $refcolumn) = @_;
 484
 485     local $_ = $$refcurrent;
 486     my $line = $$refline;
 487     my $column = $$refcolumn;
 488
 489     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 490
 491     my $begin_line = $line;
 492     my $begin_column = $column + 1;
 493
 494     my $end_line = $begin_line;
 495     my $end_column = $begin_column;
 496     $self->_update_c_position($_, \$end_line, \$end_column);
 497
 498     if(!$self->{FOUND_DECLARATION}($begin_line, $begin_column, $end_line, $end_column, $_)) {
 499         return 1;
 500     }
 501
 502     # Function
 503     my $function;
 504
 505     # Variable
 506     my ($linkage, $type, $name);
 507
 508     if(s/^WINE_(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
 509         $self->_update_c_position($&, \$line, \$column);
 510     } elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
 511         $self->_update_c_position($&, \$line, \$column);
 512         $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
 513         if(s/\)//) {
 514             $column++;
 515         }
 516     } elsif(s/^__ASM_STDCALL_FUNC\(\s*(\w+)\s*,\s*\d+\s*,\s*//s) { # FIXME: Wine specific kludge
 517         $self->_update_c_position($&, \$line, \$column);
 518         $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
 519         if(s/\)//) {
 520             $column++;
 521         }
 522     } elsif(s/^(?:DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
 523         $self->_update_c_position($&, \$line, \$column);
 524
 525         my @arguments;
 526         my @argument_lines;
 527         my @argument_columns;
 528
 529         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 530             return 0;
 531         }
 532     } elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
 533         $self->_update_c_position($&, \$line, \$column);
 534     } elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
 535         $self->_update_c_position($&, \$line, \$column);
 536     } elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
 537         $self->_update_c_position($&, \$line, \$column);
 538     } elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
 539         $self->_update_c_position($&, \$line, \$column);
 540     } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
 541         $self->_update_c_position($&, \$line, \$column);
 542     } elsif(s/^(?:__asm__|asm)\s*\(//) {
 543         $self->_update_c_position($&, \$line, \$column);
 544     } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
 545         # Nothing
 546     } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
 547         # Nothing
 548     } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
 549         if($self->{FOUND_FUNCTION}($function))
 550         {
 551             my $statements = $function->statements;
 552             my $statements_line = $function->statements_line;
 553             my $statements_column = $function->statements_column;
 554
 555             if(defined($statements)) {
 556                 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
 557                     return 0;
 558                 }
 559             }
 560         }
 561     } else {
 562         $self->_parse_c_error($_, $line, $column, "declaration");
 563     }
 564
 565     $$refcurrent = $_;
 566     $$refline = $line;
 567     $$refcolumn = $column;
 568
 569     return 1;
 570 }
 571
 572 sub _parse_c($$$$$$)
 573 {
 574     my ($self, $pattern, $refcurrent, $refline, $refcolumn, $refmatch) = @_;
 575
 576     local $_ = $$refcurrent;
 577     my $line = $$refline;
 578     my $column = $$refcolumn;
 579
 580     my $match;
 581     if(s/^(?:$pattern)//s) {
 582         $self->_update_c_position($&, \$line, \$column);
 583         $match = $&;
 584     } else {
 585         return 0;
 586     }
 587
 588     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 589
 590     $$refcurrent = $_;
 591     $$refline = $line;
 592     $$refcolumn = $column;
 593
 594     $$refmatch = $match;
 595
 596     return 1;
 597 }
 598
 599 sub parse_c_enum($$$$)
 600 {
 601     my ($self, $refcurrent, $refline, $refcolumn) = @_;
 602
 603     local $_ = $$refcurrent;
 604     my $line = $$refline;
 605     my $column = $$refcolumn;
 606
 607     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 608
 609     if (!s/^enum\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
 610         return 0;
 611     }
 612     my $_name = $1 || "";
 613
 614     $self->_update_c_position($&, \$line, \$column);
 615
 616     my $name = "";
 617
 618     my $match;
 619     while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
 620         if ($match) {
 621             if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
 622                 $self->_parse_c_error($_, $line, $column, "enum");
 623             }
 624             my $enum_name = $1;
 625             my $enum_value = $2 || "";
 626
 627             # $output->write("enum:$_name:$enum_name:$enum_value\n");
 628         }
 629
 630         if ($self->_parse_c(',', \$_, \$line, \$column)) {
 631             next;
 632         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
 633             # FIXME: Kludge
 634             my $tuple = "($_)";
 635             my $tuple_line = $line;
 636             my $tuple_column = $column - 1;
 637
 638             my @arguments;
 639             my @argument_lines;
 640                     my @argument_columns;
 641
 642             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
 643                                      \@arguments, \@argument_lines, \@argument_columns))
 644             {
 645                 $self->_parse_c_error($_, $line, $column, "enum");
 646             }
 647
 648             # FIXME: Kludge
 649             if ($#arguments >= 0) {
 650                 $name = $arguments[0];
 651             }
 652
 653             last;
 654         } else {
 655             $self->_parse_c_error($_, $line, $column, "enum");
 656         }
 657     }
 658
 659     $self->_update_c_position($_, \$line, \$column);
 660
 661     $$refcurrent = $_;
 662     $$refline = $line;
 663     $$refcolumn = $column;
 664 }
 665
 666 sub parse_c_expression($$$$)
 667 {
 668     my ($self, $refcurrent, $refline, $refcolumn) = @_;
 669
 670     local $_ = $$refcurrent;
 671     my $line = $$refline;
 672     my $column = $$refcolumn;
 673
 674     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 675
 676     while($_) {
 677         if(s/^(.*?)(\w+\s*\()/$2/s) {
 678             $self->_update_c_position($1, \$line, \$column);
 679
 680             my $begin_line = $line;
 681             my $begin_column = $column + 1;
 682
 683             my $name;
 684             my @arguments;
 685             my @argument_lines;
 686             my @argument_columns;
 687             if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
 688                 return 0;
 689             }
 690
 691             if($self->{FOUND_FUNCTION_CALL}($begin_line, $begin_column, $line, $column, $name, \@arguments))
 692             {
 693                 while(defined(my $argument = shift @arguments) &&
 694                       defined(my $argument_line = shift @argument_lines) &&
 695                       defined(my $argument_column = shift @argument_columns))
 696                 {
 697                     $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
 698                 }
 699             }
 700         } else {
 701             $_ = "";
 702         }
 703     }
 704
 705     $self->_update_c_position($_, \$line, \$column);
 706
 707     $$refcurrent = $_;
 708     $$refline = $line;
 709     $$refcolumn = $column;
 710
 711     return 1;
 712 }
 713
 714 sub parse_c_file($$$$)
 715 {
 716     my ($self, $refcurrent, $refline, $refcolumn) = @_;
 717
 718     local $_ = $$refcurrent;
 719     my $line = $$refline;
 720     my $column = $$refcolumn;
 721
 722     my $declaration = "";
 723     my $declaration_line = $line;
 724     my $declaration_column = $column;
 725
 726     my $previous_line = 0;
 727     my $previous_column = -1;
 728
 729     my $preprocessor_condition = "";
 730     my $if = 0;
 731     my $if0 = 0;
 732     my $extern_c = 0;
 733
 734     my $blevel = 1;
 735     my $plevel = 1;
 736     while($plevel > 0 || $blevel > 0) {
 737         my $match;
 738         $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
 739
 740         if($line != $previous_line) {
 741             $self->{FOUND_LINE}($line);
 742         } else {
 743             # $self->{FOUND_LINE}("$line.$column");
 744         }
 745         $previous_line = $line;
 746         $previous_column = $column;
 747
 748         if($match !~ /^\s+$/s && $options->debug) {
 749             $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
 750         }
 751
 752         if(!$declaration && $match =~ s/^\s+//s) {
 753             $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 754         }
 755
 756         if(!$if0) {
 757             $declaration .= $match;
 758
 759             # FIXME: Kludge
 760             if ($declaration =~ s/^extern\s*\"C\"//s) {
 761                 if (s/^\{//) {
 762                     $self->_update_c_position($&, \$line, \$column);
 763                     $declaration = "";
 764                     $declaration_line = $line;
 765                     $declaration_column = $column;
 766
 767                     $extern_c = 1;
 768                     next;
 769                 }
 770             } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
 771                 if (s/^\}//) {
 772                     $self->_update_c_position($&, \$line, \$column);
 773                     $declaration = "";
 774                     $declaration_line = $line;
 775                     $declaration_column = $column;
 776
 777                     $extern_c = 0;
 778                     next;
 779                 }
 780             } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
 781                 my $prefix = $&;
 782                 if ($plevel > 2 || !s/^\)//) {
 783                     $declaration = "$prefix$declaration";
 784                 } else {
 785                     $plevel--;
 786                     $self->_update_c_position($&, \$line, \$column);
 787                     $declaration .= $&;
 788
 789                     my @arguments;
 790                     my @argument_lines;
 791                     my @argument_columns;
 792
 793                     if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
 794                                              \@arguments, \@argument_lines, \@argument_columns))
 795                     {
 796                         $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
 797                     }
 798
 799                     $declaration = "";
 800                     $declaration_line = $line;
 801                     $declaration_column = $column;
 802
 803                     next;
 804                 }
 805             } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
 806                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 807             }
 808         } else {
 809             my $blank_lines = 0;
 810
 811             local $_ = $match;
 812             while(s/^.*?\n//) { $blank_lines++; }
 813
 814             if(!$declaration) {
 815                 $declaration_line = $line;
 816                 $declaration_column = $column;
 817             } else {
 818                 $declaration .= "\n" x $blank_lines;
 819             }
 820
 821         }
 822
 823         if(/^[\#\/]/) {
 824             my $blank_lines = 0;
 825             if(s/^\#\s*//) {
 826                 my $preprocessor_line = $line;
 827                 my $preprocessor_column = $column;
 828
 829                 my $preprocessor = $&;
 830                 while(s/^(.*?)\\\s*\n//) {
 831                     $blank_lines++;
 832                     $preprocessor .= "$1\n";
 833                 }
 834                 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
 835                     $_ = "$2\n$_";
 836                     if(defined($3)) {
 837                         $preprocessor .= "$1$3";
 838                     } else {
 839                         $preprocessor .= $1;
 840                     }
 841                 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
 842                     if(defined($2)) {
 843                         $_ = "$2\n$_";
 844                     } else {
 845                         $blank_lines++;
 846                     }
 847                     $preprocessor .= $1;
 848                 }
 849
 850
 851                 if($preprocessor =~ /^\#\s*if/) {
 852                     if($preprocessor =~ /^\#\s*if\s*0/) {
 853                         $if0++;
 854                     } elsif($if0 > 0) {
 855                         $if++;
 856                     } else {
 857                         if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
 858                             $preprocessor_condition = "defined(WORD_BIGENDIAN)";
 859                             # $output->write("'$preprocessor_condition':'$declaration'\n")
 860                         } else {
 861                             $preprocessor_condition = "";
 862                         }
 863                     }
 864                 } elsif($preprocessor =~ /^\#\s*else/) {
 865                     if ($preprocessor_condition ne "") {
 866                         $preprocessor_condition =~ "!$preprocessor_condition";
 867                         $preprocessor_condition =~ s/^!!/!/;
 868                         # $output->write("'$preprocessor_condition':'$declaration'\n")
 869                     }
 870                 } elsif($preprocessor =~ /^\#\s*endif/) {
 871                     if($if0 > 0) {
 872                         if($if > 0) {
 873                             $if--;
 874                         } else {
 875                             $if0--;
 876                         }
 877                     } else {
 878                         if ($preprocessor_condition ne "") {
 879                             # $output->write("'$preprocessor_condition':'$declaration'\n");
 880                             $preprocessor_condition = "";
 881                         }
 882                     }
 883                 }
 884
 885                 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
 886                      return 0;
 887                 }
 888             }
 889
 890             if(s/^\/\*.*?\*\///s) {
 891                 $self->{FOUND_COMMENT}($line, $column + 1, $&);
 892                 local $_ = $&;
 893                 while(s/^.*?\n//) {
 894                     $blank_lines++;
 895                 }
 896                 if($_) {
 897                     $column += length($_);
 898                 }
 899             } elsif(s/^\/\/(.*?)\n//) {
 900                 $self->{FOUND_COMMENT}($line, $column + 1, $&);
 901                 $blank_lines++;
 902             } elsif(s/^\///) {
 903                 if(!$if0) {
 904                     $declaration .= $&;
 905                     $column++;
 906                 }
 907             }
 908
 909             $line += $blank_lines;
 910             if($blank_lines > 0) {
 911                 $column = 0;
 912             }
 913
 914             if(!$declaration) {
 915                 $declaration_line = $line;
 916                 $declaration_column = $column;
 917             } elsif($blank_lines > 0) {
 918                 $declaration .= "\n" x $blank_lines;
 919             }
 920
 921             next;
 922         }
 923
 924         $column++;
 925
 926         if($if0) {
 927             s/^.//;
 928             next;
 929         }
 930
 931         if(s/^[\(\[]//) {
 932             $plevel++;
 933             $declaration .= $&;
 934         } elsif(s/^\]//) {
 935             $plevel--;
 936             $declaration .= $&;
 937         } elsif(s/^\)//) {
 938             $plevel--;
 939             if($plevel <= 0) {
 940                 $self->_parse_c_error($_, $line, $column, "file", ") without (");
 941             }
 942             $declaration .= $&;
 943             if($plevel == 1 && $declaration =~ /^(__ASM_GLOBAL_FUNC|__ASM_STDCALL_FUNC)/) {
 944                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 945                     return 0;
 946                 }
 947                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 948                 $declaration = "";
 949                 $declaration_line = $line;
 950                 $declaration_column = $column;
 951             }
 952         } elsif(s/^\{//) {
 953             $blevel++;
 954             $declaration .= $&;
 955         } elsif(s/^\}//) {
 956             $blevel--;
 957             if($blevel <= 0) {
 958                 $self->_parse_c_error($_, $line, $column, "file", "} without {");
 959             }
 960
 961             $declaration .= $&;
 962
 963             if($declaration =~ /^typedef/s ||
 964                $declaration =~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)*(?:interface|struct|union)(?:\s+\w+)?\s*\{/s)
 965             {
 966                 # Nothing
 967             } elsif($plevel == 1 && $blevel == 1) {
 968                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 969                     return 0;
 970                 }
 971                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 972                 $declaration = "";
 973                 $declaration_line = $line;
 974                 $declaration_column = $column;
 975             } elsif($column == 1 && !$extern_c) {
 976                 $self->_parse_c_warning("", $line, $column, "file", "inner } ends on column 1");
 977             }
 978         } elsif(s/^;//) {
 979             $declaration .= $&;
 980             if($plevel == 1 && $blevel == 1) {
 981                 $declaration =~ s/\s*;$//;
 982                 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 983                     return 0;
 984                 }
 985                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 986                 $declaration = "";
 987                 $declaration_line = $line;
 988                 $declaration_column = $column;
 989             }
 990         } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
 991             $plevel = 0;
 992             $blevel = 0;
 993         } else {
 994             $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
 995         }
 996     }
 997
 998     $$refcurrent = $_;
 999     $$refline = $line;
1000     $$refcolumn = $column;
1001
1002     return 1;
1003 }
1004
1005 sub parse_c_function($$$$$)
1006 {
1007     my ($self, $refcurrent, $refline, $refcolumn, $reffunction) = @_;
1008
1009     local $_ = $$refcurrent;
1010     my $line = $$refline;
1011     my $column = $$refcolumn;
1012
1013     my $linkage = "";
1014     my $calling_convention = "";
1015     my $return_type;
1016     my $name;
1017     my @arguments;
1018     my @argument_lines;
1019     my @argument_columns;
1020     my $statements;
1021     my $statements_line;
1022     my $statements_column;
1023
1024     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1025
1026     my $begin_line = $line;
1027     my $begin_column = $column + 1;
1028
1029     if($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
1030         # Nothing
1031     }
1032
1033     # $self->_parse_c_warning($_, $line, $column, "function", "");
1034
1035     my $match;
1036     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1037                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1038                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1039                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1040                           \$_, \$line, \$column, \$match))
1041     {
1042         if($match =~ /^(?:extern|static)$/) {
1043             if(!$linkage) {
1044                 $linkage = $match;
1045             }
1046         }
1047     }
1048
1049     if($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1050         # Nothing
1051     } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1052         # Nothing
1053     } else {
1054         if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
1055             return 0;
1056         }
1057
1058         $self->_parse_c('inline|FAR', \$_, \$line, \$column);
1059
1060         $self->_parse_c($CALL_CONVENTION,
1061                         \$_, \$line, \$column, \$calling_convention);
1062
1063
1064         # FIXME: ???: Old variant of __attribute((const))
1065         $self->_parse_c('(?:const|volatile)', \$_, \$line, \$column);
1066
1067         if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
1068             return 0;
1069         }
1070
1071         my $p = 0;
1072         if(s/^__P\s*\(//) {
1073             $self->_update_c_position($&, \$line, \$column);
1074             $p = 1;
1075         }
1076
1077         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1078             return 0;
1079         }
1080
1081         if($p) {
1082             if (s/^\)//) {
1083                 $self->_update_c_position($&, \$line, \$column);
1084             } else {
1085                 $self->_parse_c_error($_, $line, $column, "function");
1086             }
1087         }
1088     }
1089
1090
1091     if($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
1092         # Nothing
1093     }
1094
1095     my $kar;
1096     # FIXME: Implement proper handling of K&R C functions
1097     $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
1098
1099     if($kar) {
1100         $output->write("K&R: $kar\n");
1101     }
1102
1103     if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1104         return 0;
1105     }
1106
1107     my $end_line = $line;
1108     my $end_column = $column;
1109
1110     $$refcurrent = $_;
1111     $$refline = $line;
1112     $$refcolumn = $column;
1113
1114     my $function = $self->{CREATE_FUNCTION}();
1115
1116     $function->file($self->{FILE});
1117     $function->begin_line($begin_line);
1118     $function->begin_column($begin_column);
1119     $function->end_line($end_line);
1120     $function->end_column($end_column);
1121     $function->linkage($linkage);
1122     $function->return_type($return_type);
1123     $function->calling_convention($calling_convention);
1124     $function->name($name);
1125     # if(defined($argument_types)) {
1126     #     $function->argument_types([@$argument_types]);
1127     # }
1128     # if(defined($argument_names)) {
1129     #     $function->argument_names([@$argument_names]);
1130     # }
1131     $function->statements_line($statements_line);
1132     $function->statements_column($statements_column);
1133     $function->statements($statements);
1134
1135     $$reffunction = $function;
1136
1137     return 1;
1138 }
1139
1140 sub parse_c_function_call($$$$$$$$)
1141 {
1142     my ($self, $refcurrent, $refline, $refcolumn, $refname, $refarguments, $refargument_lines, $refargument_columns) = @_;
1143
1144     local $_ = $$refcurrent;
1145     my $line = $$refline;
1146     my $column = $$refcolumn;
1147
1148     my $name;
1149     my @arguments;
1150     my @argument_lines;
1151     my @argument_columns;
1152
1153     if(s/^(\w+)(\s*)(?=\()//s) {
1154         $self->_update_c_position($&, \$line, \$column);
1155
1156         $name = $1;
1157
1158         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1159             return 0;
1160         }
1161     } else {
1162         return 0;
1163     }
1164
1165     $$refcurrent = $_;
1166     $$refline = $line;
1167     $$refcolumn = $column;
1168
1169     $$refname = $name;
1170     @$refarguments = @arguments;
1171     @$refargument_lines = @argument_lines;
1172     @$refargument_columns = @argument_columns;
1173
1174     return 1;
1175 }
1176
1177
1178 sub parse_c_preprocessor($$$$)
1179 {
1180     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1181
1182     local $_ = $$refcurrent;
1183     my $line = $$refline;
1184     my $column = $$refcolumn;
1185
1186     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1187
1188     my $begin_line = $line;
1189     my $begin_column = $column + 1;
1190
1191     if(!$self->{FOUND_PREPROCESSOR}($begin_line, $begin_column, "$_")) {
1192         return 1;
1193     }
1194
1195     if(/^\#\s*define\s*(.*?)$/s) {
1196         $self->_update_c_position($_, \$line, \$column);
1197     } elsif(/^\#\s*else/s) {
1198         $self->_update_c_position($_, \$line, \$column);
1199     } elsif(/^\#\s*endif/s) {
1200         $self->_update_c_position($_, \$line, \$column);
1201     } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
1202         $self->_update_c_position($_, \$line, \$column);
1203     } elsif(/^\#\s*include\s+(.*?)$/s) {
1204         $self->_update_c_position($_, \$line, \$column);
1205     } elsif(/^\#\s*undef\s+(.*?)$/s) {
1206         $self->_update_c_position($_, \$line, \$column);
1207     } else {
1208         $self->_parse_c_error($_, $line, $column, "preprocessor");
1209     }
1210
1211     $$refcurrent = $_;
1212     $$refline = $line;
1213     $$refcolumn = $column;
1214
1215     return 1;
1216 }
1217
1218 sub parse_c_statement($$$$)
1219 {
1220     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1221
1222     local $_ = $$refcurrent;
1223     my $line = $$refline;
1224     my $column = $$refcolumn;
1225
1226     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1227
1228     $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1229
1230     # $output->write("$line.$column: statement: '$_'\n");
1231
1232     if(/^$/) {
1233         # Nothing
1234     } elsif(/^\{/) {
1235         my $statements;
1236         my $statements_line;
1237         my $statements_column;
1238         if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1239             return 0;
1240         }
1241         if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1242             return 0;
1243         }
1244     } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1245         $self->_update_c_position($&, \$line, \$column);
1246
1247         my $name = $1;
1248
1249         my @arguments;
1250         my @argument_lines;
1251         my @argument_columns;
1252         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1253             return 0;
1254         }
1255
1256         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1257         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1258             return 0;
1259         }
1260         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1261
1262         while(defined(my $argument = shift @arguments) &&
1263               defined(my $argument_line = shift @argument_lines) &&
1264               defined(my $argument_column = shift @argument_columns))
1265         {
1266             $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1267         }
1268     } elsif(s/^else//) {
1269         $self->_update_c_position($&, \$line, \$column);
1270         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1271             return 0;
1272         }
1273     } elsif(s/^return//) {
1274         $self->_update_c_position($&, \$line, \$column);
1275         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1276         if(!$self->parse_c_expression(\$_, \$line, \$column)) {
1277             return 0;
1278         }
1279     } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1280         # Nothing
1281     } else {
1282         # $self->_parse_c_error($_, $line, $column, "statement");
1283     }
1284
1285     $self->_update_c_position($_, \$line, \$column);
1286
1287     $$refcurrent = $_;
1288     $$refline = $line;
1289     $$refcolumn = $column;
1290
1291     return 1;
1292 }
1293
1294 sub parse_c_statements($$$$)
1295 {
1296     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1297
1298     local $_ = $$refcurrent;
1299     my $line = $$refline;
1300     my $column = $$refcolumn;
1301
1302     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1303
1304     # $output->write("$line.$column: statements: '$_'\n");
1305
1306     my $statement = "";
1307     my $statement_line = $line;
1308     my $statement_column = $column;
1309
1310     my $previous_line = -1;
1311     my $previous_column = -1;
1312
1313     my $blevel = 1;
1314     my $plevel = 1;
1315     while($plevel > 0 || $blevel > 0) {
1316         my $match;
1317         $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1318
1319         if($previous_line == $line && $previous_column == $column) {
1320             $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1321         }
1322         $previous_line = $line;
1323         $previous_column = $column;
1324
1325         # $output->write("'$match' '$_'\n");
1326
1327         $statement .= $match;
1328         $column++;
1329         if(s/^[\(\[]//) {
1330             $plevel++;
1331             $statement .= $&;
1332         } elsif(s/^[\)\]]//) {
1333             $plevel--;
1334             if($plevel <= 0) {
1335                 $self->_parse_c_error($_, $line, $column, "statements");
1336             }
1337             $statement .= $&;
1338         } elsif(s/^\{//) {
1339             $blevel++;
1340             $statement .= $&;
1341         } elsif(s/^\}//) {
1342             $blevel--;
1343             $statement .= $&;
1344             if($blevel == 1) {
1345                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1346                     return 0;
1347                 }
1348                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1349                 $statement = "";
1350                 $statement_line = $line;
1351                 $statement_column = $column;
1352             }
1353         } elsif(s/^;//) {
1354             if($plevel == 1 && $blevel == 1) {
1355                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1356                     return 0;
1357                 }
1358
1359                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1360                 $statement = "";
1361                 $statement_line = $line;
1362                 $statement_column = $column;
1363             } else {
1364                 $statement .= $&;
1365             }
1366         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1367             $plevel = 0;
1368             $blevel = 0;
1369         } else {
1370             $self->_parse_c_error($_, $line, $column, "statements");
1371         }
1372     }
1373
1374     $self->_update_c_position($_, \$line, \$column);
1375
1376     $$refcurrent = $_;
1377     $$refline = $line;
1378     $$refcolumn = $column;
1379
1380     return 1;
1381 }
1382
1383 sub parse_c_struct_union($$$$$$$$$)
1384 {
1385     my ($self, $refcurrent, $refline, $refcolumn, $refkind, $ref_name, $reffield_type_names, $reffield_names, $refnames) = @_;
1386
1387     local $_ = $$refcurrent;
1388     my $line = $$refline;
1389     my $column = $$refcolumn;
1390
1391     my $kind;
1392     my $_name;
1393     my @field_type_names = ();
1394     my @field_names = ();
1395     my @names = ();
1396
1397     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1398
1399     if (!s/^(interface|struct|union)(\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+))?\s*\{\s*//s) {
1400         return 0;
1401     }
1402     $kind = $1;
1403     $_name = $3 || "";
1404
1405     $self->_update_c_position($&, \$line, \$column);
1406
1407     my $match;
1408     while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
1409     {
1410         my $field_linkage;
1411         my $field_type_name;
1412         my $field_name;
1413
1414         if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
1415             $field_type_name =~ s/\s+/ /g;
1416
1417             push @field_type_names, $field_type_name;
1418             push @field_names, $field_name;
1419             # $output->write("$kind:$_name:$field_type_name:$field_name\n");
1420         } elsif ($match) {
1421             $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
1422         }
1423
1424         if ($self->_parse_c(';', \$_, \$line, \$column)) {
1425             next;
1426         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
1427             # FIXME: Kludge
1428             my $tuple = "($_)";
1429             my $tuple_line = $line;
1430             my $tuple_column = $column - 1;
1431
1432             my @arguments;
1433             my @argument_lines;
1434             my @argument_columns;
1435
1436             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
1437                                      \@arguments, \@argument_lines, \@argument_columns))
1438             {
1439                 $self->_parse_c_error($_, $line, $column, "$kind");
1440             }
1441
1442             foreach my $argument (@arguments) {
1443                 my $name = $argument;
1444
1445                 push @names, $name;
1446             }
1447
1448             last;
1449         } else {
1450             $self->_parse_c_error($_, $line, $column, "$kind");
1451         }
1452     }
1453
1454     $$refcurrent = $_;
1455     $$refline = $line;
1456     $$refcolumn = $column;
1457
1458     $$refkind = $kind;
1459     $$ref_name = $_name;
1460     @$reffield_type_names = @field_type_names;
1461     @$reffield_names = @field_names;
1462     @$refnames = @names;
1463
1464     return 1;
1465 }
1466
1467 sub parse_c_tuple($$$$$$$)
1468 {
1469     my ($self, $refcurrent, $refline, $refcolumn,
1470         # FIXME: Should not write directly
1471         $items, $item_lines, $item_columns) = @_;
1472
1473     local $_ = $$refcurrent;
1474
1475     my $line = $$refline;
1476     my $column = $$refcolumn;
1477
1478     my $item;
1479     if(s/^\(//) {
1480         $column++;
1481         $item = "";
1482     } else {
1483         return 0;
1484     }
1485
1486     my $item_line = $line;
1487     my $item_column = $column + 1;
1488
1489     my $plevel = 1;
1490     while($plevel > 0) {
1491         my $match;
1492         $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1493
1494         $column++;
1495
1496         $item .= $match;
1497         if(s/^\)//) {
1498             $plevel--;
1499             if($plevel == 0) {
1500                 push @$item_lines, $item_line;
1501                 push @$item_columns, $item_column;
1502                 push @$items, $item;
1503                 $item = "";
1504             } else {
1505                 $item .= ")";
1506             }
1507         } elsif(s/^\(//) {
1508             $plevel++;
1509             $item .= "(";
1510         } elsif(s/^,//) {
1511             if($plevel == 1) {
1512                 push @$item_lines, $item_line;
1513                 push @$item_columns, $item_column;
1514                 push @$items, $item;
1515                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1516                 $item_line = $line;
1517                 $item_column = $column + 1;
1518                 $item = "";
1519             } else {
1520                 $item .= ",";
1521             }
1522         } else {
1523             return 0;
1524         }
1525     }
1526
1527     $$refcurrent = $_;
1528     $$refline = $line;
1529     $$refcolumn = $column;
1530
1531     return 1;
1532 }
1533
1534 sub parse_c_type($$$$$)
1535 {
1536     my ($self, $refcurrent, $refline, $refcolumn, $reftype) = @_;
1537
1538     local $_ = $$refcurrent;
1539     my $line = $$refline;
1540     my $column = $$refcolumn;
1541
1542     my $type;
1543
1544     $self->_parse_c("(?:const|volatile)", \$_, \$line, \$column);
1545
1546     if($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1547         # Nothing
1548     } elsif($self->_parse_c('(?:enum\s+|interface\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
1549                             \$_, \$line, \$column, \$type))
1550     {
1551         # Nothing
1552     } else {
1553         return 0;
1554     }
1555     $type =~ s/\s//g;
1556
1557     $$refcurrent = $_;
1558     $$refline = $line;
1559     $$refcolumn = $column;
1560
1561     $$reftype = $type;
1562
1563     return 1;
1564 }
1565
1566 sub parse_c_typedef($$$$)
1567 {
1568     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1569
1570     local $_ = $$refcurrent;
1571     my $line = $$refline;
1572     my $column = $$refcolumn;
1573
1574     if (!$self->_parse_c("typedef", \$_, \$line, \$column)) {
1575         return 0;
1576     }
1577
1578     my ($kind, $name, @field_type_names, @field_names, @names);
1579     my ($linkage, $type_name);
1580     if ($self->parse_c_enum(\$_, \$line, \$column))
1581 {
1582         # Nothing to do
1583     }
1584     elsif ($self->parse_c_struct_union(\$_, \$line, \$column,
1585                                          \$kind, \$name, \@field_type_names, \@field_names, \@names))
1586     {
1587         my $base_name;
1588         foreach my $_name (@names)
1589         {
1590             if ($_name =~ /^\w+$/)
1591             {
1592                 $base_name = $_name;
1593                 last;
1594             }
1595         }
1596         $base_name="$kind $name" if (!defined $base_name and defined $name);
1597         $base_name=$kind if (!defined $base_name);
1598         foreach my $_name (@names) {
1599             if ($_name =~ /^\w+$/) {
1600                 my $type = $self->{CREATE_TYPE}();
1601
1602                 $type->kind($kind);
1603                 $type->_name($name);
1604                 $type->name($_name);
1605                 $type->field_type_names([@field_type_names]);
1606                 $type->field_names([@field_names]);
1607
1608                 $self->{FOUND_TYPE}($type);
1609             } elsif ($_name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
1610                 my $type_name = "$base_name $1";
1611                 $_name = $2;
1612
1613                 my $type = $self->{CREATE_TYPE}();
1614
1615                 $type->kind("");
1616                 $type->name($_name);
1617                 $type->field_type_names([$type_name]);
1618                 $type->field_names([""]);
1619
1620                 $self->{FOUND_TYPE}($type);
1621             } else {
1622                 $self->_parse_c_error($_, $line, $column, "typedef 2");
1623             }
1624         }
1625     }
1626     elsif ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name))
1627     {
1628         $type_name =~ s/\s+/ /g;
1629
1630         if(defined($type_name) && defined($name)) {
1631             my $type = $self->{CREATE_TYPE}();
1632
1633             if (length($name) == 0) {
1634                 $self->_parse_c_error($_, $line, $column, "typedef");
1635             }
1636
1637             $type->kind("");
1638             $type->name($name);
1639             $type->field_type_names([$type_name]);
1640             $type->field_names([""]);
1641
1642             $self->{FOUND_TYPE}($type);
1643         }
1644     } else {
1645         $self->_parse_c_error($_, $line, $column, "typedef");
1646     }
1647
1648     $$refcurrent = $_;
1649     $$refline = $line;
1650     $$refcolumn = $column;
1651
1652     return 1;
1653 }
1654
1655 sub parse_c_variable($$$$$$$)
1656 {
1657     my ($self, $refcurrent, $refline, $refcolumn, $reflinkage, $reftype, $refname) = @_;
1658
1659     local $_ = $$refcurrent;
1660     my $line = $$refline;
1661     my $column = $$refcolumn;
1662
1663     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1664
1665     my $begin_line = $line;
1666     my $begin_column = $column + 1;
1667
1668     my $linkage = "";
1669     my $sign = "";
1670     my $type = "";
1671     my $name = "";
1672
1673     # $self->_parse_c_warning($_, $line, $column, "variable");
1674
1675     my $match;
1676     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1677                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1678                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1679                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1680                           \$_, \$line, \$column, \$match))
1681     {
1682         if ($match =~ /^(?:extern|static)$/) {
1683             if (!$linkage) {
1684                 $linkage = $match;
1685             } else {
1686                 $self->_parse_c_warning($_, $line, $column, "repeated linkage (ignored): $match");
1687             }
1688         } elsif ($match =~ /^(?:signed|unsigned)$/) {
1689             if (!$sign) {
1690                 $sign = "$match ";
1691             } else {
1692                 $self->_parse_c_warning($_, $line, $column, "repeated sign (ignored): $match");
1693             }
1694         }
1695     }
1696
1697     return 0 if(/^$/);
1698
1699   finished: while (1)
1700     {
1701         if (s/^(enum\s+|interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1702             my $kind = $1;
1703             my $_name = $2;
1704             $self->_update_c_position($&, \$line, \$column);
1705
1706             if(defined($_name)) {
1707                 $type = "$kind $_name { }";
1708             } else {
1709                 $type = "$kind { }";
1710             }
1711
1712             last finished;
1713         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s+DECLSPEC_ALIGN\(.*?\)|\s*(?:const\s*|volatile\s*)?\*)*)\s*(\w+)\s*(\[.*?\]$|:\s*(\d+)$|\{)?//s) {
1714             $type = "$sign$1";
1715             $name = $2;
1716
1717             if (defined($3)) {
1718                 my $bits = $4;
1719                 local $_ = $3;
1720                 if (/^\[/) {
1721                     $type .= $_;
1722                 } elsif (/^:/) {
1723                     $type .= ":$bits";
1724                 } elsif (/^\{/) {
1725                     # Nothing
1726                 }
1727             }
1728
1729             $type = $self->_format_c_type($type);
1730
1731             last finished;
1732         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*)\s*:\s*(\d+)$//s) {
1733             $type = "$sign$1:$2";
1734             $name = "";
1735             $type = $self->_format_c_type($type);
1736
1737             last finished;
1738         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*\s*\(\s*(?:$CALL_CONVENTION)?(?:\s+DECLSPEC_[A-Z]+)?(?:\s*\*)*)\s*(\w+)\s*(\)\s*\(.*?\))$//s) {
1739             $type = $self->_format_c_type("$sign$1$3");
1740             $name = $2;
1741
1742             last finished;
1743         } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
1744             $type = $match;
1745             last finished;
1746         } else {
1747             $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
1748             last finished;
1749         }
1750
1751         if($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
1752             $type = $match;
1753             last finished;
1754         } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
1755                                 \$_, \$line, \$column, \$match))
1756         {
1757             $type = $match;
1758             last finished;
1759         } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
1760             $type = $match;
1761             last finished;
1762         } elsif(s/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
1763             my $kind = $1;
1764             my $_name = $2;
1765             $self->_update_c_position($&, \$line, \$column);
1766
1767             if(defined($_name)) {
1768                 $type = "struct $_name { }";
1769             } else {
1770                 $type = "struct { }";
1771             }
1772         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
1773             $type = $&;
1774             $type =~ s/\s//g;
1775         } else {
1776             return 0;
1777         }
1778
1779         # $output->write("*** $type: '$_'\n");
1780
1781         # $self->_parse_c_warning($_, $line, $column, "variable2", "");
1782
1783         if(s/^WINAPI\s*//) {
1784             $self->_update_c_position($&, \$line, \$column);
1785         }
1786
1787         if(s/^(\((?:$CALL_CONVENTION)?\s*\*?\s*(?:$CALL_CONVENTION)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
1788             $self->_update_c_position($&, \$line, \$column);
1789
1790             $name = $1;
1791             $name =~ s/\s//g;
1792
1793             $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
1794             if(s/^\)//) { $column++; }
1795             $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1796
1797             if(!s/^(?:=\s*|,\s*|$)//) {
1798                 return 0;
1799             }
1800         } elsif(s/^(?:\*\s*)*(?:const\s+|volatile\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
1801             $self->_update_c_position($&, \$line, \$column);
1802
1803             $name = $1;
1804             $name =~ s/\s//g;
1805         } elsif(/^$/) {
1806             $name = "";
1807         } else {
1808             return 0;
1809         }
1810         last finished;
1811     }
1812
1813     # $output->write("$type: $name: '$_'\n");
1814
1815     $$refcurrent = $_;
1816     $$refline = $line;
1817     $$refcolumn = $column;
1818
1819     $$reflinkage = $linkage;
1820     $$reftype = $type;
1821     $$refname = $name;
1822
1823     $self->{FOUND_VARIABLE}($begin_line, $begin_column, $linkage, $type, $name);
1824
1825     return 1;
1826 }
1827
1828 1;