git.oblomov.eu Git - wine/blob - tools/winapi/c_parser.pm

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