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