Added ability to turn on/off debug channels.
[wine.git] / tools / winapi / c_parser.pm
blob7165f90ad827e0874e77a53595a44c6a2c2c07a8
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
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.
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.
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 package c_parser;
21 use strict;
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw();
30 use options qw($options);
31 use output qw($output);
33 use c_function;
35 ########################################################################
36 # new
38 sub new {
39 my $proto = shift;
40 my $class = ref($proto) || $proto;
41 my $self = {};
42 bless ($self, $class);
44 my $file = \${$self->{FILE}};
45 my $found_comment = \${$self->{FOUND_COMMENT}};
46 my $found_declaration = \${$self->{FOUND_DECLARATION}};
47 my $create_function = \${$self->{CREATE_FUNCTION}};
48 my $found_function = \${$self->{FOUND_FUNCTION}};
49 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
50 my $found_line = \${$self->{FOUND_LINE}};
51 my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
52 my $found_statement = \${$self->{FOUND_STATEMENT}};
53 my $found_variable = \${$self->{FOUND_VARIABLE}};
55 $$file = shift;
57 $$found_comment = sub { return 1; };
58 $$found_declaration = sub { return 1; };
59 $$create_function = sub { return new c_function; };
60 $$found_function = sub { return 1; };
61 $$found_function_call = sub { return 1; };
62 $$found_line = sub { return 1; };
63 $$found_preprocessor = sub { return 1; };
64 $$found_statement = sub { return 1; };
65 $$found_variable = sub { return 1; };
67 return $self;
70 ########################################################################
71 # set_found_comment_callback
73 sub set_found_comment_callback {
74 my $self = shift;
76 my $found_comment = \${$self->{FOUND_COMMENT}};
78 $$found_comment = shift;
81 ########################################################################
82 # set_found_declaration_callback
84 sub set_found_declaration_callback {
85 my $self = shift;
87 my $found_declaration = \${$self->{FOUND_DECLARATION}};
89 $$found_declaration = shift;
92 ########################################################################
93 # set_found_function_callback
95 sub set_found_function_callback {
96 my $self = shift;
98 my $found_function = \${$self->{FOUND_FUNCTION}};
100 $$found_function = shift;
103 ########################################################################
104 # set_found_function_call_callback
106 sub set_found_function_call_callback {
107 my $self = shift;
109 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
111 $$found_function_call = shift;
114 ########################################################################
115 # set_found_line_callback
117 sub set_found_line_callback {
118 my $self = shift;
120 my $found_line = \${$self->{FOUND_LINE}};
122 $$found_line = shift;
125 ########################################################################
126 # set_found_preprocessor_callback
128 sub set_found_preprocessor_callback {
129 my $self = shift;
131 my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
133 $$found_preprocessor = shift;
136 ########################################################################
137 # set_found_statement_callback
139 sub set_found_statement_callback {
140 my $self = shift;
142 my $found_statement = \${$self->{FOUND_STATEMENT}};
144 $$found_statement = shift;
147 ########################################################################
148 # set_found_variable_callback
150 sub set_found_variable_callback {
151 my $self = shift;
153 my $found_variable = \${$self->{FOUND_VARIABLE}};
155 $$found_variable = shift;
158 ########################################################################
159 # _parse_c
161 sub _parse_c {
162 my $self = shift;
164 my $pattern = shift;
165 my $refcurrent = shift;
166 my $refline = shift;
167 my $refcolumn = shift;
169 my $refmatch = shift;
171 local $_ = $$refcurrent;
172 my $line = $$refline;
173 my $column = $$refcolumn;
175 my $match;
176 if(s/^(?:$pattern)//s) {
177 $self->_update_c_position($&, \$line, \$column);
178 $match = $&;
179 } else {
180 return 0;
183 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
185 $$refcurrent = $_;
186 $$refline = $line;
187 $$refcolumn = $column;
189 $$refmatch = $match;
191 return 1;
194 ########################################################################
195 # _parse_c_error
197 # FIXME: Use caller (See man perlfunc)
199 sub _parse_c_error {
200 my $self = shift;
202 my $file = \${$self->{FILE}};
204 local $_ = shift;
205 my $line = shift;
206 my $column = shift;
207 my $context = shift;
208 my $message = shift;
210 $message = "parse error" if !$message;
212 my $current = "";
213 if($_) {
214 my @lines = split(/\n/, $_);
216 $current .= $lines[0] . "\n" if $lines[0];
217 $current .= $lines[1] . "\n" if $lines[1];
220 if($output->prefix) {
221 $output->write("\n");
222 $output->prefix("");
225 if($current) {
226 $output->write("$$file:$line." . ($column + 1) . ": $context: $message: \\\n$current");
227 } else {
228 $output->write("$$file:$line." . ($column + 1) . ": $context: $message\n");
231 exit 1;
234 ########################################################################
235 # _parse_c_warning
237 sub _parse_c_warning {
238 my $self = shift;
240 my $line = shift;
241 my $column = shift;
242 my $message = shift;
244 $output->write("$line." . ($column + 1) . ": $message\n");
247 ########################################################################
248 # _parse_c_until_one_of
250 sub _parse_c_until_one_of {
251 my $self = shift;
253 my $characters = shift;
254 my $refcurrent = shift;
255 my $refline = shift;
256 my $refcolumn = shift;
257 my $match = shift;
259 local $_ = $$refcurrent;
260 my $line = $$refline;
261 my $column = $$refcolumn;
263 if(!defined($match)) {
264 my $blackhole;
265 $match = \$blackhole;
268 $$match = "";
269 while(/^[^$characters]/s) {
270 my $submatch = "";
272 if(s/^[^$characters\n\t\'\"]*//s) {
273 $submatch .= $&;
276 if(s/^\'//) {
277 $submatch .= "\'";
278 while(/^./ && !s/^\'//) {
279 s/^([^\'\\]*)//s;
280 $submatch .= $1;
281 if(s/^\\//) {
282 $submatch .= "\\";
283 if(s/^(.)//s) {
284 $submatch .= $1;
285 if($1 eq "0") {
286 s/^(\d{0,3})//s;
287 $submatch .= $1;
292 $submatch .= "\'";
294 $$match .= $submatch;
295 $column += length($submatch);
296 } elsif(s/^\"//) {
297 $submatch .= "\"";
298 while(/^./ && !s/^\"//) {
299 s/^([^\"\\]*)//s;
300 $submatch .= $1;
301 if(s/^\\//) {
302 $submatch .= "\\";
303 if(s/^(.)//s) {
304 $submatch .= $1;
305 if($1 eq "0") {
306 s/^(\d{0,3})//s;
307 $submatch .= $1;
312 $submatch .= "\"";
314 $$match .= $submatch;
315 $column += length($submatch);
316 } elsif(s/^\n//) {
317 $submatch .= "\n";
319 $$match .= $submatch;
320 $line++;
321 $column = 0;
322 } elsif(s/^\t//) {
323 $submatch .= "\t";
325 $$match .= $submatch;
326 $column = $column + 8 - $column % 8;
327 } else {
328 $$match .= $submatch;
329 $column += length($submatch);
333 $$refcurrent = $_;
334 $$refline = $line;
335 $$refcolumn = $column;
336 return 1;
339 ########################################################################
340 # _update_c_position
342 sub _update_c_position {
343 my $self = shift;
345 local $_ = shift;
346 my $refline = shift;
347 my $refcolumn = shift;
349 my $line = $$refline;
350 my $column = $$refcolumn;
352 while($_) {
353 if(s/^[^\n\t\'\"]*//s) {
354 $column += length($&);
357 if(s/^\'//) {
358 $column++;
359 while(/^./ && !s/^\'//) {
360 s/^([^\'\\]*)//s;
361 $column += length($1);
362 if(s/^\\//) {
363 $column++;
364 if(s/^(.)//s) {
365 $column += length($1);
366 if($1 eq "0") {
367 s/^(\d{0,3})//s;
368 $column += length($1);
373 $column++;
374 } elsif(s/^\"//) {
375 $column++;
376 while(/^./ && !s/^\"//) {
377 s/^([^\"\\]*)//s;
378 $column += length($1);
379 if(s/^\\//) {
380 $column++;
381 if(s/^(.)//s) {
382 $column += length($1);
383 if($1 eq "0") {
384 s/^(\d{0,3})//s;
385 $column += length($1);
390 $column++;
391 } elsif(s/^\n//) {
392 $line++;
393 $column = 0;
394 } elsif(s/^\t//) {
395 $column = $column + 8 - $column % 8;
399 $$refline = $line;
400 $$refcolumn = $column;
403 ########################################################################
404 # parse_c_block
406 sub parse_c_block {
407 my $self = shift;
409 my $refcurrent = shift;
410 my $refline = shift;
411 my $refcolumn = shift;
413 my $refstatements = shift;
414 my $refstatements_line = shift;
415 my $refstatements_column = shift;
417 local $_ = $$refcurrent;
418 my $line = $$refline;
419 my $column = $$refcolumn;
421 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
423 my $statements;
424 if(s/^\{//) {
425 $column++;
426 $statements = "";
427 } else {
428 return 0;
431 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
433 my $statements_line = $line;
434 my $statements_column = $column;
436 my $plevel = 1;
437 while($plevel > 0) {
438 my $match;
439 $self->_parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
441 $column++;
443 $statements .= $match;
444 if(s/^\}//) {
445 $plevel--;
446 if($plevel > 0) {
447 $statements .= "}";
449 } elsif(s/^\{//) {
450 $plevel++;
451 $statements .= "{";
452 } else {
453 return 0;
457 $$refcurrent = $_;
458 $$refline = $line;
459 $$refcolumn = $column;
460 $$refstatements = $statements;
461 $$refstatements_line = $statements_line;
462 $$refstatements_column = $statements_column;
464 return 1;
467 ########################################################################
468 # parse_c_declaration
470 sub parse_c_declaration {
471 my $self = shift;
473 my $found_declaration = \${$self->{FOUND_DECLARATION}};
474 my $found_function = \${$self->{FOUND_FUNCTION}};
476 my $refcurrent = shift;
477 my $refline = shift;
478 my $refcolumn = shift;
480 local $_ = $$refcurrent;
481 my $line = $$refline;
482 my $column = $$refcolumn;
484 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
486 my $begin_line = $line;
487 my $begin_column = $column + 1;
489 my $end_line = $begin_line;
490 my $end_column = $begin_column;
491 $self->_update_c_position($_, \$end_line, \$end_column);
493 if(!&$$found_declaration($begin_line, $begin_column, $end_line, $end_column, $_)) {
494 return 1;
497 # Function
498 my $function = shift;
500 my $linkage = shift;
501 my $calling_convention = shift;
502 my $return_type = shift;
503 my $name = shift;
504 my @arguments = shift;
505 my @argument_lines = shift;
506 my @argument_columns = shift;
508 # Variable
509 my $type;
511 if(0) {
512 # Nothing
513 } elsif(s/^(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
514 $self->_update_c_position($&, \$line, \$column);
515 } elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
516 $self->_update_c_position($&, \$line, \$column);
517 $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
518 if(s/\)//) {
519 $column++;
521 } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
522 } elsif(s/^extern\s*\"C\"\s*{//s) {
523 $self->_update_c_position($&, \$line, \$column);
524 } elsif(s/^(?:__asm__|asm)\s*\(//) {
525 $self->_update_c_position($&, \$line, \$column);
526 } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
527 # Nothing
528 } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
529 # Nothing
530 } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
531 if(&$$found_function($function))
533 my $statements = $function->statements;
534 my $statements_line = $function->statements_line;
535 my $statements_column = $function->statements_column;
537 if(defined($statements)) {
538 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
539 return 0;
543 } else {
544 $self->_parse_c_error($_, $line, $column, "declaration");
547 $$refcurrent = $_;
548 $$refline = $line;
549 $$refcolumn = $column;
551 return 1;
554 ########################################################################
555 # parse_c_declarations
557 sub parse_c_declarations {
558 my $self = shift;
560 my $refcurrent = shift;
561 my $refline = shift;
562 my $refcolumn = shift;
564 return 1;
567 ########################################################################
568 # parse_c_expression
570 sub parse_c_expression {
571 my $self = shift;
573 my $refcurrent = shift;
574 my $refline = shift;
575 my $refcolumn = shift;
577 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
579 local $_ = $$refcurrent;
580 my $line = $$refline;
581 my $column = $$refcolumn;
583 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
585 while($_) {
586 if(s/^(.*?)(\w+\s*\()/$2/s) {
587 $self->_update_c_position($1, \$line, \$column);
589 my $begin_line = $line;
590 my $begin_column = $column + 1;
592 my $name;
593 my @arguments;
594 my @argument_lines;
595 my @argument_columns;
596 if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
597 return 0;
600 if(&$$found_function_call($begin_line, $begin_column, $line, $column, $name, \@arguments))
602 while(defined(my $argument = shift @arguments) &&
603 defined(my $argument_line = shift @argument_lines) &&
604 defined(my $argument_column = shift @argument_columns))
606 $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
609 } else {
610 $_ = "";
614 $self->_update_c_position($_, \$line, \$column);
616 $$refcurrent = $_;
617 $$refline = $line;
618 $$refcolumn = $column;
620 return 1;
623 ########################################################################
624 # parse_c_file
626 sub parse_c_file {
627 my $self = shift;
629 my $found_comment = \${$self->{FOUND_COMMENT}};
630 my $found_line = \${$self->{FOUND_LINE}};
632 my $refcurrent = shift;
633 my $refline = shift;
634 my $refcolumn = shift;
636 local $_ = $$refcurrent;
637 my $line = $$refline;
638 my $column = $$refcolumn;
640 my $declaration = "";
641 my $declaration_line = $line;
642 my $declaration_column = $column;
644 my $previous_line = 0;
645 my $previous_column = -1;
647 my $if = 0;
648 my $if0 = 0;
650 my $blevel = 1;
651 my $plevel = 1;
652 while($plevel > 0 || $blevel > 0) {
653 my $match;
654 $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
656 if($line != $previous_line) {
657 &$$found_line($line);
658 } elsif($column == $previous_column) {
659 $self->_parse_c_error($_, $line, $column, "file", "no progress");
660 } else {
661 # &$$found_line("$line.$column");
663 $previous_line = $line;
664 $previous_column = $column;
666 # $output->write("file: $plevel $blevel: '$match'\n");
668 if(!$declaration && $match =~ s/^\s+//s) {
669 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
671 if(!$if0) {
672 $declaration .= $match;
673 } else {
674 my $blank_lines = 0;
676 local $_ = $match;
677 while(s/^.*?\n//) { $blank_lines++; }
679 if(!$declaration) {
680 $declaration_line = $line;
681 $declaration_column = $column;
682 } else {
683 $declaration .= "\n" x $blank_lines;
688 if(/^[\#\/]/) {
689 my $blank_lines = 0;
690 if(s/^\#\s*//) {
691 my $preprocessor_line = $line;
692 my $preprocessor_column = $column;
694 my $preprocessor = $&;
695 while(s/^(.*?)\\\s*\n//) {
696 $blank_lines++;
697 $preprocessor .= "$1\n";
699 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
700 $_ = "$2\n$_";
701 if(defined($3)) {
702 $preprocessor .= "$1$3";
703 } else {
704 $preprocessor .= $1;
706 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
707 if(defined($2)) {
708 $_ = "$2\n$_";
709 } else {
710 $blank_lines++;
712 $preprocessor .= $1;
715 if($if0 && $preprocessor =~ /^\#\s*endif/) {
716 if($if0 > 0) {
717 if($if > 0) {
718 $if--;
719 } else {
720 $if0--;
723 } elsif($preprocessor =~ /^\#\s*if/) {
724 if($preprocessor =~ /^\#\s*if\s*0/) {
725 $if0++;
726 } elsif($if0 > 0) {
727 $if++;
731 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
732 return 0;
736 if(s/^\/\*.*?\*\///s) {
737 &$$found_comment($line, $column + 1, $&);
738 local $_ = $&;
739 while(s/^.*?\n//) {
740 $blank_lines++;
742 if($_) {
743 $column += length($_);
745 } elsif(s/^\/\/(.*?)\n//) {
746 &$$found_comment($line, $column + 1, $&);
747 $blank_lines++;
748 } elsif(s/^\///) {
749 if(!$if0) {
750 $declaration .= $&;
751 $column++;
755 $line += $blank_lines;
756 if($blank_lines > 0) {
757 $column = 0;
760 if(!$declaration) {
761 $declaration_line = $line;
762 $declaration_column = $column;
763 } elsif($blank_lines > 0) {
764 $declaration .= "\n" x $blank_lines;
767 next;
770 $column++;
772 if($if0) {
773 s/^.//;
774 next;
777 if(s/^[\(\[]//) {
778 $plevel++;
779 $declaration .= $&;
780 } elsif(s/^\]//) {
781 $plevel--;
782 $declaration .= $&;
783 } elsif(s/^\)//) {
784 $plevel--;
785 $declaration .= $&;
786 if($plevel == 1 && $declaration =~ /^__ASM_GLOBAL_FUNC/) {
787 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
788 return 0;
790 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
791 $declaration = "";
792 $declaration_line = $line;
793 $declaration_column = $column;
795 } elsif(s/^\{//) {
796 $blevel++;
797 $declaration .= $&;
798 } elsif(s/^\}//) {
799 $blevel--;
800 $declaration .= $&;
801 if($declaration =~ /^typedef/s ||
802 $declaration =~ /^(?:const\s+|extern\s+|static\s+)*(?:struct|union)(?:\s+\w+)?\s*\{/s)
804 # Nothing
805 } elsif($plevel == 1 && $blevel == 1) {
806 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
807 return 0;
809 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
810 $declaration = "";
811 $declaration_line = $line;
812 $declaration_column = $column;
813 } elsif($column == 1) {
814 $self->_parse_c_error("", $line, $column, "file", "inner } ends on column 1");
816 } elsif(s/^;//) {
817 $declaration .= $&;
818 if($blevel == 1 &&
819 $declaration !~ /^typedef/ &&
820 $declaration !~ /^(?:const\s+|extern\s+|static\s+)(?:struct|union)(?:\s+\w+)?\s*\{/s &&
821 $declaration =~ /^(?:\w+\s*)*(?:(?:\*\s*)+|\s+)(\w+)\s*\(\s*(?:(?:\w+\s*,\s*)*\w+\s*)?\)(.*?);/s &&
822 $1 ne "ICOM_VTABLE" && $2) # K&R
824 $self->_parse_c_warning($line, $column, "function $1: warning: function has K&R format");
825 } elsif($plevel == 1 && $blevel == 1) {
826 $declaration =~ s/\s*;$//;
827 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
828 return 0;
830 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
831 $declaration = "";
832 $declaration_line = $line;
833 $declaration_column = $column;
835 } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
836 $plevel = 0;
837 $blevel = 0;
838 } else {
839 $self->_parse_c_error($_, $line, $column, "file", "'$declaration' '$match'");
843 $$refcurrent = $_;
844 $$refline = $line;
845 $$refcolumn = $column;
847 return 1;
850 ########################################################################
851 # parse_c_function
853 sub parse_c_function {
854 my $self = shift;
856 my $file = \${$self->{FILE}};
857 my $create_function = \${$self->{CREATE_FUNCTION}};
859 my $refcurrent = shift;
860 my $refline = shift;
861 my $refcolumn = shift;
863 my $reffunction = shift;
865 local $_ = $$refcurrent;
866 my $line = $$refline;
867 my $column = $$refcolumn;
869 my $linkage = "";
870 my $calling_convention = "";
871 my $return_type;
872 my $name;
873 my @arguments;
874 my @argument_lines;
875 my @argument_columns;
876 my $statements;
877 my $statements_line;
878 my $statements_column;
880 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
882 my $begin_line = $line;
883 my $begin_column = $column + 1;
885 my $match;
886 while($self->_parse_c('const|inline|extern|static|volatile|' .
887 'signed(?=\\s+char|s+int|\s+long(?:\s+long)?|\s+short)|' .
888 'unsigned(?=\s+char|\s+int|\s+long(?:\s+long)?|\s+short)',
889 \$_, \$line, \$column, \$match))
891 if($match =~ /^extern|static$/) {
892 if(!$linkage) {
893 $linkage = $match;
899 if(0) {
900 # Nothing
901 } elsif($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
902 # Nothing
903 } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
904 # Nothing
905 } else {
906 if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
907 return 0;
910 $self->_parse_c("__cdecl|__stdcall|inline|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK|WINE_UNUSED|PASCAL",
911 \$_, \$line, \$column, \$calling_convention);
913 if(!$self->_parse_c('\w+', \$_, \$line, \$column, \$name)) {
914 return 0;
917 if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
918 return 0;
922 my $kar;
923 # FIXME: Implement proper handling of K&R C functions
924 $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
926 if($kar) {
927 $output->write("K&R: $kar\n");
930 if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
931 return 0;
934 my $end_line = $line;
935 my $end_column = $column;
937 $$refcurrent = $_;
938 $$refline = $line;
939 $$refcolumn = $column;
941 my $function = &$$create_function;
943 $function->file($$file);
944 $function->begin_line($begin_line);
945 $function->begin_column($begin_column);
946 $function->end_line($end_line);
947 $function->end_column($end_column);
948 $function->linkage($linkage);
949 $function->return_type($return_type);
950 $function->calling_convention($calling_convention);
951 $function->name($name);
952 # if(defined($argument_types)) {
953 # $function->argument_types([@$argument_types]);
955 # if(defined($argument_names)) {
956 # $function->argument_names([@$argument_names]);
958 $function->statements_line($statements_line);
959 $function->statements_column($statements_column);
960 $function->statements($statements);
962 $$reffunction = $function;
964 return 1;
967 ########################################################################
968 # parse_c_function_call
970 sub parse_c_function_call {
971 my $self = shift;
973 my $refcurrent = shift;
974 my $refline = shift;
975 my $refcolumn = shift;
977 my $refname = shift;
978 my $refarguments = shift;
979 my $refargument_lines = shift;
980 my $refargument_columns = shift;
982 local $_ = $$refcurrent;
983 my $line = $$refline;
984 my $column = $$refcolumn;
986 my $name;
987 my @arguments;
988 my @argument_lines;
989 my @argument_columns;
991 if(s/^(\w+)(\s*)(?=\()//s) {
992 $self->_update_c_position($&, \$line, \$column);
994 $name = $1;
996 if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
997 return 0;
999 } else {
1000 return 0;
1003 $$refcurrent = $_;
1004 $$refline = $line;
1005 $$refcolumn = $column;
1007 $$refname = $name;
1008 @$refarguments = @arguments;
1009 @$refargument_lines = @argument_lines;
1010 @$refargument_columns = @argument_columns;
1012 return 1;
1015 ########################################################################
1016 # parse_c_preprocessor
1018 sub parse_c_preprocessor {
1019 my $self = shift;
1021 my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
1023 my $refcurrent = shift;
1024 my $refline = shift;
1025 my $refcolumn = shift;
1027 local $_ = $$refcurrent;
1028 my $line = $$refline;
1029 my $column = $$refcolumn;
1031 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1033 my $begin_line = $line;
1034 my $begin_column = $column + 1;
1036 if(!&$$found_preprocessor($begin_line, $begin_column, "$_")) {
1037 return 1;
1040 if(0) {
1041 # Nothing
1042 } elsif(/^\#\s*define\s*(.*?)$/s) {
1043 $self->_update_c_position($_, \$line, \$column);
1044 } elsif(/^\#\s*else/s) {
1045 $self->_update_c_position($_, \$line, \$column);
1046 } elsif(/^\#\s*endif/s) {
1047 $self->_update_c_position($_, \$line, \$column);
1048 } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
1049 $self->_update_c_position($_, \$line, \$column);
1050 } elsif(/^\#\s*include\s+(.*?)$/s) {
1051 $self->_update_c_position($_, \$line, \$column);
1052 } elsif(/^\#\s*undef\s+(.*?)$/s) {
1053 $self->_update_c_position($_, \$line, \$column);
1054 } else {
1055 $self->_parse_c_error($_, $line, $column, "preprocessor");
1058 $$refcurrent = $_;
1059 $$refline = $line;
1060 $$refcolumn = $column;
1062 return 1;
1065 ########################################################################
1066 # parse_c_statement
1068 sub parse_c_statement {
1069 my $self = shift;
1071 my $refcurrent = shift;
1072 my $refline = shift;
1073 my $refcolumn = shift;
1075 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1077 local $_ = $$refcurrent;
1078 my $line = $$refline;
1079 my $column = $$refcolumn;
1081 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1083 $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1085 # $output->write("$line.$column: statement: '$_'\n");
1087 if(/^$/) {
1088 # Nothing
1089 } elsif(/^\{/) {
1090 my $statements;
1091 my $statements_line;
1092 my $statements_column;
1093 if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1094 return 0;
1096 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1097 return 0;
1099 } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1100 $self->_update_c_position($&, \$line, \$column);
1102 my $name = $1;
1104 my @arguments;
1105 my @argument_lines;
1106 my @argument_columns;
1107 if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1108 return 0;
1111 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1112 if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1113 return 0;
1115 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1117 while(defined(my $argument = shift @arguments) &&
1118 defined(my $argument_line = shift @argument_lines) &&
1119 defined(my $argument_column = shift @argument_columns))
1121 $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1123 } elsif(s/^else//) {
1124 $self->_update_c_position($&, \$line, \$column);
1125 if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1126 return 0;
1128 } elsif(s/^return//) {
1129 $self->_update_c_position($&, \$line, \$column);
1130 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1131 if(!$self->parse_c_expression(\$_, \$line, \$column)) {
1132 return 0;
1134 } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1135 # Nothing
1136 } else {
1137 # $self->_parse_c_error($_, $line, $column, "statement");
1140 $self->_update_c_position($_, \$line, \$column);
1142 $$refcurrent = $_;
1143 $$refline = $line;
1144 $$refcolumn = $column;
1146 return 1;
1149 ########################################################################
1150 # parse_c_statements
1152 sub parse_c_statements {
1153 my $self = shift;
1155 my $refcurrent = shift;
1156 my $refline = shift;
1157 my $refcolumn = shift;
1159 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1161 local $_ = $$refcurrent;
1162 my $line = $$refline;
1163 my $column = $$refcolumn;
1165 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1167 # $output->write("$line.$column: statements: '$_'\n");
1169 my $statement = "";
1170 my $statement_line = $line;
1171 my $statement_column = $column;
1173 my $previous_line = -1;
1174 my $previous_column = -1;
1176 my $blevel = 1;
1177 my $plevel = 1;
1178 while($plevel > 0 || $blevel > 0) {
1179 my $match;
1180 $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1182 if($previous_line == $line && $previous_column == $column) {
1183 $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1185 $previous_line = $line;
1186 $previous_column = $column;
1188 # $output->write("'$match' '$_'\n");
1190 $statement .= $match;
1191 $column++;
1192 if(s/^[\(\[]//) {
1193 $plevel++;
1194 $statement .= $&;
1195 } elsif(s/^[\)\]]//) {
1196 $plevel--;
1197 if($plevel <= 0) {
1198 $self->_parse_c_error($_, $line, $column, "statements");
1200 $statement .= $&;
1201 } elsif(s/^\{//) {
1202 $blevel++;
1203 $statement .= $&;
1204 } elsif(s/^\}//) {
1205 $blevel--;
1206 $statement .= $&;
1207 if($blevel == 1) {
1208 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1209 return 0;
1211 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1212 $statement = "";
1213 $statement_line = $line;
1214 $statement_column = $column;
1216 } elsif(s/^;//) {
1217 if($plevel == 1 && $blevel == 1) {
1218 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1219 return 0;
1222 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1223 $statement = "";
1224 $statement_line = $line;
1225 $statement_column = $column;
1226 } else {
1227 $statement .= $&;
1229 } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1230 $plevel = 0;
1231 $blevel = 0;
1232 } else {
1233 $self->_parse_c_error($_, $line, $column, "statements");
1237 $self->_update_c_position($_, \$line, \$column);
1239 $$refcurrent = $_;
1240 $$refline = $line;
1241 $$refcolumn = $column;
1243 return 1;
1246 ########################################################################
1247 # parse_c_tuple
1249 sub parse_c_tuple {
1250 my $self = shift;
1252 my $refcurrent = shift;
1253 my $refline = shift;
1254 my $refcolumn = shift;
1256 # FIXME: Should not write directly
1257 my $items = shift;
1258 my $item_lines = shift;
1259 my $item_columns = shift;
1261 local $_ = $$refcurrent;
1263 my $line = $$refline;
1264 my $column = $$refcolumn;
1266 my $item;
1267 if(s/^\(//) {
1268 $column++;
1269 $item = "";
1270 } else {
1271 return 0;
1274 my $item_line = $line;
1275 my $item_column = $column + 1;
1277 my $plevel = 1;
1278 while($plevel > 0) {
1279 my $match;
1280 $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1282 $column++;
1284 $item .= $match;
1285 if(s/^\)//) {
1286 $plevel--;
1287 if($plevel == 0) {
1288 push @$item_lines, $item_line;
1289 push @$item_columns, $item_column;
1290 push @$items, $item;
1291 $item = "";
1292 } else {
1293 $item .= ")";
1295 } elsif(s/^\(//) {
1296 $plevel++;
1297 $item .= "(";
1298 } elsif(s/^,//) {
1299 if($plevel == 1) {
1300 push @$item_lines, $item_line;
1301 push @$item_columns, $item_column;
1302 push @$items, $item;
1303 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1304 $item_line = $line;
1305 $item_column = $column + 1;
1306 $item = "";
1307 } else {
1308 $item .= ",";
1310 } else {
1311 return 0;
1315 $$refcurrent = $_;
1316 $$refline = $line;
1317 $$refcolumn = $column;
1319 return 1;
1322 ########################################################################
1323 # parse_c_type
1325 sub parse_c_type {
1326 my $self = shift;
1328 my $refcurrent = shift;
1329 my $refline = shift;
1330 my $refcolumn = shift;
1332 my $reftype = shift;
1334 local $_ = $$refcurrent;
1335 my $line = $$refline;
1336 my $column = $$refcolumn;
1338 my $type;
1340 $self->_parse_c("const", \$_, \$line, \$column);
1342 if(0) {
1343 # Nothing
1344 } elsif($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1345 # Nothing
1346 } elsif($self->_parse_c('(?:enum\s+|struct\s+|union\s+)?\w+\s*(\*\s*)*', \$_, \$line, \$column, \$type)) {
1347 # Nothing
1348 } else {
1349 return 0;
1351 $type =~ s/\s//g;
1353 $$refcurrent = $_;
1354 $$refline = $line;
1355 $$refcolumn = $column;
1357 $$reftype = $type;
1359 return 1;
1362 ########################################################################
1363 # parse_c_typedef
1365 sub parse_c_typedef {
1366 my $self = shift;
1368 my $refcurrent = shift;
1369 my $refline = shift;
1370 my $refcolumn = shift;
1372 my $reftype = shift;
1374 local $_ = $$refcurrent;
1375 my $line = $$refline;
1376 my $column = $$refcolumn;
1378 my $type;
1380 if($self->_parse_c("typedef", \$_, \$line, \$column)) {
1381 # Nothing
1382 } elsif($self->_parse_c('enum(?:\s+\w+)?\s*\{', \$_, \$line, \$column)) {
1383 # Nothing
1384 } else {
1385 return 0;
1388 $$refcurrent = $_;
1389 $$refline = $line;
1390 $$refcolumn = $column;
1392 $$reftype = $type;
1394 return 1;
1397 ########################################################################
1398 # parse_c_variable
1400 sub parse_c_variable {
1401 my $self = shift;
1403 my $found_variable = \${$self->{FOUND_VARIABLE}};
1405 my $refcurrent = shift;
1406 my $refline = shift;
1407 my $refcolumn = shift;
1409 my $reflinkage = shift;
1410 my $reftype = shift;
1411 my $refname = shift;
1413 local $_ = $$refcurrent;
1414 my $line = $$refline;
1415 my $column = $$refcolumn;
1417 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1419 my $begin_line = $line;
1420 my $begin_column = $column + 1;
1422 my $linkage = "";
1423 my $type = "";
1424 my $name = "";
1426 my $match;
1427 while($self->_parse_c('const|inline|extern|static|volatile|' .
1428 'signed(?=\\s+char|s+int|\s+long(?:\s+long)?|\s+short)|' .
1429 'unsigned(?=\s+char|\s+int|\s+long(?:\s+long)?|\s+short)',
1430 \$_, \$line, \$column, \$match))
1432 if($match =~ /^extern|static$/) {
1433 if(!$linkage) {
1434 $linkage = $match;
1439 my $finished = 0;
1441 if($finished) {
1442 # Nothing
1443 } elsif($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
1444 $type = $match;
1445 $finished = 1;
1446 } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
1447 $type = $match;
1448 $finished = 1;
1449 } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
1450 \$_, \$line, \$column, \$match))
1452 $type = $match;
1453 $finished = 1;
1454 } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
1455 $type = $match;
1456 $finished = 1;
1457 } elsif(s/^(?:enum\s+|struct\s+|union\s+)(\w+)?\s*\{.*?\}\s*//s) {
1458 $self->_update_c_position($&, \$line, \$column);
1460 if(defined($1)) {
1461 $type = "struct $1 { }";
1462 } else {
1463 $type = "struct { }";
1465 if(defined($2)) {
1466 my $stars = $2;
1467 $stars =~ s/\s//g;
1468 if($stars) {
1469 $type .= " $type";
1472 } elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
1473 $type = $&;
1474 $type =~ s/\s//g;
1475 } else {
1476 return 0;
1479 # $output->write("$type: '$_'\n");
1481 if($finished) {
1482 # Nothing
1483 } elsif(s/^WINAPI\s*//) {
1484 $self->_update_c_position($&, \$line, \$column);
1487 if($finished) {
1488 # Nothing
1489 } elsif(s/^(\((?:__cdecl)?\s*\*?\s*(?:__cdecl)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
1490 $self->_update_c_position($&, \$line, \$column);
1492 $name = $1;
1493 $name =~ s/\s//g;
1495 $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
1496 if(s/^\)//) { $column++; }
1497 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1499 if(!s/^(?:=\s*|,\s*|$)//) {
1500 return 0;
1502 } elsif(s/^(?:\*\s*)*(?:const\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
1503 $self->_update_c_position($&, \$line, \$column);
1505 $name = $1;
1506 $name =~ s/\s//g;
1507 } elsif(/^$/) {
1508 $name = "";
1509 } else {
1510 return 0;
1513 # $output->write("$type: $name: '$_'\n");
1515 if(1) {
1516 # Nothing
1517 } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(.*?\)', \$_, \$line, \$column, \$match)) {
1518 $type = "<type>";
1519 $name = "<name>";
1520 } elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+)\s*
1521 (?:\*\s*)*(\w+|\s*\*?\s*\w+\s*\))\s*(?:\[[^\]]*\]|\([^\)]*\))?
1522 (?:,\s*(?:\*\s*)*(\w+)\s*(?:\[[^\]]*\])?)*
1523 \s*(?:=|$)//sx)
1525 $self->_update_c_position($&, \$line, \$column);
1527 $type = $1;
1528 $name = $2;
1530 $type =~ s/\s//g;
1531 $type =~ s/^struct/struct /;
1532 } elsif(/^(?:enum|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*((?:\*\s*)*)(\w+)\s*(?:=|$)/s) {
1533 $self->_update_c_position($&, \$line, \$column);
1535 if(defined($1)) {
1536 $type = "struct $1 { }";
1537 } else {
1538 $type = "struct { }";
1540 my $stars = $2;
1541 $stars =~ s/\s//g;
1542 if($stars) {
1543 $type .= " $type";
1546 $name = $3;
1547 } else {
1548 return 0;
1551 if(!$name) {
1552 $name = "<name>";
1555 $$refcurrent = $_;
1556 $$refline = $line;
1557 $$refcolumn = $column;
1559 $$reflinkage = $linkage;
1560 $$reftype = $type;
1561 $$refname = $name;
1563 if(&$$found_variable($begin_line, $begin_column, $linkage, $type, $name))
1565 # Nothing
1568 return 1;