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