tools/winapi/c_parser.pm

   1 package c_parser;
   2
   3 use strict;
   4
   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
   6 require Exporter;
   7
   8 @ISA = qw(Exporter);
   9 @EXPORT = qw();
  10 @EXPORT_OK = qw();
  11
  12 use options qw($options);
  13 use output qw($output);
  14
  15 use c_function;
  16
  17 ########################################################################
  18 # new
  19 #
  20 sub new {
  21     my $proto = shift;
  22     my $class = ref($proto) || $proto;
  23     my $self  = {};
  24     bless ($self, $class);
  25
  26     my $file = \${$self->{FILE}};
  27     my $found_comment = \${$self->{FOUND_COMMENT}};
  28     my $found_declaration = \${$self->{FOUND_DECLARATION}};
  29     my $create_function = \${$self->{CREATE_FUNCTION}};
  30     my $found_function = \${$self->{FOUND_FUNCTION}};
  31     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
  32     my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
  33     my $found_statement = \${$self->{FOUND_STATEMENT}};
  34     my $found_variable = \${$self->{FOUND_VARIABLE}};
  35
  36     $$file = shift;
  37
  38     $$found_comment = sub { return 1; };
  39     $$found_declaration = sub { return 1; };
  40     $$create_function = sub { return new c_function; };
  41     $$found_function = sub { return 1; };
  42     $$found_function_call = sub { return 1; };
  43     $$found_preprocessor = sub { return 1; };
  44     $$found_statement = sub { return 1; };
  45     $$found_variable = sub { return 1; };
  46
  47     return $self;
  48 }
  49
  50 ########################################################################
  51 # set_found_comment_callback
  52 #
  53 sub set_found_comment_callback {
  54     my $self = shift;
  55
  56     my $found_comment = \${$self->{FOUND_COMMENT}};
  57
  58     $$found_comment = shift;
  59 }
  60
  61 ########################################################################
  62 # set_found_declaration_callback
  63 #
  64 sub set_found_declaration_callback {
  65     my $self = shift;
  66
  67     my $found_declaration = \${$self->{FOUND_DECLARATION}};
  68
  69     $$found_declaration = shift;
  70 }
  71
  72 ########################################################################
  73 # set_found_function_callback
  74 #
  75 sub set_found_function_callback {
  76     my $self = shift;
  77
  78     my $found_function = \${$self->{FOUND_FUNCTION}};
  79
  80     $$found_function = shift;
  81 }
  82
  83 ########################################################################
  84 # set_found_function_call_callback
  85 #
  86 sub set_found_function_call_callback {
  87     my $self = shift;
  88
  89     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
  90
  91     $$found_function_call = shift;
  92 }
  93
  94 ########################################################################
  95 # set_found_preprocessor_callback
  96 #
  97 sub set_found_preprocessor_callback {
  98     my $self = shift;
  99
 100     my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
 101
 102     $$found_preprocessor = shift;
 103 }
 104
 105 ########################################################################
 106 # set_found_statement_callback
 107 #
 108 sub set_found_statement_callback {
 109     my $self = shift;
 110
 111     my $found_statement = \${$self->{FOUND_STATEMENT}};
 112
 113     $$found_statement = shift;
 114 }
 115
 116 ########################################################################
 117 # set_found_variable_callback
 118 #
 119 sub set_found_variable_callback {
 120     my $self = shift;
 121
 122     my $found_variable = \${$self->{FOUND_VARIABLE}};
 123
 124     $$found_variable = shift;
 125 }
 126
 127 ########################################################################
 128 # _parse_c
 129
 130 sub _parse_c {
 131     my $self = shift;
 132
 133     my $pattern = shift;
 134     my $refcurrent = shift;
 135     my $refline = shift;
 136     my $refcolumn = shift;
 137
 138     my $refmatch = shift;
 139
 140     local $_ = $$refcurrent;
 141     my $line = $$refline;
 142     my $column = $$refcolumn;
 143
 144     my $match;
 145     if(s/^(?:$pattern)//s) {
 146         $self->_update_c_position($&, \$line, \$column);
 147         $match = $&;
 148     } else {
 149         return 0;
 150     }
 151
 152     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 153
 154     $$refcurrent = $_;
 155     $$refline = $line;
 156     $$refcolumn = $column;
 157
 158     $$refmatch = $match;
 159
 160     return 1;
 161 }
 162
 163 ########################################################################
 164 # _parse_c_error
 165
 166 sub _parse_c_error {
 167     my $self = shift;
 168
 169     my $file = \${$self->{FILE}};
 170
 171     local $_ = shift;
 172     my $line = shift;
 173     my $column = shift;
 174     my $context = shift;
 175
 176     my @lines = split(/\n/, $_);
 177
 178     my $current = "\n";
 179     $current .= $lines[0] . "\n" || "";
 180     $current .= $lines[1] . "\n" || "";
 181
 182     if($output->prefix) {
 183         $output->write("\n");
 184         $output->prefix("");
 185     }
 186     $output->write("$$file:$line." . ($column + 1) . ": $context: parse error: \\$current");
 187
 188     exit 1;
 189 }
 190
 191 ########################################################################
 192 # _parse_c_output
 193
 194 sub _parse_c_output {
 195     my $self = shift;
 196
 197     local $_ = shift;
 198     my $line = shift;
 199     my $column = shift;
 200     my $message = shift;
 201
 202     my @lines = split(/\n/, $_);
 203
 204     my $current = "\n";
 205     $current .= $lines[0] . "\n" || "";
 206     $current .= $lines[1] . "\n" || "";
 207
 208     $output->write("$line." . ($column + 1) . ": $message: \\$current");
 209 }
 210
 211 ########################################################################
 212 # _parse_c_until_one_of
 213
 214 sub _parse_c_until_one_of {
 215     my $self = shift;
 216
 217     my $characters = shift;
 218     my $refcurrent = shift;
 219     my $refline = shift;
 220     my $refcolumn = shift;
 221     my $match = shift;
 222
 223     local $_ = $$refcurrent;
 224     my $line = $$refline;
 225     my $column = $$refcolumn;
 226
 227     if(!defined($match)) {
 228         my $blackhole;
 229         $match = \$blackhole;
 230     }
 231
 232     $$match = "";
 233     while(/^[^$characters]/s) {
 234         my $submatch = "";
 235
 236         if(s/^[^$characters\n\t\'\"]*//s) {
 237             $submatch .= $&;
 238         }
 239
 240         if(s/^\'//) {
 241             $submatch .= "\'";
 242             while(/^./ && !s/^\'//) {
 243                 s/^([^\'\\]*)//s;
 244                 $submatch .= $1;
 245                 if(s/^\\//) {
 246                     $submatch .= "\\";
 247                     if(s/^(.)//s) {
 248                         $submatch .= $1;
 249                         if($1 eq "0") {
 250                             s/^(\d{0,3})//s;
 251                             $submatch .= $1;
 252                         }
 253                     }
 254                 }
 255             }
 256             $submatch .= "\'";
 257
 258             $$match .= $submatch;
 259             $column += length($submatch);
 260         } elsif(s/^\"//) {
 261             $submatch .= "\"";
 262             while(/^./ && !s/^\"//) {
 263                 s/^([^\"\\]*)//s;
 264                 $submatch .= $1;
 265                 if(s/^\\//) {
 266                     $submatch .= "\\";
 267                     if(s/^(.)//s) {
 268                         $submatch .= $1;
 269                         if($1 eq "0") {
 270                             s/^(\d{0,3})//s;
 271                             $submatch .= $1;
 272                         }
 273                     }
 274                 }
 275             }
 276             $submatch .= "\"";
 277
 278             $$match .= $submatch;
 279             $column += length($submatch);
 280         } elsif(s/^\n//) {
 281             $submatch .= "\n";
 282
 283             $$match .= $submatch;
 284             $line++;
 285             $column = 0;
 286         } elsif(s/^\t//) {
 287             $submatch .= "\t";
 288
 289             $$match .= $submatch;
 290             $column = $column + 8 - $column % 8;
 291         } else {
 292             $$match .= $submatch;
 293             $column += length($submatch);
 294         }
 295     }
 296
 297     $$refcurrent = $_;
 298     $$refline = $line;
 299     $$refcolumn = $column;
 300     return 1;
 301 }
 302
 303 ########################################################################
 304 # _update_c_position
 305
 306 sub _update_c_position {
 307     my $self = shift;
 308
 309     local $_ = shift;
 310     my $refline = shift;
 311     my $refcolumn = shift;
 312
 313     my $line = $$refline;
 314     my $column = $$refcolumn;
 315
 316     while($_) {
 317         if(s/^[^\n\t\'\"]*//s) {
 318             $column += length($&);
 319         }
 320
 321         if(s/^\'//) {
 322             $column++;
 323             while(/^./ && !s/^\'//) {
 324                 s/^([^\'\\]*)//s;
 325                 $column += length($1);
 326                 if(s/^\\//) {
 327                     $column++;
 328                     if(s/^(.)//s) {
 329                         $column += length($1);
 330                         if($1 eq "0") {
 331                             s/^(\d{0,3})//s;
 332                             $column += length($1);
 333                         }
 334                     }
 335                 }
 336             }
 337             $column++;
 338         } elsif(s/^\"//) {
 339             $column++;
 340             while(/^./ && !s/^\"//) {
 341                 s/^([^\"\\]*)//s;
 342                 $column += length($1);
 343                 if(s/^\\//) {
 344                     $column++;
 345                     if(s/^(.)//s) {
 346                         $column += length($1);
 347                         if($1 eq "0") {
 348                             s/^(\d{0,3})//s;
 349                             $column += length($1);
 350                         }
 351                     }
 352                 }
 353             }
 354             $column++;
 355         } elsif(s/^\n//) {
 356             $line++;
 357             $column = 0;
 358         } elsif(s/^\t//) {
 359             $column = $column + 8 - $column % 8;
 360         }
 361     }
 362
 363     $$refline = $line;
 364     $$refcolumn = $column;
 365 }
 366
 367 ########################################################################
 368 # parse_c_block
 369
 370 sub parse_c_block {
 371     my $self = shift;
 372
 373     my $refcurrent = shift;
 374     my $refline = shift;
 375     my $refcolumn = shift;
 376
 377     my $refstatements = shift;
 378     my $refstatements_line = shift;
 379     my $refstatements_column = shift;
 380
 381     local $_ = $$refcurrent;
 382     my $line = $$refline;
 383     my $column = $$refcolumn;
 384
 385     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 386
 387     my $statements;
 388     if(s/^\{//) {
 389         $column++;
 390         $statements = "";
 391     } else {
 392         return 0;
 393     }
 394
 395     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 396
 397     my $statements_line = $line;
 398     my $statements_column = $column;
 399
 400     my $plevel = 1;
 401     while($plevel > 0) {
 402         my $match;
 403         $self->_parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
 404
 405         $column++;
 406
 407         $statements .= $match;
 408         if(s/^\}//) {
 409             $plevel--;
 410             if($plevel > 0) {
 411                 $statements .= "}";
 412             }
 413         } elsif(s/^\{//) {
 414             $plevel++;
 415             $statements .= "{";
 416         } else {
 417             return 0;
 418         }
 419     }
 420
 421     $$refcurrent = $_;
 422     $$refline = $line;
 423     $$refcolumn = $column;
 424     $$refstatements = $statements;
 425     $$refstatements_line = $statements_line;
 426     $$refstatements_column = $statements_column;
 427
 428     return 1;
 429 }
 430
 431 ########################################################################
 432 # parse_c_declaration
 433
 434 sub parse_c_declaration {
 435     my $self = shift;
 436
 437     my $found_declaration = \${$self->{FOUND_DECLARATION}};
 438     my $found_function = \${$self->{FOUND_FUNCTION}};
 439
 440     my $refcurrent = shift;
 441     my $refline = shift;
 442     my $refcolumn = shift;
 443
 444     local $_ = $$refcurrent;
 445     my $line = $$refline;
 446     my $column = $$refcolumn;
 447
 448     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 449
 450     my $begin_line = $line;
 451     my $begin_column = $column + 1;
 452
 453     my $end_line = $begin_line;
 454     my $end_column = $begin_column;
 455     $self->_update_c_position($_, \$end_line, \$end_column);
 456
 457     if(!&$$found_declaration($begin_line, $begin_column, $end_line, $end_column, $_)) {
 458         return 1;
 459     }
 460
 461     # Function
 462     my $function = shift;
 463
 464     my $linkage = shift;
 465     my $calling_convention = shift;
 466     my $return_type = shift;
 467     my $name = shift;
 468     my @arguments = shift;
 469     my @argument_lines = shift;
 470     my @argument_columns = shift;
 471
 472     # Variable
 473     my $type;
 474
 475     # $self->_parse_c_output($_, $line, $column, "declaration");
 476
 477     if(0) {
 478         # Nothing
 479     } elsif(s/^(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
 480         $self->_update_c_position($&, \$line, \$column);
 481     } elsif(s/^extern\s*\"(.*?)\"\s*//s) {
 482         $self->_update_c_position($&, \$line, \$column);
 483         my $declarations;
 484         my $declarations_line;
 485         my $declarations_column;
 486         if(!$self->parse_c_block(\$_, \$line, \$column, \$declarations, \$declarations_line, \$declarations_column)) {
 487             return 0;
 488         }
 489         if(!$self->parse_c_declarations(\$declarations, \$declarations_line, \$declarations_column)) {
 490             return 0;
 491         }
 492     } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
 493         if(&$$found_function($function))
 494         {
 495             my $statements = $function->statements;
 496             my $statements_line = $function->statements_line;
 497             my $statements_column = $function->statements_column;
 498
 499             if(defined($statements)) {
 500                 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
 501                     return 0;
 502                 }
 503             }
 504         }
 505     } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
 506         # Nothing
 507     } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
 508         # Nothing
 509     } else {
 510         $self->_parse_c_error($_, $line, $column, "declaration");
 511     }
 512
 513     $$refcurrent = $_;
 514     $$refline = $line;
 515     $$refcolumn = $column;
 516
 517     return 1;
 518 }
 519
 520 ########################################################################
 521 # parse_c_declarations
 522
 523 sub parse_c_declarations {
 524     my $self = shift;
 525
 526     my $refcurrent = shift;
 527     my $refline = shift;
 528     my $refcolumn = shift;
 529
 530     return 1;
 531 }
 532
 533 ########################################################################
 534 # parse_c_expression
 535
 536 sub parse_c_expression {
 537     my $self = shift;
 538
 539     my $refcurrent = shift;
 540     my $refline = shift;
 541     my $refcolumn = shift;
 542
 543     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
 544
 545     local $_ = $$refcurrent;
 546     my $line = $$refline;
 547     my $column = $$refcolumn;
 548
 549     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 550
 551     if(s/^(.*?)(\w+\s*\()/$2/s) {
 552         $column += length($1);
 553
 554         my $begin_line = $line;
 555         my $begin_column = $column + 1;
 556
 557         my $name;
 558         my @arguments;
 559         my @argument_lines;
 560         my @argument_columns;
 561         if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
 562             return 0;
 563         }
 564
 565         if($name =~ /^sizeof$/ ||
 566            &$$found_function_call($begin_line, $begin_column, $line, $column, $name, \@arguments))
 567         {
 568             while(defined(my $argument = shift @arguments) &&
 569                   defined(my $argument_line = shift @argument_lines) &&
 570                   defined(my $argument_column = shift @argument_columns))
 571             {
 572                 $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
 573             }
 574         }
 575     } elsif(s/^return//) {
 576         $column += length($&);
 577         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 578         if(!$self->parse_c_expression(\$_, \$line, \$column)) {
 579             return 0;
 580         }
 581     } else {
 582         return 0;
 583     }
 584
 585     $self->_update_c_position($_, \$line, \$column);
 586
 587     $$refcurrent = $_;
 588     $$refline = $line;
 589     $$refcolumn = $column;
 590
 591     return 1;
 592 }
 593
 594 ########################################################################
 595 # parse_c_file
 596
 597 sub parse_c_file {
 598     my $self = shift;
 599
 600     my $found_comment = \${$self->{FOUND_COMMENT}};
 601
 602     my $refcurrent = shift;
 603     my $refline = shift;
 604     my $refcolumn = shift;
 605
 606     local $_ = $$refcurrent;
 607     my $line = $$refline;
 608     my $column = $$refcolumn;
 609
 610     my $declaration = "";
 611     my $declaration_line = $line;
 612     my $declaration_column = $column;
 613
 614     my $previous_line = 0;
 615     my $previous_column = -1;
 616
 617     my $blevel = 1;
 618     my $plevel = 1;
 619     while($plevel > 0 || $blevel > 0) {
 620         my $match;
 621         $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
 622
 623         if($line == $previous_line && $column == $previous_column) {
 624             # $self->_parse_c_error($_, $line, $column, "file: no progress");
 625         }
 626         $previous_line = $line;
 627         $previous_column = $column;
 628
 629         # $self->_parse_c_output($_, $line, $column, "'$match'");
 630
 631         if(!$declaration && $match =~ s/^\s+//s) {
 632             $self->_update_c_position($&, \$declaration_line, \$declaration_column);
 633         }
 634         $declaration .= $match;
 635
 636         if(/^[\#\/]/) {
 637             my $blank_lines = 0;
 638             if(s/^\#\s*//) {
 639                 my $preprocessor_line = $line;
 640                 my $preprocessor_column = $column;
 641
 642                 my $preprocessor = $&;
 643                 while(s/^(.*?)\\\s*\n//) {
 644                     $blank_lines++;
 645                     $preprocessor .= "$1\n";
 646                 }
 647                 if(s/^(.*?)(\/[\*\/].*)?\n//) {
 648                     if(defined($2)) {
 649                         $_ = "$2\n$_";
 650                     } else {
 651                         $blank_lines++;
 652                     }
 653                     $preprocessor .= $1;
 654                 }
 655
 656                 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
 657                     return 0;
 658                 }
 659             }
 660
 661             if(s/^\/\*(.*?)\*\///s) {
 662                 &$$found_comment($line, $column + 1, "/*$1*/");
 663                 my @lines = split(/\n/, $1);
 664                 if($#lines > 0) {
 665                     $blank_lines += $#lines;
 666                 } else {
 667                     $column += length($1);
 668                 }
 669             } elsif(s/^\/\/(.*?)\n//) {
 670                 &$$found_comment($line, $column + 1, "//$1");
 671                 $blank_lines++;
 672             } elsif(s/^\///) {
 673                 $declaration .= $&;
 674             }
 675
 676             $line += $blank_lines;
 677             if($blank_lines > 0) {
 678                 $column = 0;
 679             }
 680
 681             if(!$declaration) {
 682                 $declaration_line = $line;
 683                 $declaration_column = $column;
 684             } else {
 685                 $declaration .= "\n" x $blank_lines;
 686             }
 687
 688             next;
 689         }
 690
 691         $column++;
 692         if(s/^[\(\[]//) {
 693             $plevel++;
 694             $declaration .= $&;
 695         } elsif(s/^[\)\]]//) {
 696             $plevel--;
 697             $declaration .= $&;
 698         } elsif(s/^\{//) {
 699             $blevel++;
 700             $declaration .= $&;
 701         } elsif(s/^\}//) {
 702             $blevel--;
 703             $declaration .= $&;
 704             if($plevel == 1 && $blevel == 1 && $declaration !~ /^typedef/) {
 705                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 706                     return 0;
 707                 }
 708                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 709                 $declaration = "";
 710                 $declaration_line = $line;
 711                 $declaration_column = $column;
 712             }
 713         } elsif(s/^;//) {
 714             if($plevel == 1 && $blevel == 1) {
 715                 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
 716                     return 0;
 717                 }
 718                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 719                 $declaration = "";
 720                 $declaration_line = $line;
 721                 $declaration_column = $column;
 722             } else {
 723                 $declaration .= $&;
 724             }
 725         } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
 726             $plevel = 0;
 727             $blevel = 0;
 728         } else {
 729             $self->_parse_c_error($_, $line, $column, "file");
 730         }
 731     }
 732
 733     $$refcurrent = $_;
 734     $$refline = $line;
 735     $$refcolumn = $column;
 736
 737     return 1;
 738 }
 739
 740 ########################################################################
 741 # parse_c_function
 742
 743 sub parse_c_function {
 744     my $self = shift;
 745
 746     my $file = \${$self->{FILE}};
 747     my $create_function = \${$self->{CREATE_FUNCTION}};
 748
 749     my $refcurrent = shift;
 750     my $refline = shift;
 751     my $refcolumn = shift;
 752
 753     my $reffunction = shift;
 754
 755     local $_ = $$refcurrent;
 756     my $line = $$refline;
 757     my $column = $$refcolumn;
 758
 759     my $linkage = "";
 760     my $calling_convention = "";
 761     my $return_type;
 762     my $name;
 763     my @arguments;
 764     my @argument_lines;
 765     my @argument_columns;
 766     my $statements;
 767     my $statements_line;
 768     my $statements_column;
 769
 770     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 771
 772     my $begin_line = $line;
 773     my $begin_column = $column + 1;
 774
 775     $self->_parse_c("inline", \$_, \$line, \$column);
 776     $self->_parse_c("extern|static", \$_, \$line, \$column, \$linkage);
 777     $self->_parse_c("inline", \$_, \$line, \$column);
 778     if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
 779         return 0;
 780     }
 781
 782     $self->_parse_c("__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK",
 783              \$_, \$line, \$column, \$calling_convention);
 784     if(!$self->_parse_c("\\w+", \$_, \$line, \$column, \$name)) {
 785         return 0;
 786     }
 787     if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 788         return 0;
 789     }
 790     if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
 791         return 0;
 792     }
 793
 794     my $end_line = $line;
 795     my $end_column = $column;
 796
 797     $$refcurrent = $_;
 798     $$refline = $line;
 799     $$refcolumn = $column;
 800
 801     my $function = &$$create_function;
 802
 803     $function->file($$file);
 804     $function->begin_line($begin_line);
 805     $function->begin_column($begin_column);
 806     $function->end_line($end_line);
 807     $function->end_column($end_column);
 808     $function->linkage($linkage);
 809     $function->return_type($return_type);
 810     $function->calling_convention($calling_convention);
 811     $function->name($name);
 812     # if(defined($argument_types)) {
 813     #     $function->argument_types([@$argument_types]);
 814     # }
 815     # if(defined($argument_names)) {
 816     #     $function->argument_names([@$argument_names]);
 817     # }
 818     $function->statements_line($statements_line);
 819     $function->statements_column($statements_column);
 820     $function->statements($statements);
 821
 822     $$reffunction = $function;
 823
 824     return 1;
 825 }
 826
 827 ########################################################################
 828 # parse_c_function_call
 829
 830 sub parse_c_function_call {
 831     my $self = shift;
 832
 833     my $refcurrent = shift;
 834     my $refline = shift;
 835     my $refcolumn = shift;
 836
 837     my $refname = shift;
 838     my $refarguments = shift;
 839     my $refargument_lines = shift;
 840     my $refargument_columns = shift;
 841
 842     local $_ = $$refcurrent;
 843     my $line = $$refline;
 844     my $column = $$refcolumn;
 845
 846     my $name;
 847     my @arguments;
 848     my @argument_lines;
 849     my @argument_columns;
 850
 851     if(s/^(\w+)(\s*)\(/\(/s) {
 852         $column += length("$1$2");
 853
 854         $name = $1;
 855
 856         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 857             return 0;
 858         }
 859     } else {
 860         return 0;
 861     }
 862
 863     $$refcurrent = $_;
 864     $$refline = $line;
 865     $$refcolumn = $column;
 866
 867     $$refname = $name;
 868     @$refarguments = @arguments;
 869     @$refargument_lines = @argument_lines;
 870     @$refargument_columns = @argument_columns;
 871
 872     return 1;
 873 }
 874
 875 ########################################################################
 876 # parse_c_preprocessor
 877
 878 sub parse_c_preprocessor {
 879     my $self = shift;
 880
 881     my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
 882
 883     my $refcurrent = shift;
 884     my $refline = shift;
 885     my $refcolumn = shift;
 886
 887     local $_ = $$refcurrent;
 888     my $line = $$refline;
 889     my $column = $$refcolumn;
 890
 891     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 892
 893     my $begin_line = $line;
 894     my $begin_column = $column + 1;
 895
 896     if(!&$$found_preprocessor($begin_line, $begin_column, "$_")) {
 897         return 1;
 898     }
 899
 900     if(0) {
 901         # Nothing
 902     } elsif(/^\#\s*define\s+(.*?)$/s) {
 903         $self->_update_c_position($_, \$line, \$column);
 904     } elsif(/^\#\s*else/s) {
 905         $self->_update_c_position($_, \$line, \$column);
 906     } elsif(/^\#\s*endif/s) {
 907         $self->_update_c_position($_, \$line, \$column);
 908     } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s+(.*?)$/s) {
 909         $self->_update_c_position($_, \$line, \$column);
 910     } elsif(/^\#\s*include\s+(.*?)$/s) {
 911         $self->_update_c_position($_, \$line, \$column);
 912     } elsif(/^\#\s*undef\s+(.*?)$/s) {
 913         $self->_update_c_position($_, \$line, \$column);
 914     } else {
 915         $self->_parse_c_error($_, $line, $column, "preprocessor");
 916     }
 917
 918     $$refcurrent = $_;
 919     $$refline = $line;
 920     $$refcolumn = $column;
 921
 922     return 1;
 923 }
 924
 925 ########################################################################
 926 # parse_c_statement
 927
 928 sub parse_c_statement {
 929     my $self = shift;
 930
 931     my $refcurrent = shift;
 932     my $refline = shift;
 933     my $refcolumn = shift;
 934
 935     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
 936
 937     local $_ = $$refcurrent;
 938     my $line = $$refline;
 939     my $column = $$refcolumn;
 940
 941     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 942
 943     if(s/^(?:case\s+)?(\w+)\s*://) {
 944         $column += length($&);
 945         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 946     }
 947
 948     # $output->write("$line.$column: '$_'\n");
 949
 950     if(/^$/) {
 951         # Nothing
 952     } elsif(/^\{/) {
 953         my $statements;
 954         my $statements_line;
 955         my $statements_column;
 956         if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
 957             return 0;
 958         }
 959         if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
 960             return 0;
 961         }
 962     } elsif(/^(for|if|switch|while)(\s*)\(/) {
 963         $column += length("$1$2");
 964         my $name = $1;
 965
 966         $_ = "($'";
 967
 968         my @arguments;
 969         my @argument_lines;
 970         my @argument_columns;
 971         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
 972             return 0;
 973         }
 974
 975         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 976         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
 977             return 0;
 978         }
 979         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
 980
 981         while(defined(my $argument = shift @arguments) &&
 982               defined(my $argument_line = shift @argument_lines) &&
 983               defined(my $argument_column = shift @argument_columns))
 984         {
 985             $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
 986         }
 987     } elsif(s/^else//) {
 988         $column += length($&);
 989         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
 990             return 0;
 991         }
 992     } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
 993         # Nothing
 994     } else {
 995         # $self->_parse_c_error($_, $line, $column, "statement");
 996     }
 997
 998     $self->_update_c_position($_, \$line, \$column);
 999
1000     $$refcurrent = $_;
1001     $$refline = $line;
1002     $$refcolumn = $column;
1003
1004     return 1;
1005 }
1006
1007 ########################################################################
1008 # parse_c_statements
1009
1010 sub parse_c_statements {
1011     my $self = shift;
1012
1013     my $refcurrent = shift;
1014     my $refline = shift;
1015     my $refcolumn = shift;
1016
1017     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1018
1019     local $_ = $$refcurrent;
1020     my $line = $$refline;
1021     my $column = $$refcolumn;
1022
1023     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1024
1025     my $statement = "";
1026     my $statement_line = $line;
1027     my $statement_column = $column;
1028
1029     my $blevel = 1;
1030     my $plevel = 1;
1031     while($plevel > 0 || $blevel > 0) {
1032         my $match;
1033         $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1034
1035         # $output->write("'$match' '$_'\n");
1036
1037         $column++;
1038         $statement .= $match;
1039         if(s/^[\(\[]//) {
1040             $plevel++;
1041             $statement .= $&;
1042         } elsif(s/^[\)\]]//) {
1043             $plevel--;
1044             if($plevel <= 0) {
1045                 $self->_parse_c_error($_, $line, $column, "statements");
1046             }
1047             $statement .= $&;
1048         } elsif(s/^\{//) {
1049             $blevel++;
1050             $statement .= $&;
1051         } elsif(s/^\}//) {
1052             $blevel--;
1053             $statement .= $&;
1054             if($blevel == 1) {
1055                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1056                     return 0;
1057                 }
1058                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1059                 $statement = "";
1060                 $statement_line = $line;
1061                 $statement_column = $column;
1062             }
1063         } elsif(s/^;//) {
1064             if($plevel == 1 && $blevel == 1) {
1065                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1066                     return 0;
1067                 }
1068
1069                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1070                 $statement = "";
1071                 $statement_line = $line;
1072                 $statement_column = $column;
1073             } else {
1074                 $statement .= $&;
1075             }
1076         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1077             $plevel = 0;
1078             $blevel = 0;
1079         } else {
1080             $self->_parse_c_error($_, $line, $column, "statements");
1081         }
1082     }
1083
1084     $self->_update_c_position($_, \$line, \$column);
1085
1086     $$refcurrent = $_;
1087     $$refline = $line;
1088     $$refcolumn = $column;
1089
1090     return 1;
1091 }
1092
1093 ########################################################################
1094 # parse_c_tuple
1095
1096 sub parse_c_tuple {
1097     my $self = shift;
1098
1099     my $refcurrent = shift;
1100     my $refline = shift;
1101     my $refcolumn = shift;
1102
1103     # FIXME: Should not write directly
1104     my $items = shift;
1105     my $item_lines = shift;
1106     my $item_columns = shift;
1107
1108     local $_ = $$refcurrent;
1109
1110     my $line = $$refline;
1111     my $column = $$refcolumn;
1112
1113     my $item;
1114     if(s/^\(//) {
1115         $column++;
1116         $item = "";
1117     } else {
1118         return 0;
1119     }
1120
1121     my $item_line = $line;
1122     my $item_column = $column + 1;
1123
1124     my $plevel = 1;
1125     while($plevel > 0) {
1126         my $match;
1127         $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1128
1129         $column++;
1130
1131         $item .= $match;
1132         if(s/^\)//) {
1133             $plevel--;
1134             if($plevel == 0) {
1135                 push @$item_lines, $item_line;
1136                 push @$item_columns, $item_column;
1137                 push @$items, $item;
1138                 $item = "";
1139             } else {
1140                 $item .= ")";
1141             }
1142         } elsif(s/^\(//) {
1143             $plevel++;
1144             $item .= "(";
1145         } elsif(s/^,//) {
1146             if($plevel == 1) {
1147                 push @$item_lines, $item_line;
1148                 push @$item_columns, $item_column;
1149                 push @$items, $item;
1150                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1151                 $item_line = $line;
1152                 $item_column = $column + 1;
1153                 $item = "";
1154             } else {
1155                 $item .= ",";
1156             }
1157         } else {
1158             return 0;
1159         }
1160     }
1161
1162     $$refcurrent = $_;
1163     $$refline = $line;
1164     $$refcolumn = $column;
1165
1166     return 1;
1167 }
1168
1169 ########################################################################
1170 # parse_c_type
1171
1172 sub parse_c_type {
1173     my $self = shift;
1174
1175     my $refcurrent = shift;
1176     my $refline = shift;
1177     my $refcolumn = shift;
1178
1179     my $reftype = shift;
1180
1181     local $_ = $$refcurrent;
1182     my $line = $$refline;
1183     my $column = $$refcolumn;
1184
1185     my $type;
1186
1187     $self->_parse_c("const", \$_, \$line, \$column);
1188
1189
1190     if(0) {
1191         # Nothing
1192     } elsif($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1193                 # Nothing
1194     } elsif($self->_parse_c('\w+\s*(\*\s*)*', \$_, \$line, \$column, \$type)) {
1195         # Nothing
1196     } else {
1197         return 0;
1198     }
1199     $type =~ s/\s//g;
1200
1201     $$refcurrent = $_;
1202     $$refline = $line;
1203     $$refcolumn = $column;
1204
1205     $$reftype = $type;
1206
1207     return 1;
1208 }
1209
1210 ########################################################################
1211 # parse_c_typedef
1212
1213 sub parse_c_typedef {
1214     my $self = shift;
1215
1216     my $refcurrent = shift;
1217     my $refline = shift;
1218     my $refcolumn = shift;
1219
1220     my $reftype = shift;
1221
1222     local $_ = $$refcurrent;
1223     my $line = $$refline;
1224     my $column = $$refcolumn;
1225
1226     my $type;
1227
1228     if(!$self->_parse_c("typedef", \$_, \$line, \$column)) {
1229         return 0;
1230     }
1231
1232     $$refcurrent = $_;
1233     $$refline = $line;
1234     $$refcolumn = $column;
1235
1236     $$reftype = $type;
1237
1238     return 1;
1239 }
1240
1241 ########################################################################
1242 # parse_c_variable
1243
1244 sub parse_c_variable {
1245     my $self = shift;
1246
1247     my $found_variable = \${$self->{FOUND_VARIABLE}};
1248
1249     my $refcurrent = shift;
1250     my $refline = shift;
1251     my $refcolumn = shift;
1252
1253     my $reflinkage = shift;
1254     my $reftype = shift;
1255     my $refname = shift;
1256
1257     local $_ = $$refcurrent;
1258     my $line = $$refline;
1259     my $column = $$refcolumn;
1260
1261     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1262
1263     my $begin_line = $line;
1264     my $begin_column = $column + 1;
1265
1266     my $linkage = "";
1267     my $type;
1268     my $name;
1269
1270     $self->_parse_c("extern|static", \$_, \$line, \$column, \$linkage);
1271     if(!$self->parse_c_type(\$_, \$line, \$column, \$type)) { return 0; }
1272     if(!$self->_parse_c("\\w+", \$_, \$line, \$column, \$name)) { return 0; }
1273
1274     $$refcurrent = $_;
1275     $$refline = $line;
1276     $$refcolumn = $column;
1277
1278     $$reflinkage = $linkage;
1279     $$reftype = $type;
1280     $$refname = $name;
1281
1282     if(&$$found_variable($begin_line, $begin_column, $linkage, $type, $name))
1283     {
1284         # Nothing
1285     }
1286
1287     return 1;
1288 }
1289
1290 1;