git.oblomov.eu Git - wine/blob - 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                     "VFWAPI|VFWAPIV|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/^(?:DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
 517         $self->_update_c_position($&, \$line, \$column);
 518
 519         my @arguments;
 520         my @argument_lines;
 521         my @argument_columns;
 522
 523         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 524             return 0;
 525         }
 526     } elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
 527         $self->_update_c_position($&, \$line, \$column);
 528     } elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
 529         $self->_update_c_position($&, \$line, \$column);
 530     } elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
 531         $self->_update_c_position($&, \$line, \$column);
 532     } elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
 533         $self->_update_c_position($&, \$line, \$column);
 534     } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
 535         $self->_update_c_position($&, \$line, \$column);
 536     } elsif(s/^(?:__asm__|asm)\s*\(//) {
 537         $self->_update_c_position($&, \$line, \$column);
 538     } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
 539         # Nothing
 540     } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
 541         # Nothing
 542     } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
 543         if($self->{FOUND_FUNCTION}($function))
 544         {
 545             my $statements = $function->statements;
 546             my $statements_line = $function->statements_line;
 547             my $statements_column = $function->statements_column;
 548
 549             if(defined($statements)) {
 550                 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
 551                     return 0;
 552                 }
 553             }
 554         }
 555     } else {
 556         $self->_parse_c_error($_, $line, $column, "declaration");
 557     }
 558
 559     $$refcurrent = $_;
 560     $$refline = $line;
 561     $$refcolumn = $column;
 562
 563     return 1;
 564 }
 565
 566 sub _parse_c($$$$$$)
 567 {
 568     my ($self, $pattern, $refcurrent, $refline, $refcolumn, $refmatch) = @_;
 569
 570     local $_ = $$refcurrent;
 571     my $line = $$refline;
 572     my $column = $$refcolumn;
 573
 574     my $match;
 575     if(s/^(?:$pattern)//s) {
 576         $self->_update_c_position($&, \$line, \$column);
 577         $match = $&;
 578     } else {
 579         return 0;
 580     }
 581
 582     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 583
 584     $$refcurrent = $_;
 585     $$refline = $line;
 586     $$refcolumn = $column;
 587
 588     $$refmatch = $match;
 589
 590     return 1;
 591 }
 592
 593 sub parse_c_enum($$$$)
 594 {
 595     my ($self, $refcurrent, $refline, $refcolumn) = @_;
 596
 597     local $_ = $$refcurrent;
 598     my $line = $$refline;
 599     my $column = $$refcolumn;
 600
 601     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 602
 603     if (!s/^enum\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
 604         return 0;
 605     }
 606     my $_name = $1 || "";
 607
 608     $self->_update_c_position($&, \$line, \$column);
 609
 610     my $name = "";
 611
 612     my $match;
 613     while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
 614         if ($match) {
 615             if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
 616                 $self->_parse_c_error($_, $line, $column, "enum");
 617             }
 618             my $enum_name = $1;
 619             my $enum_value = $2 || "";
 620
 621             # $output->write("enum:$_name:$enum_name:$enum_value\n");
 622         }
 623
 624         if ($self->_parse_c(',', \$_, \$line, \$column)) {
 625             next;
 626         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
 627             # FIXME: Kludge
 628             my $tuple = "($_)";
 629             my $tuple_line = $line;
 630             my $tuple_column = $column - 1;
 631
 632             my @arguments;
 633             my @argument_lines;
 634                     my @argument_columns;
 635
 636             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
 637                                      \@arguments, \@argument_lines, \@argument_columns))
 638             {
 639                 $self->_parse_c_error($_, $line, $column, "enum");
 640             }
 641
 642             # FIXME: Kludge
 643             if ($#arguments >= 0) {
 644                 $name = $arguments[0];
 645             }
 646
 647             last;
 648         } else {
 649             $self->_parse_c_error($_, $line, $column, "enum");
 650         }
 651     }
 652
 653     $self->_update_c_position($_, \$line, \$column);
 654
 655     $$refcurrent = $_;
 656     $$refline = $line;
 657     $$refcolumn = $column;
 658 }
 659
 660 sub parse_c_expression($$$$)
 661 {
 662     my ($self, $refcurrent, $refline, $refcolumn) = @_;
 663
 664     local $_ = $$refcurrent;
 665     my $line = $$refline;
 666     my $column = $$refcolumn;
 667
 668     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 669
 670     while($_) {
 671         if(s/^(.*?)(\w+\s*\()/$2/s) {
 672             $self->_update_c_position($1, \$line, \$column);
 673
 674             my $begin_line = $line;
 675             my $begin_column = $column + 1;
 676
 677             my $name;
 678             my @arguments;
 679             my @argument_lines;
 680             my @argument_columns;
 681             if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
 682                 return 0;
 683             }
 684
 685             if($self->{FOUND_FUNCTION_CALL}($begin_line, $begin_column, $line, $column, $name, \@arguments))
 686             {
 687                 while(defined(my $argument = shift @arguments) &&
 688                       defined(my $argument_line = shift @argument_lines) &&
 689                       defined(my $argument_column = shift @argument_columns))
 690                 {
 691                     $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
 692                 }
 693             }
 694         } else {
 695             $_ = "";
 696         }
 697     }
 698
 699     $self->_update_c_position($_, \$line, \$column);
 700
 701     $$refcurrent = $_;
 702     $$refline = $line;
 703     $$refcolumn = $column;
 704
 705     return 1;
 706 }
 707
 708 sub parse_c_file($$$$)
 709 {
 710     my ($self, $refcurrent, $refline, $refcolumn) = @_;
 711
 712     local $_ = $$refcurrent;
 713     my $line = $$refline;
 714     my $column = $$refcolumn;
 715
 716     my $declaration = "";
 717     my $declaration_line = $line;
 718     my $declaration_column = $column;
 719
 720     my $previous_line = 0;
 721     my $previous_column = -1;
 722
 723     my $preprocessor_condition;
 724     my $if = 0;
 725     my $if0 = 0;
 726     my $extern_c = 0;
 727
 728     my $blevel = 1;
 729     my $plevel = 1;
 730     while($plevel > 0 || $blevel > 0) {
 731         my $match;
 732         $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
 733
 734         if($line != $previous_line) {
 735             $self->{FOUND_LINE}($line);
 736         } else {
 737             # $self->{FOUND_LINE}("$line.$column");
 738         }
 739         $previous_line = $line;
 740         $previous_column = $column;
 741
 742         if($match !~ /^\s+$/s && $options->debug) {
 743             $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
 744         }
 745
 746         if(!$declaration && $match =~ s/^\s+//s) {
 747             $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 748         }
 749
 750         if(!$if0) {
 751             $declaration .= $match;
 752
 753             # FIXME: Kludge
 754             if ($declaration =~ s/^extern\s*\"C\"//s) {
 755                 if (s/^\{//) {
 756                     $self->_update_c_position($&, \$line, \$column);
 757                     $declaration = "";
 758                     $declaration_line = $line;
 759                     $declaration_column = $column;
 760
 761                     $extern_c = 1;
 762                     next;
 763                 }
 764             } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
 765                 if (s/^\}//) {
 766                     $self->_update_c_position($&, \$line, \$column);
 767                     $declaration = "";
 768                     $declaration_line = $line;
 769                     $declaration_column = $column;
 770
 771                     $extern_c = 0;
 772                     next;
 773                 }
 774             } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
 775                 my $prefix = $&;
 776                 if ($plevel > 2 || !s/^\)//) {
 777                     $declaration = "$prefix$declaration";
 778                 } else {
 779                     $plevel--;
 780                     $self->_update_c_position($&, \$line, \$column);
 781                     $declaration .= $&;
 782
 783                     my @arguments;
 784                     my @argument_lines;
 785                     my @argument_columns;
 786
 787                     if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
 788                                              \@arguments, \@argument_lines, \@argument_columns))
 789                     {
 790                         $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
 791                     }
 792
 793                     $declaration = "";
 794                     $declaration_line = $line;
 795                     $declaration_column = $column;
 796
 797                     next;
 798                 }
 799             } elsif ($declaration =~ s/^(?:DEFINE_SHLGUID)\s*\(.*?\)//s) {
 800                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 801             } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
 802                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 803             } elsif ($declaration =~ s/^ICOM_DEFINE\(\s*(\w+)\s*,\s*(\w+)\s*\)\s*//s) {
 804                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 805             }
 806         } else {
 807             my $blank_lines = 0;
 808
 809             local $_ = $match;
 810             while(s/^.*?\n//) { $blank_lines++; }
 811
 812             if(!$declaration) {
 813                 $declaration_line = $line;
 814                 $declaration_column = $column;
 815             } else {
 816                 $declaration .= "\n" x $blank_lines;
 817             }
 818
 819         }
 820
 821         if(/^[\#\/]/) {
 822             my $blank_lines = 0;
 823             if(s/^\#\s*//) {
 824                 my $preprocessor_line = $line;
 825                 my $preprocessor_column = $column;
 826
 827                 my $preprocessor = $&;
 828                 while(s/^(.*?)\\\s*\n//) {
 829                     $blank_lines++;
 830                     $preprocessor .= "$1\n";
 831                 }
 832                 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
 833                     $_ = "$2\n$_";
 834                     if(defined($3)) {
 835                         $preprocessor .= "$1$3";
 836                     } else {
 837                         $preprocessor .= $1;
 838                     }
 839                 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
 840                     if(defined($2)) {
 841                         $_ = "$2\n$_";
 842                     } else {
 843                         $blank_lines++;
 844                     }
 845                     $preprocessor .= $1;
 846                 }
 847
 848
 849                 if($preprocessor =~ /^\#\s*if/) {
 850                     if($preprocessor =~ /^\#\s*if\s*0/) {
 851                         $if0++;
 852                     } elsif($if0 > 0) {
 853                         $if++;
 854                     } else {
 855                         if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
 856                             $preprocessor_condition = "defined(WORD_BIGENDIAN)";
 857                             # $output->write("'$preprocessor_condition':'$declaration'\n")
 858                         } else {
 859                             $preprocessor_condition = "";
 860                         }
 861                     }
 862                 } elsif($preprocessor =~ /^\#\s*else/) {
 863                     if ($preprocessor_condition ne "") {
 864                         $preprocessor_condition =~ "!$preprocessor_condition";
 865                         $preprocessor_condition =~ s/^!!/!/;
 866                         # $output->write("'$preprocessor_condition':'$declaration'\n")
 867                     }
 868                 } elsif($preprocessor =~ /^\#\s*endif/) {
 869                     if($if0 > 0) {
 870                         if($if > 0) {
 871                             $if--;
 872                         } else {
 873                             $if0--;
 874                         }
 875                     } else {
 876                         if ($preprocessor_condition ne "") {
 877                             # $output->write("'$preprocessor_condition':'$declaration'\n");
 878                             $preprocessor_condition = "";
 879                         }
 880                     }
 881                 }
 882
 883                 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
 884                      return 0;
 885                 }
 886             }
 887
 888             if(s/^\/\*.*?\*\///s) {
 889                 $self->{FOUND_COMMENT}($line, $column + 1, $&);
 890                 local $_ = $&;
 891                 while(s/^.*?\n//) {
 892                     $blank_lines++;
 893                 }
 894                 if($_) {
 895                     $column += length($_);
 896                 }
 897             } elsif(s/^\/\/(.*?)\n//) {
 898                 $self->{FOUND_COMMENT}($line, $column + 1, $&);
 899                 $blank_lines++;
 900             } elsif(s/^\///) {
 901                 if(!$if0) {
 902                     $declaration .= $&;
 903                     $column++;
 904                 }
 905             }
 906
 907             $line += $blank_lines;
 908             if($blank_lines > 0) {
 909                 $column = 0;
 910             }
 911
 912             if(!$declaration) {
 913                 $declaration_line = $line;
 914                 $declaration_column = $column;
 915             } elsif($blank_lines > 0) {
 916                 $declaration .= "\n" x $blank_lines;
 917             }
 918
 919             next;
 920         }
 921
 922         $column++;
 923
 924         if($if0) {
 925             s/^.//;
 926             next;
 927         }
 928
 929         if(s/^[\(\[]//) {
 930             $plevel++;
 931             $declaration .= $&;
 932         } elsif(s/^\]//) {
 933             $plevel--;
 934             $declaration .= $&;
 935         } elsif(s/^\)//) {
 936             $plevel--;
 937             if($plevel <= 0) {
 938                 $self->_parse_c_error($_, $line, $column, "file", ") without (");
 939             }
 940             $declaration .= $&;
 941             if($plevel == 1 && $declaration =~ /^__ASM_GLOBAL_FUNC/) {
 942                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 943                     return 0;
 944                 }
 945                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 946                 $declaration = "";
 947                 $declaration_line = $line;
 948                 $declaration_column = $column;
 949             }
 950         } elsif(s/^\{//) {
 951             $blevel++;
 952             $declaration .= $&;
 953         } elsif(s/^\}//) {
 954             $blevel--;
 955             if($blevel <= 0) {
 956                 $self->_parse_c_error($_, $line, $column, "file", "} without {");
 957             }
 958
 959             $declaration .= $&;
 960
 961             if($declaration =~ /^typedef/s ||
 962                $declaration =~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)*(?:interface|struct|union)(?:\s+\w+)?\s*\{/s)
 963             {
 964                 # Nothing
 965             } elsif($plevel == 1 && $blevel == 1) {
 966                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 967                     return 0;
 968                 }
 969                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 970                 $declaration = "";
 971                 $declaration_line = $line;
 972                 $declaration_column = $column;
 973             } elsif($column == 1 && !$extern_c) {
 974                 $self->_parse_c_error("", $line, $column, "file", "inner } ends on column 1");
 975             }
 976         } elsif(s/^;//) {
 977             $declaration .= $&;
 978             if($plevel == 1 && $blevel == 1) {
 979                 $declaration =~ s/\s*;$//;
 980                 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 981                     return 0;
 982                 }
 983                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 984                 $declaration = "";
 985                 $declaration_line = $line;
 986                 $declaration_column = $column;
 987             }
 988         } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
 989             $plevel = 0;
 990             $blevel = 0;
 991         } else {
 992             $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
 993         }
 994     }
 995
 996     $$refcurrent = $_;
 997     $$refline = $line;
 998     $$refcolumn = $column;
 999
1000     return 1;
1001 }
1002
1003 sub parse_c_function($$$$$)
1004 {
1005     my ($self, $refcurrent, $refline, $refcolumn, $reffunction) = @_;
1006
1007     local $_ = $$refcurrent;
1008     my $line = $$refline;
1009     my $column = $$refcolumn;
1010
1011     my $linkage = "";
1012     my $calling_convention = "";
1013     my $return_type;
1014     my $name;
1015     my @arguments;
1016     my @argument_lines;
1017     my @argument_columns;
1018     my $statements;
1019     my $statements_line;
1020     my $statements_column;
1021
1022     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1023
1024     my $begin_line = $line;
1025     my $begin_column = $column + 1;
1026
1027     if($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
1028         # Nothing
1029     }
1030
1031     # $self->_parse_c_warning($_, $line, $column, "function", "");
1032
1033     my $match;
1034     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1035                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1036                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1037                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1038                           \$_, \$line, \$column, \$match))
1039     {
1040         if($match =~ /^(?:extern|static)$/) {
1041             if(!$linkage) {
1042                 $linkage = $match;
1043             }
1044         }
1045     }
1046
1047     if($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1048         # Nothing
1049     } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1050         # Nothing
1051     } else {
1052         if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
1053             return 0;
1054         }
1055
1056         $self->_parse_c('inline|FAR', \$_, \$line, \$column);
1057
1058         $self->_parse_c($CALL_CONVENTION,
1059                         \$_, \$line, \$column, \$calling_convention);
1060
1061
1062         # FIXME: ???: Old variant of __attribute((const))
1063         $self->_parse_c('(?:const|volatile)', \$_, \$line, \$column);
1064
1065         if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
1066             return 0;
1067         }
1068
1069         my $p = 0;
1070         if(s/^__P\s*\(//) {
1071             $self->_update_c_position($&, \$line, \$column);
1072             $p = 1;
1073         }
1074
1075         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1076             return 0;
1077         }
1078
1079         if($p) {
1080             if (s/^\)//) {
1081                 $self->_update_c_position($&, \$line, \$column);
1082             } else {
1083                 $self->_parse_c_error($_, $line, $column, "function");
1084             }
1085         }
1086     }
1087
1088
1089     if($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
1090         # Nothing
1091     }
1092
1093     my $kar;
1094     # FIXME: Implement proper handling of K&R C functions
1095     $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
1096
1097     if($kar) {
1098         $output->write("K&R: $kar\n");
1099     }
1100
1101     if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1102         return 0;
1103     }
1104
1105     my $end_line = $line;
1106     my $end_column = $column;
1107
1108     $$refcurrent = $_;
1109     $$refline = $line;
1110     $$refcolumn = $column;
1111
1112     my $function = $self->{CREATE_FUNCTION}();
1113
1114     $function->file($self->{FILE});
1115     $function->begin_line($begin_line);
1116     $function->begin_column($begin_column);
1117     $function->end_line($end_line);
1118     $function->end_column($end_column);
1119     $function->linkage($linkage);
1120     $function->return_type($return_type);
1121     $function->calling_convention($calling_convention);
1122     $function->name($name);
1123     # if(defined($argument_types)) {
1124     #     $function->argument_types([@$argument_types]);
1125     # }
1126     # if(defined($argument_names)) {
1127     #     $function->argument_names([@$argument_names]);
1128     # }
1129     $function->statements_line($statements_line);
1130     $function->statements_column($statements_column);
1131     $function->statements($statements);
1132
1133     $$reffunction = $function;
1134
1135     return 1;
1136 }
1137
1138 sub parse_c_function_call($$$$$$$$)
1139 {
1140     my ($self, $refcurrent, $refline, $refcolumn, $refname, $refarguments, $refargument_lines, $refargument_columns) = @_;
1141
1142     local $_ = $$refcurrent;
1143     my $line = $$refline;
1144     my $column = $$refcolumn;
1145
1146     my $name;
1147     my @arguments;
1148     my @argument_lines;
1149     my @argument_columns;
1150
1151     if(s/^(\w+)(\s*)(?=\()//s) {
1152         $self->_update_c_position($&, \$line, \$column);
1153
1154         $name = $1;
1155
1156         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1157             return 0;
1158         }
1159     } else {
1160         return 0;
1161     }
1162
1163     $$refcurrent = $_;
1164     $$refline = $line;
1165     $$refcolumn = $column;
1166
1167     $$refname = $name;
1168     @$refarguments = @arguments;
1169     @$refargument_lines = @argument_lines;
1170     @$refargument_columns = @argument_columns;
1171
1172     return 1;
1173 }
1174
1175
1176 sub parse_c_preprocessor($$$$)
1177 {
1178     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1179
1180     local $_ = $$refcurrent;
1181     my $line = $$refline;
1182     my $column = $$refcolumn;
1183
1184     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1185
1186     my $begin_line = $line;
1187     my $begin_column = $column + 1;
1188
1189     if(!$self->{FOUND_PREPROCESSOR}($begin_line, $begin_column, "$_")) {
1190         return 1;
1191     }
1192
1193     if(/^\#\s*define\s*(.*?)$/s) {
1194         $self->_update_c_position($_, \$line, \$column);
1195     } elsif(/^\#\s*else/s) {
1196         $self->_update_c_position($_, \$line, \$column);
1197     } elsif(/^\#\s*endif/s) {
1198         $self->_update_c_position($_, \$line, \$column);
1199     } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
1200         $self->_update_c_position($_, \$line, \$column);
1201     } elsif(/^\#\s*include\s+(.*?)$/s) {
1202         $self->_update_c_position($_, \$line, \$column);
1203     } elsif(/^\#\s*undef\s+(.*?)$/s) {
1204         $self->_update_c_position($_, \$line, \$column);
1205     } else {
1206         $self->_parse_c_error($_, $line, $column, "preprocessor");
1207     }
1208
1209     $$refcurrent = $_;
1210     $$refline = $line;
1211     $$refcolumn = $column;
1212
1213     return 1;
1214 }
1215
1216 sub parse_c_statement($$$$)
1217 {
1218     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1219
1220     local $_ = $$refcurrent;
1221     my $line = $$refline;
1222     my $column = $$refcolumn;
1223
1224     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1225
1226     $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1227
1228     # $output->write("$line.$column: statement: '$_'\n");
1229
1230     if(/^$/) {
1231         # Nothing
1232     } elsif(/^\{/) {
1233         my $statements;
1234         my $statements_line;
1235         my $statements_column;
1236         if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1237             return 0;
1238         }
1239         if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1240             return 0;
1241         }
1242     } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1243         $self->_update_c_position($&, \$line, \$column);
1244
1245         my $name = $1;
1246
1247         my @arguments;
1248         my @argument_lines;
1249         my @argument_columns;
1250         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1251             return 0;
1252         }
1253
1254         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1255         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1256             return 0;
1257         }
1258         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1259
1260         while(defined(my $argument = shift @arguments) &&
1261               defined(my $argument_line = shift @argument_lines) &&
1262               defined(my $argument_column = shift @argument_columns))
1263         {
1264             $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1265         }
1266     } elsif(s/^else//) {
1267         $self->_update_c_position($&, \$line, \$column);
1268         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1269             return 0;
1270         }
1271     } elsif(s/^return//) {
1272         $self->_update_c_position($&, \$line, \$column);
1273         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1274         if(!$self->parse_c_expression(\$_, \$line, \$column)) {
1275             return 0;
1276         }
1277     } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1278         # Nothing
1279     } else {
1280         # $self->_parse_c_error($_, $line, $column, "statement");
1281     }
1282
1283     $self->_update_c_position($_, \$line, \$column);
1284
1285     $$refcurrent = $_;
1286     $$refline = $line;
1287     $$refcolumn = $column;
1288
1289     return 1;
1290 }
1291
1292 sub parse_c_statements($$$$)
1293 {
1294     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1295
1296     local $_ = $$refcurrent;
1297     my $line = $$refline;
1298     my $column = $$refcolumn;
1299
1300     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1301
1302     # $output->write("$line.$column: statements: '$_'\n");
1303
1304     my $statement = "";
1305     my $statement_line = $line;
1306     my $statement_column = $column;
1307
1308     my $previous_line = -1;
1309     my $previous_column = -1;
1310
1311     my $blevel = 1;
1312     my $plevel = 1;
1313     while($plevel > 0 || $blevel > 0) {
1314         my $match;
1315         $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1316
1317         if($previous_line == $line && $previous_column == $column) {
1318             $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1319         }
1320         $previous_line = $line;
1321         $previous_column = $column;
1322
1323         # $output->write("'$match' '$_'\n");
1324
1325         $statement .= $match;
1326         $column++;
1327         if(s/^[\(\[]//) {
1328             $plevel++;
1329             $statement .= $&;
1330         } elsif(s/^[\)\]]//) {
1331             $plevel--;
1332             if($plevel <= 0) {
1333                 $self->_parse_c_error($_, $line, $column, "statements");
1334             }
1335             $statement .= $&;
1336         } elsif(s/^\{//) {
1337             $blevel++;
1338             $statement .= $&;
1339         } elsif(s/^\}//) {
1340             $blevel--;
1341             $statement .= $&;
1342             if($blevel == 1) {
1343                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1344                     return 0;
1345                 }
1346                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1347                 $statement = "";
1348                 $statement_line = $line;
1349                 $statement_column = $column;
1350             }
1351         } elsif(s/^;//) {
1352             if($plevel == 1 && $blevel == 1) {
1353                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1354                     return 0;
1355                 }
1356
1357                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1358                 $statement = "";
1359                 $statement_line = $line;
1360                 $statement_column = $column;
1361             } else {
1362                 $statement .= $&;
1363             }
1364         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1365             $plevel = 0;
1366             $blevel = 0;
1367         } else {
1368             $self->_parse_c_error($_, $line, $column, "statements");
1369         }
1370     }
1371
1372     $self->_update_c_position($_, \$line, \$column);
1373
1374     $$refcurrent = $_;
1375     $$refline = $line;
1376     $$refcolumn = $column;
1377
1378     return 1;
1379 }
1380
1381 sub parse_c_struct_union($$$$$$$$$)
1382 {
1383     my ($self, $refcurrent, $refline, $refcolumn, $refkind, $ref_name, $reffield_type_names, $reffield_names, $refnames) = @_;
1384
1385     local $_ = $$refcurrent;
1386     my $line = $$refline;
1387     my $column = $$refcolumn;
1388
1389     my $kind;
1390     my $_name;
1391     my @field_type_names = ();
1392     my @field_names = ();
1393     my @names = ();
1394
1395     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1396
1397     if (!s/^(interface|struct|union)\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1398         return 0;
1399     }
1400     $kind = $1;
1401     $_name = $2 || "";
1402
1403     $self->_update_c_position($&, \$line, \$column);
1404
1405     my $match;
1406     while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
1407     {
1408         my $field_linkage;
1409         my $field_type_name;
1410         my $field_name;
1411
1412         if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
1413             $field_type_name =~ s/\s+/ /g;
1414
1415             push @field_type_names, $field_type_name;
1416             push @field_names, $field_name;
1417             # $output->write("$kind:$_name:$field_type_name:$field_name\n");
1418         } elsif ($match) {
1419             $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
1420         }
1421
1422         if ($self->_parse_c(';', \$_, \$line, \$column)) {
1423             next;
1424         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
1425             # FIXME: Kludge
1426             my $tuple = "($_)";
1427             my $tuple_line = $line;
1428             my $tuple_column = $column - 1;
1429
1430             my @arguments;
1431             my @argument_lines;
1432             my @argument_columns;
1433
1434             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
1435                                      \@arguments, \@argument_lines, \@argument_columns))
1436             {
1437                 $self->_parse_c_error($_, $line, $column, "$kind");
1438             }
1439
1440             foreach my $argument (@arguments) {
1441                 my $name = $argument;
1442
1443                 push @names, $name;
1444             }
1445
1446             last;
1447         } else {
1448             $self->_parse_c_error($_, $line, $column, "$kind");
1449         }
1450     }
1451
1452     $$refcurrent = $_;
1453     $$refline = $line;
1454     $$refcolumn = $column;
1455
1456     $$refkind = $kind;
1457     $$ref_name = $_name;
1458     @$reffield_type_names = @field_type_names;
1459     @$reffield_names = @field_names;
1460     @$refnames = @names;
1461
1462     return 1;
1463 }
1464
1465 sub parse_c_tuple($$$$$$$)
1466 {
1467     my ($self, $refcurrent, $refline, $refcolumn,
1468         # FIXME: Should not write directly
1469         $items, $item_lines, $item_columns) = @_;
1470
1471     local $_ = $$refcurrent;
1472
1473     my $line = $$refline;
1474     my $column = $$refcolumn;
1475
1476     my $item;
1477     if(s/^\(//) {
1478         $column++;
1479         $item = "";
1480     } else {
1481         return 0;
1482     }
1483
1484     my $item_line = $line;
1485     my $item_column = $column + 1;
1486
1487     my $plevel = 1;
1488     while($plevel > 0) {
1489         my $match;
1490         $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1491
1492         $column++;
1493
1494         $item .= $match;
1495         if(s/^\)//) {
1496             $plevel--;
1497             if($plevel == 0) {
1498                 push @$item_lines, $item_line;
1499                 push @$item_columns, $item_column;
1500                 push @$items, $item;
1501                 $item = "";
1502             } else {
1503                 $item .= ")";
1504             }
1505         } elsif(s/^\(//) {
1506             $plevel++;
1507             $item .= "(";
1508         } elsif(s/^,//) {
1509             if($plevel == 1) {
1510                 push @$item_lines, $item_line;
1511                 push @$item_columns, $item_column;
1512                 push @$items, $item;
1513                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1514                 $item_line = $line;
1515                 $item_column = $column + 1;
1516                 $item = "";
1517             } else {
1518                 $item .= ",";
1519             }
1520         } else {
1521             return 0;
1522         }
1523     }
1524
1525     $$refcurrent = $_;
1526     $$refline = $line;
1527     $$refcolumn = $column;
1528
1529     return 1;
1530 }
1531
1532 sub parse_c_type($$$$$)
1533 {
1534     my ($self, $refcurrent, $refline, $refcolumn, $reftype) = @_;
1535
1536     local $_ = $$refcurrent;
1537     my $line = $$refline;
1538     my $column = $$refcolumn;
1539
1540     my $type;
1541
1542     $self->_parse_c("(?:const|volatile)", \$_, \$line, \$column);
1543
1544     if($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1545         # Nothing
1546     } elsif($self->_parse_c('(?:enum\s+|interface\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
1547                             \$_, \$line, \$column, \$type))
1548     {
1549         # Nothing
1550     } else {
1551         return 0;
1552     }
1553     $type =~ s/\s//g;
1554
1555     $$refcurrent = $_;
1556     $$refline = $line;
1557     $$refcolumn = $column;
1558
1559     $$reftype = $type;
1560
1561     return 1;
1562 }
1563
1564 sub parse_c_typedef($$$$)
1565 {
1566     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1567
1568     local $_ = $$refcurrent;
1569     my $line = $$refline;
1570     my $column = $$refcolumn;
1571
1572     if (!$self->_parse_c("typedef", \$_, \$line, \$column)) {
1573         return 0;
1574     }
1575
1576     my ($kind, $name, @field_type_names, @field_names, @names);
1577     my ($linkage, $type_name);
1578     if ($self->parse_c_enum(\$_, \$line, \$column))
1579 {
1580         # Nothing to do
1581     }
1582     elsif ($self->parse_c_struct_union(\$_, \$line, \$column,
1583                                          \$kind, \$name, \@field_type_names, \@field_names, \@names))
1584     {
1585         my $base_name;
1586         foreach my $_name (@names)
1587         {
1588             if ($_name =~ /^\w+$/)
1589             {
1590                 $base_name = $_name;
1591                 last;
1592             }
1593         }
1594         $base_name="$kind $name" if (!defined $base_name and defined $name);
1595         $base_name=$kind if (!defined $base_name);
1596         foreach my $_name (@names) {
1597             if ($_name =~ /^\w+$/) {
1598                 my $type = $self->{CREATE_TYPE}();
1599
1600                 $type->kind($kind);
1601                 $type->_name($name);
1602                 $type->name($_name);
1603                 $type->field_type_names([@field_type_names]);
1604                 $type->field_names([@field_names]);
1605
1606                 $self->{FOUND_TYPE}($type);
1607             } elsif ($_name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
1608                 my $type_name = "$base_name $1";
1609                 $_name = $2;
1610
1611                 my $type = $self->{CREATE_TYPE}();
1612
1613                 $type->kind("");
1614                 $type->name($_name);
1615                 $type->field_type_names([$type_name]);
1616                 $type->field_names([""]);
1617
1618                 $self->{FOUND_TYPE}($type);
1619             } else {
1620                 $self->_parse_c_error($_, $line, $column, "typedef 2");
1621             }
1622         }
1623     }
1624     elsif ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name))
1625     {
1626         $type_name =~ s/\s+/ /g;
1627
1628         if(defined($type_name) && defined($name)) {
1629             my $type = $self->{CREATE_TYPE}();
1630
1631             if (length($name) == 0) {
1632                 $self->_parse_c_error($_, $line, $column, "typedef");
1633             }
1634
1635             $type->kind("");
1636             $type->name($name);
1637             $type->field_type_names([$type_name]);
1638             $type->field_names([""]);
1639
1640             $self->{FOUND_TYPE}($type);
1641         }
1642     } else {
1643         $self->_parse_c_error($_, $line, $column, "typedef");
1644     }
1645
1646     $$refcurrent = $_;
1647     $$refline = $line;
1648     $$refcolumn = $column;
1649
1650     return 1;
1651 }
1652
1653 sub parse_c_variable($$$$$$$)
1654 {
1655     my ($self, $refcurrent, $refline, $refcolumn, $reflinkage, $reftype, $refname) = @_;
1656
1657     local $_ = $$refcurrent;
1658     my $line = $$refline;
1659     my $column = $$refcolumn;
1660
1661     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1662
1663     my $begin_line = $line;
1664     my $begin_column = $column + 1;
1665
1666     my $linkage = "";
1667     my $sign = "";
1668     my $type = "";
1669     my $name = "";
1670
1671     # $self->_parse_c_warning($_, $line, $column, "variable");
1672
1673     my $match;
1674     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1675                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1676                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1677                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1678                           \$_, \$line, \$column, \$match))
1679     {
1680         if ($match =~ /^(?:extern|static)$/) {
1681             if (!$linkage) {
1682                 $linkage = $match;
1683             } else {
1684                 $self->_parse_c_warning($_, $line, $column, "repeated linkage (ignored): $match");
1685             }
1686         } elsif ($match =~ /^(?:signed|unsigned)$/) {
1687             if (!$sign) {
1688                 $sign = "$match ";
1689             } else {
1690                 $self->_parse_c_warning($_, $line, $column, "repeated sign (ignored): $match");
1691             }
1692         }
1693     }
1694
1695     return 0 if(/^$/);
1696
1697   finished: while (1)
1698     {
1699         if (s/^(enum\s+|interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1700             my $kind = $1;
1701             my $_name = $2;
1702             $self->_update_c_position($&, \$line, \$column);
1703
1704             if(defined($_name)) {
1705                 $type = "$kind $_name { }";
1706             } else {
1707                 $type = "$kind { }";
1708             }
1709
1710             last finished;
1711         } 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) {
1712             $type = "$sign$1";
1713             $name = $2;
1714
1715             if (defined($3)) {
1716                 my $bits = $4;
1717                 local $_ = $3;
1718                 if (/^\[/) {
1719                     $type .= $_;
1720                 } elsif (/^:/) {
1721                     $type .= ":$bits";
1722                 } elsif (/^\{/) {
1723                     # Nothing
1724                 }
1725             }
1726
1727             $type = $self->_format_c_type($type);
1728
1729             last finished;
1730         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*)\s*:\s*(\d+)$//s) {
1731             $type = "$sign$1:$2";
1732             $name = "";
1733             $type = $self->_format_c_type($type);
1734
1735             last finished;
1736         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*\s*\(\s*(?:$CALL_CONVENTION)?(?:\s*\*)*)\s*(\w+)\s*(\)\s*\(.*?\))$//s) {
1737             $type = $self->_format_c_type("$sign$1$3");
1738             $name = $2;
1739
1740             last finished;
1741         } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
1742             $type = $match;
1743             last finished;
1744         } else {
1745             $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
1746             last finished;
1747         }
1748
1749         if($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
1750             $type = $match;
1751             last finished;
1752         } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
1753                                 \$_, \$line, \$column, \$match))
1754         {
1755             $type = $match;
1756             last finished;
1757         } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
1758             $type = $match;
1759             last finished;
1760         } elsif(s/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
1761             my $kind = $1;
1762             my $_name = $2;
1763             $self->_update_c_position($&, \$line, \$column);
1764
1765             if(defined($_name)) {
1766                 $type = "struct $_name { }";
1767             } else {
1768                 $type = "struct { }";
1769             }
1770         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
1771             $type = $&;
1772             $type =~ s/\s//g;
1773         } else {
1774             return 0;
1775         }
1776
1777         # $output->write("*** $type: '$_'\n");
1778
1779         # $self->_parse_c_warning($_, $line, $column, "variable2", "");
1780
1781         if(s/^WINAPI\s*//) {
1782             $self->_update_c_position($&, \$line, \$column);
1783         }
1784
1785         if(s/^(\((?:$CALL_CONVENTION)?\s*\*?\s*(?:$CALL_CONVENTION)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
1786             $self->_update_c_position($&, \$line, \$column);
1787
1788             $name = $1;
1789             $name =~ s/\s//g;
1790
1791             $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
1792             if(s/^\)//) { $column++; }
1793             $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1794
1795             if(!s/^(?:=\s*|,\s*|$)//) {
1796                 return 0;
1797             }
1798         } elsif(s/^(?:\*\s*)*(?:const\s+|volatile\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
1799             $self->_update_c_position($&, \$line, \$column);
1800
1801             $name = $1;
1802             $name =~ s/\s//g;
1803         } elsif(/^$/) {
1804             $name = "";
1805         } else {
1806             return 0;
1807         }
1808         last finished;
1809     }
1810
1811     # $output->write("$type: $name: '$_'\n");
1812
1813     $$refcurrent = $_;
1814     $$refline = $line;
1815     $$refcolumn = $column;
1816
1817     $$reflinkage = $linkage;
1818     $$reftype = $type;
1819     $$refname = $name;
1820
1821     $self->{FOUND_VARIABLE}($begin_line, $begin_column, $linkage, $type, $name);
1822
1823     return 1;
1824 }
1825
1826 1;