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