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., 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_expression
 701
 702 sub parse_c_expression {
 703     my $self = shift;
 704
 705     my $refcurrent = shift;
 706     my $refline = shift;
 707     my $refcolumn = shift;
 708
 709     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
 710
 711     local $_ = $$refcurrent;
 712     my $line = $$refline;
 713     my $column = $$refcolumn;
 714
 715     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 716
 717     while($_) {
 718         if(s/^(.*?)(\w+\s*\()/$2/s) {
 719             $self->_update_c_position($1, \$line, \$column);
 720
 721             my $begin_line = $line;
 722             my $begin_column = $column + 1;
 723
 724             my $name;
 725             my @arguments;
 726             my @argument_lines;
 727             my @argument_columns;
 728             if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
 729                 return 0;
 730             }
 731
 732             if(&$$found_function_call($begin_line, $begin_column, $line, $column, $name, \@arguments))
 733             {
 734                 while(defined(my $argument = shift @arguments) &&
 735                       defined(my $argument_line = shift @argument_lines) &&
 736                       defined(my $argument_column = shift @argument_columns))
 737                 {
 738                     $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
 739                 }
 740             }
 741         } else {
 742             $_ = "";
 743         }
 744     }
 745
 746     $self->_update_c_position($_, \$line, \$column);
 747
 748     $$refcurrent = $_;
 749     $$refline = $line;
 750     $$refcolumn = $column;
 751
 752     return 1;
 753 }
 754
 755 ########################################################################
 756 # parse_c_file
 757
 758 sub parse_c_file {
 759     my $self = shift;
 760
 761     my $found_comment = \${$self->{FOUND_COMMENT}};
 762     my $found_line = \${$self->{FOUND_LINE}};
 763
 764     my $refcurrent = shift;
 765     my $refline = shift;
 766     my $refcolumn = shift;
 767
 768     local $_ = $$refcurrent;
 769     my $line = $$refline;
 770     my $column = $$refcolumn;
 771
 772     my $declaration = "";
 773     my $declaration_line = $line;
 774     my $declaration_column = $column;
 775
 776     my $previous_line = 0;
 777     my $previous_column = -1;
 778
 779     my $preprocessor_condition;
 780     my $if = 0;
 781     my $if0 = 0;
 782     my $extern_c = 0;
 783
 784     my $blevel = 1;
 785     my $plevel = 1;
 786     while($plevel > 0 || $blevel > 0) {
 787         my $match;
 788         $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
 789
 790         if($line != $previous_line) {
 791             &$$found_line($line);
 792         } elsif(0 && $column == $previous_column) {
 793             $self->_parse_c_error($_, $line, $column, "file", "no progress");
 794         } else {
 795             # &$$found_line("$line.$column");
 796         }
 797         $previous_line = $line;
 798         $previous_column = $column;
 799
 800         if($match !~ /^\s+$/s && $options->debug) {
 801             $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
 802         }
 803
 804         if(!$declaration && $match =~ s/^\s+//s) {
 805             $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 806         }
 807
 808         if(!$if0) {
 809             $declaration .= $match;
 810
 811             # FIXME: Kludge
 812             if ($declaration =~ s/^extern\s*\"C\"//s) {
 813                 if (s/^\{//) {
 814                     $self->_update_c_position($&, \$line, \$column);
 815                     $declaration = "";
 816                     $declaration_line = $line;
 817                     $declaration_column = $column;
 818
 819                     $extern_c = 1;
 820                     next;
 821                 }
 822             } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
 823                 if (s/^\}//) {
 824                     $self->_update_c_position($&, \$line, \$column);
 825                     $declaration = "";
 826                     $declaration_line = $line;
 827                     $declaration_column = $column;
 828
 829                     $extern_c = 0;
 830                     next;
 831                 }
 832             } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
 833                 my $prefix = $&;
 834                 if ($plevel > 2 || !s/^\)//) {
 835                     $declaration = "$prefix$declaration";
 836                 } else {
 837                     $plevel--;
 838                     $self->_update_c_position($&, \$line, \$column);
 839                     $declaration .= $&;
 840
 841                     my @arguments;
 842                     my @argument_lines;
 843                     my @argument_columns;
 844
 845                     if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
 846                                              \@arguments, \@argument_lines, \@argument_columns))
 847                     {
 848                         $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
 849                     }
 850
 851                     $declaration = "";
 852                     $declaration_line = $line;
 853                     $declaration_column = $column;
 854
 855                     next;
 856                 }
 857             } elsif ($declaration =~ s/^(?:DEFINE_SHLGUID)\s*\(.*?\)//s) {
 858                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 859             } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
 860                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 861             } elsif ($declaration =~ s/^ICOM_DEFINE\(\s*(\w+)\s*,\s*(\w+)\s*\)\s*//s) {
 862                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 863             }
 864         } else {
 865             my $blank_lines = 0;
 866
 867             local $_ = $match;
 868             while(s/^.*?\n//) { $blank_lines++; }
 869
 870             if(!$declaration) {
 871                 $declaration_line = $line;
 872                 $declaration_column = $column;
 873             } else {
 874                 $declaration .= "\n" x $blank_lines;
 875             }
 876
 877         }
 878
 879         if(/^[\#\/]/) {
 880             my $blank_lines = 0;
 881             if(s/^\#\s*//) {
 882                 my $preprocessor_line = $line;
 883                 my $preprocessor_column = $column;
 884
 885                 my $preprocessor = $&;
 886                 while(s/^(.*?)\\\s*\n//) {
 887                     $blank_lines++;
 888                     $preprocessor .= "$1\n";
 889                 }
 890                 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
 891                     $_ = "$2\n$_";
 892                     if(defined($3)) {
 893                         $preprocessor .= "$1$3";
 894                     } else {
 895                         $preprocessor .= $1;
 896                     }
 897                 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
 898                     if(defined($2)) {
 899                         $_ = "$2\n$_";
 900                     } else {
 901                         $blank_lines++;
 902                     }
 903                     $preprocessor .= $1;
 904                 }
 905
 906
 907                 if (0) {
 908                     # Nothing
 909                 } elsif($preprocessor =~ /^\#\s*if/) {
 910                     if($preprocessor =~ /^\#\s*if\s*0/) {
 911                         $if0++;
 912                     } elsif($if0 > 0) {
 913                         $if++;
 914                     } else {
 915                         if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
 916                             $preprocessor_condition = "defined(WORD_BIGENDIAN)";
 917                             # $output->write("'$preprocessor_condition':'$declaration'\n")
 918                         } else {
 919                             $preprocessor_condition = "";
 920                         }
 921                     }
 922                 } elsif($preprocessor =~ /^\#\s*else/) {
 923                     if ($preprocessor_condition ne "") {
 924                         $preprocessor_condition =~ "!$preprocessor_condition";
 925                         $preprocessor_condition =~ s/^!!/!/;
 926                         # $output->write("'$preprocessor_condition':'$declaration'\n")
 927                     }
 928                 } elsif($preprocessor =~ /^\#\s*endif/) {
 929                     if($if0 > 0) {
 930                         if($if > 0) {
 931                             $if--;
 932                         } else {
 933                             $if0--;
 934                         }
 935                     } else {
 936                         if ($preprocessor_condition ne "") {
 937                             # $output->write("'$preprocessor_condition':'$declaration'\n");
 938                             $preprocessor_condition = "";
 939                         }
 940                     }
 941                 }
 942
 943                 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
 944                      return 0;
 945                 }
 946             }
 947
 948             if(s/^\/\*.*?\*\///s) {
 949                 &$$found_comment($line, $column + 1, $&);
 950                 local $_ = $&;
 951                 while(s/^.*?\n//) {
 952                     $blank_lines++;
 953                 }
 954                 if($_) {
 955                     $column += length($_);
 956                 }
 957             } elsif(s/^\/\/(.*?)\n//) {
 958                 &$$found_comment($line, $column + 1, $&);
 959                 $blank_lines++;
 960             } elsif(s/^\///) {
 961                 if(!$if0) {
 962                     $declaration .= $&;
 963                     $column++;
 964                 }
 965             }
 966
 967             $line += $blank_lines;
 968             if($blank_lines > 0) {
 969                 $column = 0;
 970             }
 971
 972             if(!$declaration) {
 973                 $declaration_line = $line;
 974                 $declaration_column = $column;
 975             } elsif($blank_lines > 0) {
 976                 $declaration .= "\n" x $blank_lines;
 977             }
 978
 979             next;
 980         }
 981
 982         $column++;
 983
 984         if($if0) {
 985             s/^.//;
 986             next;
 987         }
 988
 989         if(s/^[\(\[]//) {
 990             $plevel++;
 991             $declaration .= $&;
 992         } elsif(s/^\]//) {
 993             $plevel--;
 994             $declaration .= $&;
 995         } elsif(s/^\)//) {
 996             $plevel--;
 997             if($blevel <= 0) {
 998                 $self->_parse_c_error($_, $line, $column, "file", ") without (");
 999             }
1000             $declaration .= $&;
1001             if($plevel == 1 && $declaration =~ /^__ASM_GLOBAL_FUNC/) {
1002                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1003                     return 0;
1004                 }
1005                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1006                 $declaration = "";
1007                 $declaration_line = $line;
1008                 $declaration_column = $column;
1009             }
1010         } elsif(s/^\{//) {
1011             $blevel++;
1012             $declaration .= $&;
1013         } elsif(s/^\}//) {
1014             $blevel--;
1015             if($blevel <= 0) {
1016                 $self->_parse_c_error($_, $line, $column, "file", "} without {");
1017             }
1018
1019             $declaration .= $&;
1020
1021             if($declaration =~ /^typedef/s ||
1022                $declaration =~ /^(?:const\s+|extern\s+|static\s+)*(?:struct|union)(?:\s+\w+)?\s*\{/s)
1023             {
1024                 # Nothing
1025             } elsif($plevel == 1 && $blevel == 1) {
1026                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1027                     return 0;
1028                 }
1029                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1030                 $declaration = "";
1031                 $declaration_line = $line;
1032                 $declaration_column = $column;
1033             } elsif($column == 1 && !$extern_c) {
1034                 $self->_parse_c_error("", $line, $column, "file", "inner } ends on column 1");
1035             }
1036         } elsif(s/^;//) {
1037             $declaration .= $&;
1038             if(0 && $blevel == 1 &&
1039                $declaration !~ /^typedef/ &&
1040                $declaration !~ /^(?:const\s+|extern\s+|static\s+)?(?:struct|union)(?:\s+\w+)?\s*\{/s &&
1041                $declaration =~ /^(?:\w+(?:\s*\*)*\s+)*(\w+)\s*\(\s*(?:(?:\w+\s*,\s*)*(\w+))?\s*\)\s*(.*?);$/s &&
1042                $1 ne "ICOM_VTABLE" && defined($2) && $2 ne "void" && $3) # K&R
1043             {
1044                 $self->_parse_c_warning("", $line, $column, "file", "function $1: warning: function has K&R format");
1045             } elsif($plevel == 1 && $blevel == 1) {
1046                 $declaration =~ s/\s*;$//;
1047                 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1048                     return 0;
1049                 }
1050                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1051                 $declaration = "";
1052                 $declaration_line = $line;
1053                 $declaration_column = $column;
1054             }
1055         } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
1056             $plevel = 0;
1057             $blevel = 0;
1058         } else {
1059             $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
1060         }
1061     }
1062
1063     $$refcurrent = $_;
1064     $$refline = $line;
1065     $$refcolumn = $column;
1066
1067     return 1;
1068 }
1069
1070 ########################################################################
1071 # parse_c_function
1072
1073 sub parse_c_function {
1074     my $self = shift;
1075
1076     my $file = \${$self->{FILE}};
1077     my $create_function = \${$self->{CREATE_FUNCTION}};
1078
1079     my $refcurrent = shift;
1080     my $refline = shift;
1081     my $refcolumn = shift;
1082
1083     my $reffunction = shift;
1084
1085     local $_ = $$refcurrent;
1086     my $line = $$refline;
1087     my $column = $$refcolumn;
1088
1089     my $linkage = "";
1090     my $calling_convention = "";
1091     my $return_type;
1092     my $name;
1093     my @arguments;
1094     my @argument_lines;
1095     my @argument_columns;
1096     my $statements;
1097     my $statements_line;
1098     my $statements_column;
1099
1100     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1101
1102     my $begin_line = $line;
1103     my $begin_column = $column + 1;
1104
1105     if(0) {
1106         # Nothing
1107     } elsif($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
1108         # Nothing
1109     }
1110
1111     # $self->_parse_c_warning($_, $line, $column, "function", "");
1112
1113     my $match;
1114     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1115                           'signed(?=\s+__int64\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1116                           'unsigned(?=\s+__int64\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1117                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1118                           \$_, \$line, \$column, \$match))
1119     {
1120         if($match =~ /^extern|static$/) {
1121             if(!$linkage) {
1122                 $linkage = $match;
1123             }
1124         }
1125     }
1126
1127     if(0) {
1128         # Nothing
1129     } elsif($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1130         # Nothing
1131     } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1132         # Nothing
1133     } else {
1134         if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
1135             return 0;
1136         }
1137
1138         $self->_parse_c('inline|FAR', \$_, \$line, \$column);
1139
1140         $self->_parse_c("__cdecl|__stdcall|__RPC_STUB|" .
1141                         "CALLBACK|CDECL|PASCAL|" .
1142                         "RPC_ENTRY|RPC_VAR_ENTRY|" .
1143                         "VFWAPIV|VFWAPI|WINAPIV|WINAPI|" .
1144                         "WINE_UNUSED",
1145                         \$_, \$line, \$column, \$calling_convention);
1146
1147
1148         # FIXME: ???: Old variant of __attribute((const))
1149         $self->_parse_c('const', \$_, \$line, \$column);
1150
1151         if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
1152             return 0;
1153         }
1154
1155         my $p = 0;
1156         if(s/^__P\s*\(//) {
1157             $self->_update_c_position($&, \$line, \$column);
1158             $p = 1;
1159         }
1160
1161         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1162             return 0;
1163         }
1164
1165         if($p) {
1166             if (s/^\)//) {
1167                 $self->_update_c_position($&, \$line, \$column);
1168             } else {
1169                 $self->_parse_c_error($_, $line, $column, "function");
1170             }
1171         }
1172     }
1173
1174
1175     if (0) {
1176         # Nothing
1177     } elsif($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
1178         # Nothing
1179     }
1180
1181     my $kar;
1182     # FIXME: Implement proper handling of K&R C functions
1183     $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
1184
1185     if($kar) {
1186         $output->write("K&R: $kar\n");
1187     }
1188
1189     if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1190         return 0;
1191     }
1192
1193     my $end_line = $line;
1194     my $end_column = $column;
1195
1196     $$refcurrent = $_;
1197     $$refline = $line;
1198     $$refcolumn = $column;
1199
1200     my $function = &$$create_function;
1201
1202     $function->file($$file);
1203     $function->begin_line($begin_line);
1204     $function->begin_column($begin_column);
1205     $function->end_line($end_line);
1206     $function->end_column($end_column);
1207     $function->linkage($linkage);
1208     $function->return_type($return_type);
1209     $function->calling_convention($calling_convention);
1210     $function->name($name);
1211     # if(defined($argument_types)) {
1212     #     $function->argument_types([@$argument_types]);
1213     # }
1214     # if(defined($argument_names)) {
1215     #     $function->argument_names([@$argument_names]);
1216     # }
1217     $function->statements_line($statements_line);
1218     $function->statements_column($statements_column);
1219     $function->statements($statements);
1220
1221     $$reffunction = $function;
1222
1223     return 1;
1224 }
1225
1226 ########################################################################
1227 # parse_c_function_call
1228
1229 sub parse_c_function_call {
1230     my $self = shift;
1231
1232     my $refcurrent = shift;
1233     my $refline = shift;
1234     my $refcolumn = shift;
1235
1236     my $refname = shift;
1237     my $refarguments = shift;
1238     my $refargument_lines = shift;
1239     my $refargument_columns = shift;
1240
1241     local $_ = $$refcurrent;
1242     my $line = $$refline;
1243     my $column = $$refcolumn;
1244
1245     my $name;
1246     my @arguments;
1247     my @argument_lines;
1248     my @argument_columns;
1249
1250     if(s/^(\w+)(\s*)(?=\()//s) {
1251         $self->_update_c_position($&, \$line, \$column);
1252
1253         $name = $1;
1254
1255         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1256             return 0;
1257         }
1258     } else {
1259         return 0;
1260     }
1261
1262     $$refcurrent = $_;
1263     $$refline = $line;
1264     $$refcolumn = $column;
1265
1266     $$refname = $name;
1267     @$refarguments = @arguments;
1268     @$refargument_lines = @argument_lines;
1269     @$refargument_columns = @argument_columns;
1270
1271     return 1;
1272 }
1273
1274 ########################################################################
1275 # parse_c_preprocessor
1276
1277 sub parse_c_preprocessor {
1278     my $self = shift;
1279
1280     my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
1281
1282     my $refcurrent = shift;
1283     my $refline = shift;
1284     my $refcolumn = shift;
1285
1286     local $_ = $$refcurrent;
1287     my $line = $$refline;
1288     my $column = $$refcolumn;
1289
1290     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1291
1292     my $begin_line = $line;
1293     my $begin_column = $column + 1;
1294
1295     if(!&$$found_preprocessor($begin_line, $begin_column, "$_")) {
1296         return 1;
1297     }
1298
1299     if(0) {
1300         # Nothing
1301     } elsif(/^\#\s*define\s*(.*?)$/s) {
1302         $self->_update_c_position($_, \$line, \$column);
1303     } elsif(/^\#\s*else/s) {
1304         $self->_update_c_position($_, \$line, \$column);
1305     } elsif(/^\#\s*endif/s) {
1306         $self->_update_c_position($_, \$line, \$column);
1307     } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
1308         $self->_update_c_position($_, \$line, \$column);
1309     } elsif(/^\#\s*include\s+(.*?)$/s) {
1310         $self->_update_c_position($_, \$line, \$column);
1311     } elsif(/^\#\s*undef\s+(.*?)$/s) {
1312         $self->_update_c_position($_, \$line, \$column);
1313     } else {
1314         $self->_parse_c_error($_, $line, $column, "preprocessor");
1315     }
1316
1317     $$refcurrent = $_;
1318     $$refline = $line;
1319     $$refcolumn = $column;
1320
1321     return 1;
1322 }
1323
1324 ########################################################################
1325 # parse_c_statement
1326
1327 sub parse_c_statement {
1328     my $self = shift;
1329
1330     my $refcurrent = shift;
1331     my $refline = shift;
1332     my $refcolumn = shift;
1333
1334     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1335
1336     local $_ = $$refcurrent;
1337     my $line = $$refline;
1338     my $column = $$refcolumn;
1339
1340     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1341
1342     $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1343
1344     # $output->write("$line.$column: statement: '$_'\n");
1345
1346     if(/^$/) {
1347         # Nothing
1348     } elsif(/^\{/) {
1349         my $statements;
1350         my $statements_line;
1351         my $statements_column;
1352         if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1353             return 0;
1354         }
1355         if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1356             return 0;
1357         }
1358     } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1359         $self->_update_c_position($&, \$line, \$column);
1360
1361         my $name = $1;
1362
1363         my @arguments;
1364         my @argument_lines;
1365         my @argument_columns;
1366         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1367             return 0;
1368         }
1369
1370         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1371         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1372             return 0;
1373         }
1374         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1375
1376         while(defined(my $argument = shift @arguments) &&
1377               defined(my $argument_line = shift @argument_lines) &&
1378               defined(my $argument_column = shift @argument_columns))
1379         {
1380             $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1381         }
1382     } elsif(s/^else//) {
1383         $self->_update_c_position($&, \$line, \$column);
1384         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1385             return 0;
1386         }
1387     } elsif(s/^return//) {
1388         $self->_update_c_position($&, \$line, \$column);
1389         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1390         if(!$self->parse_c_expression(\$_, \$line, \$column)) {
1391             return 0;
1392         }
1393     } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1394         # Nothing
1395     } else {
1396         # $self->_parse_c_error($_, $line, $column, "statement");
1397     }
1398
1399     $self->_update_c_position($_, \$line, \$column);
1400
1401     $$refcurrent = $_;
1402     $$refline = $line;
1403     $$refcolumn = $column;
1404
1405     return 1;
1406 }
1407
1408 ########################################################################
1409 # parse_c_statements
1410
1411 sub parse_c_statements {
1412     my $self = shift;
1413
1414     my $refcurrent = shift;
1415     my $refline = shift;
1416     my $refcolumn = shift;
1417
1418     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1419
1420     local $_ = $$refcurrent;
1421     my $line = $$refline;
1422     my $column = $$refcolumn;
1423
1424     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1425
1426     # $output->write("$line.$column: statements: '$_'\n");
1427
1428     my $statement = "";
1429     my $statement_line = $line;
1430     my $statement_column = $column;
1431
1432     my $previous_line = -1;
1433     my $previous_column = -1;
1434
1435     my $blevel = 1;
1436     my $plevel = 1;
1437     while($plevel > 0 || $blevel > 0) {
1438         my $match;
1439         $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1440
1441         if($previous_line == $line && $previous_column == $column) {
1442             $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1443         }
1444         $previous_line = $line;
1445         $previous_column = $column;
1446
1447         # $output->write("'$match' '$_'\n");
1448
1449         $statement .= $match;
1450         $column++;
1451         if(s/^[\(\[]//) {
1452             $plevel++;
1453             $statement .= $&;
1454         } elsif(s/^[\)\]]//) {
1455             $plevel--;
1456             if($plevel <= 0) {
1457                 $self->_parse_c_error($_, $line, $column, "statements");
1458             }
1459             $statement .= $&;
1460         } elsif(s/^\{//) {
1461             $blevel++;
1462             $statement .= $&;
1463         } elsif(s/^\}//) {
1464             $blevel--;
1465             $statement .= $&;
1466             if($blevel == 1) {
1467                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1468                     return 0;
1469                 }
1470                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1471                 $statement = "";
1472                 $statement_line = $line;
1473                 $statement_column = $column;
1474             }
1475         } elsif(s/^;//) {
1476             if($plevel == 1 && $blevel == 1) {
1477                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1478                     return 0;
1479                 }
1480
1481                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1482                 $statement = "";
1483                 $statement_line = $line;
1484                 $statement_column = $column;
1485             } else {
1486                 $statement .= $&;
1487             }
1488         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1489             $plevel = 0;
1490             $blevel = 0;
1491         } else {
1492             $self->_parse_c_error($_, $line, $column, "statements");
1493         }
1494     }
1495
1496     $self->_update_c_position($_, \$line, \$column);
1497
1498     $$refcurrent = $_;
1499     $$refline = $line;
1500     $$refcolumn = $column;
1501
1502     return 1;
1503 }
1504
1505 ########################################################################
1506 # parse_c_tuple
1507
1508 sub parse_c_tuple {
1509     my $self = shift;
1510
1511     my $refcurrent = shift;
1512     my $refline = shift;
1513     my $refcolumn = shift;
1514
1515     # FIXME: Should not write directly
1516     my $items = shift;
1517     my $item_lines = shift;
1518     my $item_columns = shift;
1519
1520     local $_ = $$refcurrent;
1521
1522     my $line = $$refline;
1523     my $column = $$refcolumn;
1524
1525     my $item;
1526     if(s/^\(//) {
1527         $column++;
1528         $item = "";
1529     } else {
1530         return 0;
1531     }
1532
1533     my $item_line = $line;
1534     my $item_column = $column + 1;
1535
1536     my $plevel = 1;
1537     while($plevel > 0) {
1538         my $match;
1539         $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1540
1541         $column++;
1542
1543         $item .= $match;
1544         if(s/^\)//) {
1545             $plevel--;
1546             if($plevel == 0) {
1547                 push @$item_lines, $item_line;
1548                 push @$item_columns, $item_column;
1549                 push @$items, $item;
1550                 $item = "";
1551             } else {
1552                 $item .= ")";
1553             }
1554         } elsif(s/^\(//) {
1555             $plevel++;
1556             $item .= "(";
1557         } elsif(s/^,//) {
1558             if($plevel == 1) {
1559                 push @$item_lines, $item_line;
1560                 push @$item_columns, $item_column;
1561                 push @$items, $item;
1562                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1563                 $item_line = $line;
1564                 $item_column = $column + 1;
1565                 $item = "";
1566             } else {
1567                 $item .= ",";
1568             }
1569         } else {
1570             return 0;
1571         }
1572     }
1573
1574     $$refcurrent = $_;
1575     $$refline = $line;
1576     $$refcolumn = $column;
1577
1578     return 1;
1579 }
1580
1581 ########################################################################
1582 # parse_c_type
1583
1584 sub parse_c_type {
1585     my $self = shift;
1586
1587     my $refcurrent = shift;
1588     my $refline = shift;
1589     my $refcolumn = shift;
1590
1591     my $reftype = shift;
1592
1593     local $_ = $$refcurrent;
1594     my $line = $$refline;
1595     my $column = $$refcolumn;
1596
1597     my $type;
1598
1599     $self->_parse_c("const", \$_, \$line, \$column);
1600
1601     if(0) {
1602         # Nothing
1603     } elsif($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1604         # Nothing
1605     } elsif($self->_parse_c('(?:enum\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
1606                             \$_, \$line, \$column, \$type))
1607     {
1608         # Nothing
1609     } else {
1610         return 0;
1611     }
1612     $type =~ s/\s//g;
1613
1614     $$refcurrent = $_;
1615     $$refline = $line;
1616     $$refcolumn = $column;
1617
1618     $$reftype = $type;
1619
1620     return 1;
1621 }
1622
1623 ########################################################################
1624 # parse_c_typedef
1625
1626 sub parse_c_typedef {
1627     my $self = shift;
1628
1629     my $create_type = \${$self->{CREATE_TYPE}};
1630     my $found_type = \${$self->{FOUND_TYPE}};
1631     my $preprocessor_condition = \${$self->{PREPROCESSOR_CONDITION}};
1632
1633     my $refcurrent = shift;
1634     my $refline = shift;
1635     my $refcolumn = shift;
1636
1637     my $reftype = shift;
1638
1639     local $_ = $$refcurrent;
1640     my $line = $$refline;
1641     my $column = $$refcolumn;
1642
1643     my $type;
1644
1645     if (0) {
1646         # Nothing
1647     } elsif (s/^(?:typedef\s+)?(enum\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1648         $self->_update_c_position($&, \$line, \$column);
1649
1650         my $kind = $1;
1651         my $_name = $2 || "";
1652
1653         $kind =~ s/\s+//g;
1654
1655         if ($kind =~ /^struct|union$/) {
1656             my $name = "";
1657             my @field_type_names = ();
1658             my @field_names = ();
1659
1660             my $match;
1661             while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
1662             {
1663                 my $field_linkage;
1664                 my $field_type_name;
1665                 my $field_name;
1666
1667                 if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
1668                     $field_type_name =~ s/\s+/ /g;
1669
1670                     push @field_type_names, $field_type_name;
1671                     push @field_names, $field_name;
1672                     # $output->write("$kind:$_name:$field_type_name:$field_name\n");
1673                 } elsif ($match) {
1674                     $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
1675                 }
1676
1677                 if ($self->_parse_c(';', \$_, \$line, \$column)) {
1678                     next;
1679                 } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
1680                     # FIXME: Kludge
1681                     my $tuple = "($_)";
1682                     my $tuple_line = $line;
1683                     my $tuple_column = $column - 1;
1684
1685                     my @arguments;
1686                     my @argument_lines;
1687                     my @argument_columns;
1688
1689                     if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
1690                                              \@arguments, \@argument_lines, \@argument_columns))
1691                     {
1692                         $self->_parse_c_error($_, $line, $column, "typedef $kind");
1693                     }
1694
1695                     # FIXME: Kludge
1696                     if ($#arguments >= 0) {
1697                         $name = $arguments[0];
1698                     }
1699
1700                     last;
1701                 } else {
1702                     $self->_parse_c_error($_, $line, $column, "typedef $kind");
1703                 }
1704             }
1705
1706             my $type = &$$create_type();
1707
1708             $type->kind($kind);
1709             $type->_name($_name);
1710             $type->name($name);
1711             $type->field_type_names([@field_type_names]);
1712             $type->field_names([@field_names]);
1713
1714             &$$found_type($type);
1715         } else {
1716             my $name = "";
1717
1718             my $match;
1719             while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
1720                 if ($match) {
1721                     if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
1722                         $self->_parse_c_error($_, $line, $column, "typedef $kind");
1723                     }
1724                     my $enum_name = $1;
1725                     my $enum_value = $2 || "";
1726
1727                     # $output->write("$kind:$_name:$enum_name:$enum_value\n");
1728                 }
1729
1730                 if ($self->_parse_c(',', \$_, \$line, \$column)) {
1731                     next;
1732                 } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
1733                     # FIXME: Kludge
1734                     my $tuple = "($_)";
1735                     my $tuple_line = $line;
1736                     my $tuple_column = $column - 1;
1737
1738                     my @arguments;
1739                     my @argument_lines;
1740                     my @argument_columns;
1741
1742                     if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
1743                                              \@arguments, \@argument_lines, \@argument_columns))
1744                     {
1745                         $self->_parse_c_error($_, $line, $column, "typedef $kind");
1746                     }
1747
1748                     # FIXME: Kludge
1749                     if ($#arguments >= 0) {
1750                         $name = $arguments[0];
1751                     }
1752
1753                     last;
1754                 } else {
1755                     $self->_parse_c_error($_, $line, $column, "typedef $kind");
1756                 }
1757             }
1758
1759             # FIXME: Not correct
1760             # $output->write("typedef:$name:$_name\n");
1761         }
1762     } elsif ($self->_parse_c("typedef", \$_, \$line, \$column)) {
1763         my $linkage;
1764         my $type_name;
1765         my $name;
1766
1767         if ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name)) {
1768             $type_name =~ s/\s+/ /g;
1769
1770             if(defined($type_name) && defined($name)) {
1771                 my $type = &$$create_type();
1772
1773                 if (length($name) == 0) {
1774                     $self->_parse_c_error($_, $line, $column, "typedef");
1775                 }
1776
1777                 $type->kind("");
1778                 $type->name($name);
1779                 $type->pack(1);
1780                 $type->field_type_names([$type_name]);
1781                 $type->field_names([""]);
1782
1783                 &$$found_type($type);
1784             }
1785
1786             if (0 && $_ && !/^,/) {
1787                 $self->_parse_c_error($_, $line, $column, "typedef");
1788             }
1789         } else {
1790             $self->_parse_c_error($_, $line, $column, "typedef");
1791         }
1792     } elsif (0 && $self->_parse_c("typedef", \$_, \$line, \$column)) {
1793         my $type_name;
1794         $self->_parse_c('\w+', \$_, \$line, \$column, \$type_name);
1795
1796         my $name;
1797         $self->_parse_c('\w+', \$_, \$line, \$column, \$name);
1798
1799     } else {
1800         return 0;
1801     }
1802
1803     $$refcurrent = $_;
1804     $$refline = $line;
1805     $$refcolumn = $column;
1806
1807     $$reftype = $type;
1808
1809     return 1;
1810 }
1811
1812 ########################################################################
1813 # parse_c_variable
1814
1815 sub parse_c_variable {
1816     my $self = shift;
1817
1818     my $found_variable = \${$self->{FOUND_VARIABLE}};
1819
1820     my $refcurrent = shift;
1821     my $refline = shift;
1822     my $refcolumn = shift;
1823
1824     my $reflinkage = shift;
1825     my $reftype = shift;
1826     my $refname = shift;
1827
1828     local $_ = $$refcurrent;
1829     my $line = $$refline;
1830     my $column = $$refcolumn;
1831
1832     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1833
1834     my $begin_line = $line;
1835     my $begin_column = $column + 1;
1836
1837     my $linkage = "";
1838     my $type = "";
1839     my $name = "";
1840
1841     # $self->_parse_c_warning($_, $line, $column, "variable");
1842
1843     my $match;
1844     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1845                           'signed(?=\s+__int64\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1846                           'unsigned(?=\s+__int64\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1847                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1848                           \$_, \$line, \$column, \$match))
1849     {
1850         if($match =~ /^extern|static$/) {
1851             if(!$linkage) {
1852                 $linkage = $match;
1853             }
1854         }
1855     }
1856
1857     my $finished = 0;
1858
1859     if($finished) {
1860         # Nothing
1861     } elsif(/^$/) {
1862         return 0;
1863     } elsif(s/^(enum|struct|union)(?:\s+(\w+))?\s*\{//s) {
1864         my $kind = $1;
1865         my $_name = $2;
1866         $self->_update_c_position($&, \$line, \$column);
1867
1868         if(defined($_name)) {
1869             $type = "$kind $_name { }";
1870         } else {
1871             $type = "$kind { }";
1872         }
1873
1874         $finished = 1;
1875     } elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+(?:\s*\*)*)\s*(\w+)\s*(\[.*?\]$|:\s*(\d+)$|\{)?//s) {
1876         $type = $1;
1877         $name = $2;
1878
1879         if (defined($3)) {
1880             my $bits = $4;
1881             local $_ = $3;
1882             if (/^\[/) {
1883                 $type .= $_;
1884             } elsif (/^:/) {
1885                 $type .= ":$bits";
1886             } elsif (/^\{/) {
1887                 # Nothing
1888             }
1889         }
1890
1891         $type = $self->_format_c_type($type);
1892
1893         $finished = 1;
1894     } elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+(?:\s*\*)*\s*\(\s*(?:\*\s*)*)(\w+)\s*(\)\(.*?\))$//s) {
1895         $type = $self->_format_c_type("$1$3");
1896         $name = $2;
1897
1898         $finished = 1;
1899
1900         $type = $self->_format_c_type("$1$3");
1901         $name = $2;
1902
1903         $finished = 1;
1904     } else {
1905         $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
1906     }
1907
1908     if($finished) {
1909         # Nothing
1910     } elsif($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
1911         $type = $match;
1912         $finished = 1;
1913     } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
1914         $type = $match;
1915         $finished = 1;
1916     } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
1917                             \$_, \$line, \$column, \$match))
1918     {
1919         $type = $match;
1920         $finished = 1;
1921     } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
1922         $type = $match;
1923         $finished = 1;
1924     } elsif(s/^(enum|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
1925         my $kind = $1;
1926         my $_name = $2;
1927         $self->_update_c_position($&, \$line, \$column);
1928
1929         if(defined($_name)) {
1930             $type = "struct $_name { }";
1931         } else {
1932             $type = "struct { }";
1933         }
1934     } elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
1935         $type = $&;
1936         $type =~ s/\s//g;
1937     } else {
1938         return 0;
1939     }
1940
1941     # $output->write("*** $type: '$_'\n");
1942
1943     # $self->_parse_c_warning($_, $line, $column, "variable2", "");
1944
1945     if($finished) {
1946         # Nothing
1947     } elsif(s/^WINAPI\s*//) {
1948         $self->_update_c_position($&, \$line, \$column);
1949     } elsif(s/^WINE_UNUSED\s*//) {
1950         $self->_update_c_position($&, \$line, \$column);
1951     }
1952
1953     if($finished) {
1954         # Nothing
1955     } elsif(s/^(\((?:__cdecl|PASCAL|WINAPI)?\s*\*?\s*(?:__cdecl|PASCAL|WINAPI)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
1956         $self->_update_c_position($&, \$line, \$column);
1957
1958         $name = $1;
1959         $name =~ s/\s//g;
1960
1961         $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
1962         if(s/^\)//) { $column++; }
1963         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1964
1965         if(!s/^(?:=\s*|,\s*|$)//) {
1966             return 0;
1967         }
1968     } elsif(s/^(?:\*\s*)*(?:const\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
1969         $self->_update_c_position($&, \$line, \$column);
1970
1971         $name = $1;
1972         $name =~ s/\s//g;
1973     } elsif(/^$/) {
1974         $name = "";
1975     } else {
1976         return 0;
1977     }
1978
1979     # $output->write("$type: $name: '$_'\n");
1980
1981     if(1 || $finished) {
1982         # Nothing
1983     } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(.*?\)', \$_, \$line, \$column, \$match)) {
1984         $type = "<type>";
1985         $name = "<name>";
1986     } elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+)\s*
1987                 (?:\*\s*)*(\w+|\s*\*?\s*\w+\s*\))\s*(?:\[[^\]]*\]|\([^\)]*\))?
1988                 (?:,\s*(?:\*\s*)*(\w+)\s*(?:\[[^\]]*\])?)*
1989             \s*(?:=|$)//sx)
1990     {
1991         $self->_update_c_position($&, \$line, \$column);
1992
1993         $type = $1;
1994         $name = $2;
1995
1996         $type =~ s/\s//g;
1997         $type =~ s/^struct/struct /;
1998     } elsif(/^(enum|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*((?:\*\s*)*)(\w+)\s*(?:=|$)/s) {
1999         $self->_update_c_position($&, \$line, \$column);
2000
2001         my $kind = $1;
2002         my $_name= $2;
2003         my $stars = $3;
2004         $name = $4;
2005
2006         if(defined($_name)) {
2007             $type = "struct $_name { }";
2008         } else {
2009             $type = "struct { }";
2010         }
2011
2012         $stars =~ s/\s//g;
2013         if($stars) {
2014             $type .= " $type";
2015         }
2016     } else {
2017         return 0;
2018     }
2019
2020     $$refcurrent = $_;
2021     $$refline = $line;
2022     $$refcolumn = $column;
2023
2024     $$reflinkage = $linkage;
2025     $$reftype = $type;
2026     $$refname = $name;
2027
2028     if(&$$found_variable($begin_line, $begin_column, $linkage, $type, $name))
2029     {
2030         # Nothing
2031     }
2032
2033     return 1;
2034 }
2035
2036 1;