tools/winapi/c_parser.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 #
  18
  19 package c_parser;
  20
  21 use strict;
  22
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw();
  28 @EXPORT_OK = qw();
  29
  30 use options qw($options);
  31 use output qw($output);
  32
  33 use c_function;
  34 use c_type;
  35
  36 # Defined a couple common regexp tidbits
  37 my $CALL_CONVENTION="__cdecl|__stdcall|" .
  38                     "__RPC_API|__RPC_STUB|__RPC_USER|" .
  39                     "CALLBACK|CDECL|NTAPI|PASCAL|RPC_ENTRY|RPC_VAR_ENTRY|" .
  40                     "VFWAPI|VFWAPIV|WINAPI|WINAPIV|";
  41
  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     my $self = shift;
 568
 569     my $found_declaration = \${$self->{FOUND_DECLARATION}};
 570     my $found_function = \${$self->{FOUND_FUNCTION}};
 571
 572     my $refcurrent = shift;
 573     my $refline = shift;
 574     my $refcolumn = shift;
 575
 576     local $_ = $$refcurrent;
 577     my $line = $$refline;
 578     my $column = $$refcolumn;
 579
 580     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 581
 582     my $begin_line = $line;
 583     my $begin_column = $column + 1;
 584
 585     my $end_line = $begin_line;
 586     my $end_column = $begin_column;
 587     $self->_update_c_position($_, \$end_line, \$end_column);
 588
 589     if(!&$$found_declaration($begin_line, $begin_column, $end_line, $end_column, $_)) {
 590         return 1;
 591     }
 592
 593     # Function
 594     my $function = shift;
 595
 596     my $linkage = shift;
 597     my $calling_convention = shift;
 598     my $return_type = shift;
 599     my $name = shift;
 600     my @arguments = shift;
 601     my @argument_lines = shift;
 602     my @argument_columns = shift;
 603
 604     # Variable
 605     my $type;
 606
 607     if(0) {
 608         # Nothing
 609     } elsif(s/^WINE_(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
 610         $self->_update_c_position($&, \$line, \$column);
 611     } elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
 612         $self->_update_c_position($&, \$line, \$column);
 613         $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
 614         if(s/\)//) {
 615             $column++;
 616         }
 617     } elsif(s/^(?:DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
 618         $self->_update_c_position($&, \$line, \$column);
 619
 620         my @arguments;
 621         my @argument_lines;
 622         my @argument_columns;
 623
 624         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 625             return 0;
 626         }
 627     } elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
 628         $self->_update_c_position($&, \$line, \$column);
 629     } elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
 630         $self->_update_c_position($&, \$line, \$column);
 631     } elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
 632         $self->_update_c_position($&, \$line, \$column);
 633     } elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
 634         $self->_update_c_position($&, \$line, \$column);
 635     } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
 636         $self->_update_c_position($&, \$line, \$column);
 637     } elsif(s/^(?:__asm__|asm)\s*\(//) {
 638         $self->_update_c_position($&, \$line, \$column);
 639     } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
 640         # Nothing
 641     } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
 642         # Nothing
 643     } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
 644         if(&$$found_function($function))
 645         {
 646             my $statements = $function->statements;
 647             my $statements_line = $function->statements_line;
 648             my $statements_column = $function->statements_column;
 649
 650             if(defined($statements)) {
 651                 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
 652                     return 0;
 653                 }
 654             }
 655         }
 656     } else {
 657         $self->_parse_c_error($_, $line, $column, "declaration");
 658     }
 659
 660     $$refcurrent = $_;
 661     $$refline = $line;
 662     $$refcolumn = $column;
 663
 664     return 1;
 665 }
 666
 667 ########################################################################
 668 # parse_c_declarations
 669
 670 sub parse_c_declarations($$$$) {
 671     my $self = shift;
 672
 673     my $refcurrent = shift;
 674     my $refline = shift;
 675     my $refcolumn = shift;
 676
 677     return 1;
 678 }
 679
 680 ########################################################################
 681 # _parse_c
 682
 683 sub _parse_c($$$$$$) {
 684     my $self = shift;
 685
 686     my $pattern = shift;
 687     my $refcurrent = shift;
 688     my $refline = shift;
 689     my $refcolumn = shift;
 690
 691     my $refmatch = shift;
 692
 693     local $_ = $$refcurrent;
 694     my $line = $$refline;
 695     my $column = $$refcolumn;
 696
 697     my $match;
 698     if(s/^(?:$pattern)//s) {
 699         $self->_update_c_position($&, \$line, \$column);
 700         $match = $&;
 701     } else {
 702         return 0;
 703     }
 704
 705     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 706
 707     $$refcurrent = $_;
 708     $$refline = $line;
 709     $$refcolumn = $column;
 710
 711     $$refmatch = $match;
 712
 713     return 1;
 714 }
 715
 716 ########################################################################
 717 # parse_c_enum
 718
 719 sub parse_c_enum($$$$) {
 720     my $self = shift;
 721
 722     my $refcurrent = shift;
 723     my $refline = shift;
 724     my $refcolumn = shift;
 725
 726     local $_ = $$refcurrent;
 727     my $line = $$refline;
 728     my $column = $$refcolumn;
 729
 730     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 731
 732     if (!s/^enum\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
 733         return 0;
 734     }
 735     my $_name = $1 || "";
 736
 737     $self->_update_c_position($&, \$line, \$column);
 738
 739     my $name = "";
 740
 741     my $match;
 742     while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
 743         if ($match) {
 744             if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
 745                 $self->_parse_c_error($_, $line, $column, "enum");
 746             }
 747             my $enum_name = $1;
 748             my $enum_value = $2 || "";
 749
 750             # $output->write("enum:$_name:$enum_name:$enum_value\n");
 751         }
 752
 753         if ($self->_parse_c(',', \$_, \$line, \$column)) {
 754             next;
 755         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
 756             # FIXME: Kludge
 757             my $tuple = "($_)";
 758             my $tuple_line = $line;
 759             my $tuple_column = $column - 1;
 760
 761             my @arguments;
 762             my @argument_lines;
 763                     my @argument_columns;
 764
 765             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
 766                                      \@arguments, \@argument_lines, \@argument_columns))
 767             {
 768                 $self->_parse_c_error($_, $line, $column, "enum");
 769             }
 770
 771             # FIXME: Kludge
 772             if ($#arguments >= 0) {
 773                 $name = $arguments[0];
 774             }
 775
 776             last;
 777         } else {
 778             $self->_parse_c_error($_, $line, $column, "enum");
 779         }
 780     }
 781
 782     $self->_update_c_position($_, \$line, \$column);
 783
 784     $$refcurrent = $_;
 785     $$refline = $line;
 786     $$refcolumn = $column;
 787 }
 788
 789
 790 ########################################################################
 791 # parse_c_expression
 792
 793 sub parse_c_expression($$$$) {
 794     my $self = shift;
 795
 796     my $refcurrent = shift;
 797     my $refline = shift;
 798     my $refcolumn = shift;
 799
 800     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
 801
 802     local $_ = $$refcurrent;
 803     my $line = $$refline;
 804     my $column = $$refcolumn;
 805
 806     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 807
 808     while($_) {
 809         if(s/^(.*?)(\w+\s*\()/$2/s) {
 810             $self->_update_c_position($1, \$line, \$column);
 811
 812             my $begin_line = $line;
 813             my $begin_column = $column + 1;
 814
 815             my $name;
 816             my @arguments;
 817             my @argument_lines;
 818             my @argument_columns;
 819             if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
 820                 return 0;
 821             }
 822
 823             if(&$$found_function_call($begin_line, $begin_column, $line, $column, $name, \@arguments))
 824             {
 825                 while(defined(my $argument = shift @arguments) &&
 826                       defined(my $argument_line = shift @argument_lines) &&
 827                       defined(my $argument_column = shift @argument_columns))
 828                 {
 829                     $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
 830                 }
 831             }
 832         } else {
 833             $_ = "";
 834         }
 835     }
 836
 837     $self->_update_c_position($_, \$line, \$column);
 838
 839     $$refcurrent = $_;
 840     $$refline = $line;
 841     $$refcolumn = $column;
 842
 843     return 1;
 844 }
 845
 846 ########################################################################
 847 # parse_c_file
 848
 849 sub parse_c_file($$$$) {
 850     my $self = shift;
 851
 852     my $found_comment = \${$self->{FOUND_COMMENT}};
 853     my $found_line = \${$self->{FOUND_LINE}};
 854
 855     my $refcurrent = shift;
 856     my $refline = shift;
 857     my $refcolumn = shift;
 858
 859     local $_ = $$refcurrent;
 860     my $line = $$refline;
 861     my $column = $$refcolumn;
 862
 863     my $declaration = "";
 864     my $declaration_line = $line;
 865     my $declaration_column = $column;
 866
 867     my $previous_line = 0;
 868     my $previous_column = -1;
 869
 870     my $preprocessor_condition;
 871     my $if = 0;
 872     my $if0 = 0;
 873     my $extern_c = 0;
 874
 875     my $blevel = 1;
 876     my $plevel = 1;
 877     while($plevel > 0 || $blevel > 0) {
 878         my $match;
 879         $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
 880
 881         if($line != $previous_line) {
 882             &$$found_line($line);
 883         } elsif(0 && $column == $previous_column) {
 884             $self->_parse_c_error($_, $line, $column, "file", "no progress");
 885         } else {
 886             # &$$found_line("$line.$column");
 887         }
 888         $previous_line = $line;
 889         $previous_column = $column;
 890
 891         if($match !~ /^\s+$/s && $options->debug) {
 892             $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
 893         }
 894
 895         if(!$declaration && $match =~ s/^\s+//s) {
 896             $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 897         }
 898
 899         if(!$if0) {
 900             $declaration .= $match;
 901
 902             # FIXME: Kludge
 903             if ($declaration =~ s/^extern\s*\"C\"//s) {
 904                 if (s/^\{//) {
 905                     $self->_update_c_position($&, \$line, \$column);
 906                     $declaration = "";
 907                     $declaration_line = $line;
 908                     $declaration_column = $column;
 909
 910                     $extern_c = 1;
 911                     next;
 912                 }
 913             } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
 914                 if (s/^\}//) {
 915                     $self->_update_c_position($&, \$line, \$column);
 916                     $declaration = "";
 917                     $declaration_line = $line;
 918                     $declaration_column = $column;
 919
 920                     $extern_c = 0;
 921                     next;
 922                 }
 923             } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
 924                 my $prefix = $&;
 925                 if ($plevel > 2 || !s/^\)//) {
 926                     $declaration = "$prefix$declaration";
 927                 } else {
 928                     $plevel--;
 929                     $self->_update_c_position($&, \$line, \$column);
 930                     $declaration .= $&;
 931
 932                     my @arguments;
 933                     my @argument_lines;
 934                     my @argument_columns;
 935
 936                     if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
 937                                              \@arguments, \@argument_lines, \@argument_columns))
 938                     {
 939                         $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
 940                     }
 941
 942                     $declaration = "";
 943                     $declaration_line = $line;
 944                     $declaration_column = $column;
 945
 946                     next;
 947                 }
 948             } elsif ($declaration =~ s/^(?:DEFINE_SHLGUID)\s*\(.*?\)//s) {
 949                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 950             } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
 951                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 952             } elsif ($declaration =~ s/^ICOM_DEFINE\(\s*(\w+)\s*,\s*(\w+)\s*\)\s*//s) {
 953                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 954             }
 955         } else {
 956             my $blank_lines = 0;
 957
 958             local $_ = $match;
 959             while(s/^.*?\n//) { $blank_lines++; }
 960
 961             if(!$declaration) {
 962                 $declaration_line = $line;
 963                 $declaration_column = $column;
 964             } else {
 965                 $declaration .= "\n" x $blank_lines;
 966             }
 967
 968         }
 969
 970         if(/^[\#\/]/) {
 971             my $blank_lines = 0;
 972             if(s/^\#\s*//) {
 973                 my $preprocessor_line = $line;
 974                 my $preprocessor_column = $column;
 975
 976                 my $preprocessor = $&;
 977                 while(s/^(.*?)\\\s*\n//) {
 978                     $blank_lines++;
 979                     $preprocessor .= "$1\n";
 980                 }
 981                 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
 982                     $_ = "$2\n$_";
 983                     if(defined($3)) {
 984                         $preprocessor .= "$1$3";
 985                     } else {
 986                         $preprocessor .= $1;
 987                     }
 988                 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
 989                     if(defined($2)) {
 990                         $_ = "$2\n$_";
 991                     } else {
 992                         $blank_lines++;
 993                     }
 994                     $preprocessor .= $1;
 995                 }
 996
 997
 998                 if (0) {
 999                     # Nothing
1000                 } elsif($preprocessor =~ /^\#\s*if/) {
1001                     if($preprocessor =~ /^\#\s*if\s*0/) {
1002                         $if0++;
1003                     } elsif($if0 > 0) {
1004                         $if++;
1005                     } else {
1006                         if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
1007                             $preprocessor_condition = "defined(WORD_BIGENDIAN)";
1008                             # $output->write("'$preprocessor_condition':'$declaration'\n")
1009                         } else {
1010                             $preprocessor_condition = "";
1011                         }
1012                     }
1013                 } elsif($preprocessor =~ /^\#\s*else/) {
1014                     if ($preprocessor_condition ne "") {
1015                         $preprocessor_condition =~ "!$preprocessor_condition";
1016                         $preprocessor_condition =~ s/^!!/!/;
1017                         # $output->write("'$preprocessor_condition':'$declaration'\n")
1018                     }
1019                 } elsif($preprocessor =~ /^\#\s*endif/) {
1020                     if($if0 > 0) {
1021                         if($if > 0) {
1022                             $if--;
1023                         } else {
1024                             $if0--;
1025                         }
1026                     } else {
1027                         if ($preprocessor_condition ne "") {
1028                             # $output->write("'$preprocessor_condition':'$declaration'\n");
1029                             $preprocessor_condition = "";
1030                         }
1031                     }
1032                 }
1033
1034                 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
1035                      return 0;
1036                 }
1037             }
1038
1039             if(s/^\/\*.*?\*\///s) {
1040                 &$$found_comment($line, $column + 1, $&);
1041                 local $_ = $&;
1042                 while(s/^.*?\n//) {
1043                     $blank_lines++;
1044                 }
1045                 if($_) {
1046                     $column += length($_);
1047                 }
1048             } elsif(s/^\/\/(.*?)\n//) {
1049                 &$$found_comment($line, $column + 1, $&);
1050                 $blank_lines++;
1051             } elsif(s/^\///) {
1052                 if(!$if0) {
1053                     $declaration .= $&;
1054                     $column++;
1055                 }
1056             }
1057
1058             $line += $blank_lines;
1059             if($blank_lines > 0) {
1060                 $column = 0;
1061             }
1062
1063             if(!$declaration) {
1064                 $declaration_line = $line;
1065                 $declaration_column = $column;
1066             } elsif($blank_lines > 0) {
1067                 $declaration .= "\n" x $blank_lines;
1068             }
1069
1070             next;
1071         }
1072
1073         $column++;
1074
1075         if($if0) {
1076             s/^.//;
1077             next;
1078         }
1079
1080         if(s/^[\(\[]//) {
1081             $plevel++;
1082             $declaration .= $&;
1083         } elsif(s/^\]//) {
1084             $plevel--;
1085             $declaration .= $&;
1086         } elsif(s/^\)//) {
1087             $plevel--;
1088             if($blevel <= 0) {
1089                 $self->_parse_c_error($_, $line, $column, "file", ") without (");
1090             }
1091             $declaration .= $&;
1092             if($plevel == 1 && $declaration =~ /^__ASM_GLOBAL_FUNC/) {
1093                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1094                     return 0;
1095                 }
1096                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1097                 $declaration = "";
1098                 $declaration_line = $line;
1099                 $declaration_column = $column;
1100             }
1101         } elsif(s/^\{//) {
1102             $blevel++;
1103             $declaration .= $&;
1104         } elsif(s/^\}//) {
1105             $blevel--;
1106             if($blevel <= 0) {
1107                 $self->_parse_c_error($_, $line, $column, "file", "} without {");
1108             }
1109
1110             $declaration .= $&;
1111
1112             if($declaration =~ /^typedef/s ||
1113                $declaration =~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)*(?:interface|struct|union)(?:\s+\w+)?\s*\{/s)
1114             {
1115                 # Nothing
1116             } elsif($plevel == 1 && $blevel == 1) {
1117                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1118                     return 0;
1119                 }
1120                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1121                 $declaration = "";
1122                 $declaration_line = $line;
1123                 $declaration_column = $column;
1124             } elsif($column == 1 && !$extern_c) {
1125                 $self->_parse_c_error("", $line, $column, "file", "inner } ends on column 1");
1126             }
1127         } elsif(s/^;//) {
1128             $declaration .= $&;
1129             if(0 && $blevel == 1 &&
1130                $declaration !~ /^typedef/ &&
1131                $declaration !~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)?(?:interface|struct|union)(?:\s+\w+)?\s*\{/s &&
1132                $declaration =~ /^(?:\w+(?:\s*\*)*\s+)*(\w+)\s*\(\s*(?:(?:\w+\s*,\s*)*(\w+))?\s*\)\s*(.*?);$/s &&
1133                $1 ne "ICOM_VTABLE" && defined($2) && $2 ne "void" && $3) # K&R
1134             {
1135                 $self->_parse_c_warning("", $line, $column, "file", "function $1: warning: function has K&R format");
1136             } elsif($plevel == 1 && $blevel == 1) {
1137                 $declaration =~ s/\s*;$//;
1138                 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1139                     return 0;
1140                 }
1141                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1142                 $declaration = "";
1143                 $declaration_line = $line;
1144                 $declaration_column = $column;
1145             }
1146         } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
1147             $plevel = 0;
1148             $blevel = 0;
1149         } else {
1150             $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
1151         }
1152     }
1153
1154     $$refcurrent = $_;
1155     $$refline = $line;
1156     $$refcolumn = $column;
1157
1158     return 1;
1159 }
1160
1161 ########################################################################
1162 # parse_c_function
1163
1164 sub parse_c_function($$$$$) {
1165     my $self = shift;
1166
1167     my $file = \${$self->{FILE}};
1168     my $create_function = \${$self->{CREATE_FUNCTION}};
1169
1170     my $refcurrent = shift;
1171     my $refline = shift;
1172     my $refcolumn = shift;
1173
1174     my $reffunction = shift;
1175
1176     local $_ = $$refcurrent;
1177     my $line = $$refline;
1178     my $column = $$refcolumn;
1179
1180     my $linkage = "";
1181     my $calling_convention = "";
1182     my $return_type;
1183     my $name;
1184     my @arguments;
1185     my @argument_lines;
1186     my @argument_columns;
1187     my $statements;
1188     my $statements_line;
1189     my $statements_column;
1190
1191     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1192
1193     my $begin_line = $line;
1194     my $begin_column = $column + 1;
1195
1196     if(0) {
1197         # Nothing
1198     } elsif($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
1199         # Nothing
1200     }
1201
1202     # $self->_parse_c_warning($_, $line, $column, "function", "");
1203
1204     my $match;
1205     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1206                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1207                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1208                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1209                           \$_, \$line, \$column, \$match))
1210     {
1211         if($match =~ /^(?:extern|static)$/) {
1212             if(!$linkage) {
1213                 $linkage = $match;
1214             }
1215         }
1216     }
1217
1218     if(0) {
1219         # Nothing
1220     } elsif($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1221         # Nothing
1222     } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1223         # Nothing
1224     } else {
1225         if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
1226             return 0;
1227         }
1228
1229         $self->_parse_c('inline|FAR', \$_, \$line, \$column);
1230
1231         $self->_parse_c($CALL_CONVENTION,
1232                         \$_, \$line, \$column, \$calling_convention);
1233
1234
1235         # FIXME: ???: Old variant of __attribute((const))
1236         $self->_parse_c('(?:const|volatile)', \$_, \$line, \$column);
1237
1238         if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
1239             return 0;
1240         }
1241
1242         my $p = 0;
1243         if(s/^__P\s*\(//) {
1244             $self->_update_c_position($&, \$line, \$column);
1245             $p = 1;
1246         }
1247
1248         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1249             return 0;
1250         }
1251
1252         if($p) {
1253             if (s/^\)//) {
1254                 $self->_update_c_position($&, \$line, \$column);
1255             } else {
1256                 $self->_parse_c_error($_, $line, $column, "function");
1257             }
1258         }
1259     }
1260
1261
1262     if (0) {
1263         # Nothing
1264     } elsif($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
1265         # Nothing
1266     }
1267
1268     my $kar;
1269     # FIXME: Implement proper handling of K&R C functions
1270     $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
1271
1272     if($kar) {
1273         $output->write("K&R: $kar\n");
1274     }
1275
1276     if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1277         return 0;
1278     }
1279
1280     my $end_line = $line;
1281     my $end_column = $column;
1282
1283     $$refcurrent = $_;
1284     $$refline = $line;
1285     $$refcolumn = $column;
1286
1287     my $function = &$$create_function;
1288
1289     $function->file($$file);
1290     $function->begin_line($begin_line);
1291     $function->begin_column($begin_column);
1292     $function->end_line($end_line);
1293     $function->end_column($end_column);
1294     $function->linkage($linkage);
1295     $function->return_type($return_type);
1296     $function->calling_convention($calling_convention);
1297     $function->name($name);
1298     # if(defined($argument_types)) {
1299     #     $function->argument_types([@$argument_types]);
1300     # }
1301     # if(defined($argument_names)) {
1302     #     $function->argument_names([@$argument_names]);
1303     # }
1304     $function->statements_line($statements_line);
1305     $function->statements_column($statements_column);
1306     $function->statements($statements);
1307
1308     $$reffunction = $function;
1309
1310     return 1;
1311 }
1312
1313 ########################################################################
1314 # parse_c_function_call
1315
1316 sub parse_c_function_call($$$$$$$$) {
1317     my $self = shift;
1318
1319     my $refcurrent = shift;
1320     my $refline = shift;
1321     my $refcolumn = shift;
1322
1323     my $refname = shift;
1324     my $refarguments = shift;
1325     my $refargument_lines = shift;
1326     my $refargument_columns = shift;
1327
1328     local $_ = $$refcurrent;
1329     my $line = $$refline;
1330     my $column = $$refcolumn;
1331
1332     my $name;
1333     my @arguments;
1334     my @argument_lines;
1335     my @argument_columns;
1336
1337     if(s/^(\w+)(\s*)(?=\()//s) {
1338         $self->_update_c_position($&, \$line, \$column);
1339
1340         $name = $1;
1341
1342         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1343             return 0;
1344         }
1345     } else {
1346         return 0;
1347     }
1348
1349     $$refcurrent = $_;
1350     $$refline = $line;
1351     $$refcolumn = $column;
1352
1353     $$refname = $name;
1354     @$refarguments = @arguments;
1355     @$refargument_lines = @argument_lines;
1356     @$refargument_columns = @argument_columns;
1357
1358     return 1;
1359 }
1360
1361 ########################################################################
1362 # parse_c_preprocessor
1363
1364 sub parse_c_preprocessor($$$$) {
1365     my $self = shift;
1366
1367     my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
1368
1369     my $refcurrent = shift;
1370     my $refline = shift;
1371     my $refcolumn = shift;
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     my $begin_line = $line;
1380     my $begin_column = $column + 1;
1381
1382     if(!&$$found_preprocessor($begin_line, $begin_column, "$_")) {
1383         return 1;
1384     }
1385
1386     if(0) {
1387         # Nothing
1388     } elsif(/^\#\s*define\s*(.*?)$/s) {
1389         $self->_update_c_position($_, \$line, \$column);
1390     } elsif(/^\#\s*else/s) {
1391         $self->_update_c_position($_, \$line, \$column);
1392     } elsif(/^\#\s*endif/s) {
1393         $self->_update_c_position($_, \$line, \$column);
1394     } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
1395         $self->_update_c_position($_, \$line, \$column);
1396     } elsif(/^\#\s*include\s+(.*?)$/s) {
1397         $self->_update_c_position($_, \$line, \$column);
1398     } elsif(/^\#\s*undef\s+(.*?)$/s) {
1399         $self->_update_c_position($_, \$line, \$column);
1400     } else {
1401         $self->_parse_c_error($_, $line, $column, "preprocessor");
1402     }
1403
1404     $$refcurrent = $_;
1405     $$refline = $line;
1406     $$refcolumn = $column;
1407
1408     return 1;
1409 }
1410
1411 ########################################################################
1412 # parse_c_statement
1413
1414 sub parse_c_statement($$$$) {
1415     my $self = shift;
1416
1417     my $refcurrent = shift;
1418     my $refline = shift;
1419     my $refcolumn = shift;
1420
1421     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1422
1423     local $_ = $$refcurrent;
1424     my $line = $$refline;
1425     my $column = $$refcolumn;
1426
1427     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1428
1429     $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1430
1431     # $output->write("$line.$column: statement: '$_'\n");
1432
1433     if(/^$/) {
1434         # Nothing
1435     } elsif(/^\{/) {
1436         my $statements;
1437         my $statements_line;
1438         my $statements_column;
1439         if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1440             return 0;
1441         }
1442         if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1443             return 0;
1444         }
1445     } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1446         $self->_update_c_position($&, \$line, \$column);
1447
1448         my $name = $1;
1449
1450         my @arguments;
1451         my @argument_lines;
1452         my @argument_columns;
1453         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1454             return 0;
1455         }
1456
1457         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1458         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1459             return 0;
1460         }
1461         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1462
1463         while(defined(my $argument = shift @arguments) &&
1464               defined(my $argument_line = shift @argument_lines) &&
1465               defined(my $argument_column = shift @argument_columns))
1466         {
1467             $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1468         }
1469     } elsif(s/^else//) {
1470         $self->_update_c_position($&, \$line, \$column);
1471         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1472             return 0;
1473         }
1474     } elsif(s/^return//) {
1475         $self->_update_c_position($&, \$line, \$column);
1476         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1477         if(!$self->parse_c_expression(\$_, \$line, \$column)) {
1478             return 0;
1479         }
1480     } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1481         # Nothing
1482     } else {
1483         # $self->_parse_c_error($_, $line, $column, "statement");
1484     }
1485
1486     $self->_update_c_position($_, \$line, \$column);
1487
1488     $$refcurrent = $_;
1489     $$refline = $line;
1490     $$refcolumn = $column;
1491
1492     return 1;
1493 }
1494
1495 ########################################################################
1496 # parse_c_statements
1497
1498 sub parse_c_statements($$$$) {
1499     my $self = shift;
1500
1501     my $refcurrent = shift;
1502     my $refline = shift;
1503     my $refcolumn = shift;
1504
1505     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1506
1507     local $_ = $$refcurrent;
1508     my $line = $$refline;
1509     my $column = $$refcolumn;
1510
1511     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1512
1513     # $output->write("$line.$column: statements: '$_'\n");
1514
1515     my $statement = "";
1516     my $statement_line = $line;
1517     my $statement_column = $column;
1518
1519     my $previous_line = -1;
1520     my $previous_column = -1;
1521
1522     my $blevel = 1;
1523     my $plevel = 1;
1524     while($plevel > 0 || $blevel > 0) {
1525         my $match;
1526         $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1527
1528         if($previous_line == $line && $previous_column == $column) {
1529             $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1530         }
1531         $previous_line = $line;
1532         $previous_column = $column;
1533
1534         # $output->write("'$match' '$_'\n");
1535
1536         $statement .= $match;
1537         $column++;
1538         if(s/^[\(\[]//) {
1539             $plevel++;
1540             $statement .= $&;
1541         } elsif(s/^[\)\]]//) {
1542             $plevel--;
1543             if($plevel <= 0) {
1544                 $self->_parse_c_error($_, $line, $column, "statements");
1545             }
1546             $statement .= $&;
1547         } elsif(s/^\{//) {
1548             $blevel++;
1549             $statement .= $&;
1550         } elsif(s/^\}//) {
1551             $blevel--;
1552             $statement .= $&;
1553             if($blevel == 1) {
1554                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1555                     return 0;
1556                 }
1557                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1558                 $statement = "";
1559                 $statement_line = $line;
1560                 $statement_column = $column;
1561             }
1562         } elsif(s/^;//) {
1563             if($plevel == 1 && $blevel == 1) {
1564                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1565                     return 0;
1566                 }
1567
1568                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1569                 $statement = "";
1570                 $statement_line = $line;
1571                 $statement_column = $column;
1572             } else {
1573                 $statement .= $&;
1574             }
1575         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1576             $plevel = 0;
1577             $blevel = 0;
1578         } else {
1579             $self->_parse_c_error($_, $line, $column, "statements");
1580         }
1581     }
1582
1583     $self->_update_c_position($_, \$line, \$column);
1584
1585     $$refcurrent = $_;
1586     $$refline = $line;
1587     $$refcolumn = $column;
1588
1589     return 1;
1590 }
1591
1592 ########################################################################
1593 # parse_c_struct_union
1594
1595 sub parse_c_struct_union($$$$$$$$$) {
1596     my $self = shift;
1597
1598     my $refcurrent = shift;
1599     my $refline = shift;
1600     my $refcolumn = shift;
1601
1602     my $refkind = shift;
1603     my $ref_name = shift;
1604     my $reffield_type_names = shift;
1605     my $reffield_names = shift;
1606     my $refnames = shift;
1607
1608     local $_ = $$refcurrent;
1609     my $line = $$refline;
1610     my $column = $$refcolumn;
1611
1612     my $kind;
1613     my $_name;
1614     my @field_type_names = ();
1615     my @field_names = ();
1616     my @names = ();
1617
1618     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1619
1620     if (!s/^(interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1621         return 0;
1622     }
1623     $kind = $1;
1624     $_name = $2 || "";
1625
1626     $self->_update_c_position($&, \$line, \$column);
1627
1628     $kind =~ s/\s+//g;
1629
1630     my $match;
1631     while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
1632     {
1633         my $field_linkage;
1634         my $field_type_name;
1635         my $field_name;
1636
1637         if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
1638             $field_type_name =~ s/\s+/ /g;
1639
1640             push @field_type_names, $field_type_name;
1641             push @field_names, $field_name;
1642             # $output->write("$kind:$_name:$field_type_name:$field_name\n");
1643         } elsif ($match) {
1644             $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
1645         }
1646
1647         if ($self->_parse_c(';', \$_, \$line, \$column)) {
1648             next;
1649         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
1650             # FIXME: Kludge
1651             my $tuple = "($_)";
1652             my $tuple_line = $line;
1653             my $tuple_column = $column - 1;
1654
1655             my @arguments;
1656             my @argument_lines;
1657             my @argument_columns;
1658
1659             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
1660                                      \@arguments, \@argument_lines, \@argument_columns))
1661             {
1662                 $self->_parse_c_error($_, $line, $column, "$kind");
1663             }
1664
1665             foreach my $argument (@arguments) {
1666                 my $name = $argument;
1667
1668                 push @names, $name;
1669             }
1670
1671             last;
1672         } else {
1673             $self->_parse_c_error($_, $line, $column, "$kind");
1674         }
1675     }
1676
1677     $$refcurrent = $_;
1678     $$refline = $line;
1679     $$refcolumn = $column;
1680
1681     $$refkind = $kind;
1682     $$ref_name = $_name;
1683     @$reffield_type_names = @field_type_names;
1684     @$reffield_names = @field_names;
1685     @$refnames = @names;
1686
1687     return 1;
1688 }
1689
1690 ########################################################################
1691 # parse_c_tuple
1692
1693 sub parse_c_tuple($$$$$$$) {
1694     my $self = shift;
1695
1696     my $refcurrent = shift;
1697     my $refline = shift;
1698     my $refcolumn = shift;
1699
1700     # FIXME: Should not write directly
1701     my $items = shift;
1702     my $item_lines = shift;
1703     my $item_columns = shift;
1704
1705     local $_ = $$refcurrent;
1706
1707     my $line = $$refline;
1708     my $column = $$refcolumn;
1709
1710     my $item;
1711     if(s/^\(//) {
1712         $column++;
1713         $item = "";
1714     } else {
1715         return 0;
1716     }
1717
1718     my $item_line = $line;
1719     my $item_column = $column + 1;
1720
1721     my $plevel = 1;
1722     while($plevel > 0) {
1723         my $match;
1724         $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1725
1726         $column++;
1727
1728         $item .= $match;
1729         if(s/^\)//) {
1730             $plevel--;
1731             if($plevel == 0) {
1732                 push @$item_lines, $item_line;
1733                 push @$item_columns, $item_column;
1734                 push @$items, $item;
1735                 $item = "";
1736             } else {
1737                 $item .= ")";
1738             }
1739         } elsif(s/^\(//) {
1740             $plevel++;
1741             $item .= "(";
1742         } elsif(s/^,//) {
1743             if($plevel == 1) {
1744                 push @$item_lines, $item_line;
1745                 push @$item_columns, $item_column;
1746                 push @$items, $item;
1747                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1748                 $item_line = $line;
1749                 $item_column = $column + 1;
1750                 $item = "";
1751             } else {
1752                 $item .= ",";
1753             }
1754         } else {
1755             return 0;
1756         }
1757     }
1758
1759     $$refcurrent = $_;
1760     $$refline = $line;
1761     $$refcolumn = $column;
1762
1763     return 1;
1764 }
1765
1766 ########################################################################
1767 # parse_c_type
1768
1769 sub parse_c_type($$$$$) {
1770     my $self = shift;
1771
1772     my $refcurrent = shift;
1773     my $refline = shift;
1774     my $refcolumn = shift;
1775
1776     my $reftype = shift;
1777
1778     local $_ = $$refcurrent;
1779     my $line = $$refline;
1780     my $column = $$refcolumn;
1781
1782     my $type;
1783
1784     $self->_parse_c("(?:const|volatile)", \$_, \$line, \$column);
1785
1786     if(0) {
1787         # Nothing
1788     } elsif($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1789         # Nothing
1790     } elsif($self->_parse_c('(?:enum\s+|interface\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
1791                             \$_, \$line, \$column, \$type))
1792     {
1793         # Nothing
1794     } else {
1795         return 0;
1796     }
1797     $type =~ s/\s//g;
1798
1799     $$refcurrent = $_;
1800     $$refline = $line;
1801     $$refcolumn = $column;
1802
1803     $$reftype = $type;
1804
1805     return 1;
1806 }
1807
1808 ########################################################################
1809 # parse_c_typedef
1810
1811 sub parse_c_typedef($$$$) {
1812     my $self = shift;
1813
1814     my $create_type = \${$self->{CREATE_TYPE}};
1815     my $found_type = \${$self->{FOUND_TYPE}};
1816     my $preprocessor_condition = \${$self->{PREPROCESSOR_CONDITION}};
1817
1818     my $refcurrent = shift;
1819     my $refline = shift;
1820     my $refcolumn = shift;
1821
1822     local $_ = $$refcurrent;
1823     my $line = $$refline;
1824     my $column = $$refcolumn;
1825
1826     my $type;
1827
1828     if (!$self->_parse_c("typedef", \$_, \$line, \$column)) {
1829         return 0;
1830     }
1831
1832     my $finished = 0;
1833
1834     if ($finished) {
1835         # Nothing
1836     } elsif ($self->parse_c_enum(\$_, \$line, \$column)) {
1837         $finished = 1;
1838     }
1839
1840     my $kind;
1841     my $_name;
1842     my @field_type_names;
1843     my @field_names;
1844     my @names;
1845     if ($finished) {
1846         # Nothing
1847     } elsif ($self->parse_c_struct_union(\$_, \$line, \$column,
1848                                          \$kind, \$_name, \@field_type_names, \@field_names, \@names))
1849     {
1850         my $base_name;
1851         foreach my $name (@names)
1852         {
1853             if ($name =~ /^\w+$/)
1854             {
1855                 $base_name = $name;
1856                 last;
1857             }
1858         }
1859         $base_name="$kind $_name" if (!defined $base_name and defined $_name);
1860         $base_name=$kind if (!defined $base_name);
1861         foreach my $name (@names) {
1862             if ($name =~ /^\w+$/) {
1863                 my $type = &$$create_type();
1864
1865                 $type->kind($kind);
1866                 $type->_name($_name);
1867                 $type->name($name);
1868                 $type->field_type_names([@field_type_names]);
1869                 $type->field_names([@field_names]);
1870
1871                 &$$found_type($type);
1872             } elsif ($name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
1873                 my $type_name = "$base_name $1";
1874                 $name = $2;
1875
1876                 my $type = &$$create_type();
1877
1878                 $type->kind("");
1879                 $type->name($name);
1880                 $type->field_type_names([$type_name]);
1881                 $type->field_names([""]);
1882
1883                 &$$found_type($type);
1884             } else {
1885                 $self->_parse_c_error($_, $line, $column, "typedef 2");
1886             }
1887         }
1888
1889         $finished = 1;
1890     }
1891
1892     my $linkage;
1893     my $type_name;
1894     my $name;
1895     if ($finished) {
1896         # Nothing
1897     } elsif ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name)) {
1898         $type_name =~ s/\s+/ /g;
1899
1900         if(defined($type_name) && defined($name)) {
1901             my $type = &$$create_type();
1902
1903             if (length($name) == 0) {
1904                 $self->_parse_c_error($_, $line, $column, "typedef");
1905             }
1906
1907             $type->kind("");
1908             $type->name($name);
1909             $type->field_type_names([$type_name]);
1910             $type->field_names([""]);
1911
1912             &$$found_type($type);
1913         }
1914
1915         if (0 && $_ && !/^,/) {
1916             $self->_parse_c_error($_, $line, $column, "typedef");
1917         }
1918     } else {
1919         $self->_parse_c_error($_, $line, $column, "typedef");
1920     }
1921
1922     $$refcurrent = $_;
1923     $$refline = $line;
1924     $$refcolumn = $column;
1925
1926     return 1;
1927 }
1928
1929 ########################################################################
1930 # parse_c_variable
1931
1932 sub parse_c_variable($$$$$$$) {
1933     my $self = shift;
1934
1935     my $found_variable = \${$self->{FOUND_VARIABLE}};
1936
1937     my $refcurrent = shift;
1938     my $refline = shift;
1939     my $refcolumn = shift;
1940
1941     my $reflinkage = shift;
1942     my $reftype = shift;
1943     my $refname = shift;
1944
1945     local $_ = $$refcurrent;
1946     my $line = $$refline;
1947     my $column = $$refcolumn;
1948
1949     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1950
1951     my $begin_line = $line;
1952     my $begin_column = $column + 1;
1953
1954     my $linkage = "";
1955     my $sign = "";
1956     my $type = "";
1957     my $name = "";
1958
1959     # $self->_parse_c_warning($_, $line, $column, "variable");
1960
1961     my $match;
1962     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1963                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1964                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1965                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1966                           \$_, \$line, \$column, \$match))
1967     {
1968         if ($match =~ /^(?:extern|static)$/) {
1969             if (!$linkage) {
1970                 $linkage = $match;
1971             } else {
1972                 $self->_parse_c_warning($_, $line, $column, "repeated linkage (ignored): $match");
1973             }
1974         } elsif ($match =~ /^(?:signed|unsigned)$/) {
1975             if (!$sign) {
1976                 $sign = "$match ";
1977             } else {
1978                 $self->_parse_c_warning($_, $line, $column, "repeated sign (ignored): $match");
1979             }
1980         }
1981     }
1982
1983     my $finished = 0;
1984
1985     if($finished) {
1986         # Nothing
1987     } elsif(/^$/) {
1988         return 0;
1989     } elsif (s/^(enum\s+|interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1990         my $kind = $1;
1991         my $_name = $2;
1992         $self->_update_c_position($&, \$line, \$column);
1993
1994         if(defined($_name)) {
1995             $type = "$kind $_name { }";
1996         } else {
1997             $type = "$kind { }";
1998         }
1999
2000         $finished = 1;
2001     } 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) {
2002         $type = "$sign$1";
2003         $name = $2;
2004
2005         if (defined($3)) {
2006             my $bits = $4;
2007             local $_ = $3;
2008             if (/^\[/) {
2009                 $type .= $_;
2010             } elsif (/^:/) {
2011                 $type .= ":$bits";
2012             } elsif (/^\{/) {
2013                 # Nothing
2014             }
2015         }
2016
2017         $type = $self->_format_c_type($type);
2018
2019         $finished = 1;
2020     } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*)\s*:\s*(\d+)$//s) {
2021         $type = "$sign$1:$2";
2022         $name = "";
2023         $type = $self->_format_c_type($type);
2024
2025         $finished = 1;
2026     } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*\s*\(\s*(?:$CALL_CONVENTION)?(?:\s*\*)*)\s*(\w+)\s*(\)\s*\(.*?\))$//s) {
2027         $type = $self->_format_c_type("$sign$1$3");
2028         $name = $2;
2029
2030         $finished = 1;
2031     } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
2032         $type = $match;
2033         $finished = 1;
2034     } else {
2035         $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
2036         $finished = 1;
2037     }
2038
2039     if($finished) {
2040         # Nothing
2041     } elsif($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
2042         $type = $match;
2043         $finished = 1;
2044     } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
2045                             \$_, \$line, \$column, \$match))
2046     {
2047         $type = $match;
2048         $finished = 1;
2049     } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
2050         $type = $match;
2051         $finished = 1;
2052     } elsif(s/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
2053         my $kind = $1;
2054         my $_name = $2;
2055         $self->_update_c_position($&, \$line, \$column);
2056
2057         if(defined($_name)) {
2058             $type = "struct $_name { }";
2059         } else {
2060             $type = "struct { }";
2061         }
2062     } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
2063         $type = $&;
2064         $type =~ s/\s//g;
2065     } else {
2066         return 0;
2067     }
2068
2069     # $output->write("*** $type: '$_'\n");
2070
2071     # $self->_parse_c_warning($_, $line, $column, "variable2", "");
2072
2073     if($finished) {
2074         # Nothing
2075     } elsif(s/^WINAPI\s*//) {
2076         $self->_update_c_position($&, \$line, \$column);
2077     }
2078
2079     if($finished) {
2080         # Nothing
2081     } elsif(s/^(\((?:$CALL_CONVENTION)?\s*\*?\s*(?:$CALL_CONVENTION)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
2082         $self->_update_c_position($&, \$line, \$column);
2083
2084         $name = $1;
2085         $name =~ s/\s//g;
2086
2087         $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
2088         if(s/^\)//) { $column++; }
2089         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
2090
2091         if(!s/^(?:=\s*|,\s*|$)//) {
2092             return 0;
2093         }
2094     } elsif(s/^(?:\*\s*)*(?:const\s+|volatile\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
2095         $self->_update_c_position($&, \$line, \$column);
2096
2097         $name = $1;
2098         $name =~ s/\s//g;
2099     } elsif(/^$/) {
2100         $name = "";
2101     } else {
2102         return 0;
2103     }
2104
2105     # $output->write("$type: $name: '$_'\n");
2106
2107     if(1 || $finished) {
2108         # Nothing
2109     } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(.*?\)', \$_, \$line, \$column, \$match)) {
2110         $type = "<type>";
2111         $name = "<name>";
2112     } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*
2113                 (?:\*\s*)*(\w+|\s*\*?\s*\w+\s*\))\s*(?:\[[^\]]*\]|\([^\)]*\))?
2114                 (?:,\s*(?:\*\s*)*(\w+)\s*(?:\[[^\]]*\])?)*
2115             \s*(?:=|$)//sx)
2116     {
2117         $self->_update_c_position($&, \$line, \$column);
2118
2119         $type = $1;
2120         $name = $2;
2121
2122         $type =~ s/\s//g;
2123         $type =~ s/^struct/struct /;
2124     } elsif(/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*((?:\*\s*)*)(\w+)\s*(?:=|$)/s) {
2125         $self->_update_c_position($&, \$line, \$column);
2126
2127         my $kind = $1;
2128         my $_name= $2;
2129         my $stars = $3;
2130         $name = $4;
2131
2132         if(defined($_name)) {
2133             $type = "struct $_name { }";
2134         } else {
2135             $type = "struct { }";
2136         }
2137
2138         $stars =~ s/\s//g;
2139         if($stars) {
2140             $type .= " $type";
2141         }
2142     } else {
2143         return 0;
2144     }
2145
2146     $$refcurrent = $_;
2147     $$refline = $line;
2148     $$refcolumn = $column;
2149
2150     $$reflinkage = $linkage;
2151     $$reftype = $type;
2152     $$refname = $name;
2153
2154     if(&$$found_variable($begin_line, $begin_column, $linkage, $type, $name))
2155     {
2156         # Nothing
2157     }
2158
2159     return 1;
2160 }
2161
2162 1;