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