tools/winapi/c_parser.pm

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