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