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