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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
30 use options qw($options);
31 use output qw($output);
36 # Defined a couple common regexp tidbits
37 my $CALL_CONVENTION="__cdecl|__stdcall|" .
38 "__RPC_API|__RPC_STUB|__RPC_USER|" .
39 "CALLBACK|CDECL|NTAPI|PASCAL|RPC_ENTRY|RPC_VAR_ENTRY|" .
40 "VFWAPI|VFWAPIV|WINAPI|WINAPIV|APIENTRY|";
43 sub parse_c_function($$$$$);
44 sub parse_c_function_call($$$$$$$$);
45 sub parse_c_preprocessor($$$$);
46 sub parse_c_statements($$$$);
47 sub parse_c_tuple($$$$$$$);
48 sub parse_c_type($$$$$);
49 sub parse_c_typedef($$$$);
50 sub parse_c_variable($$$$$$$);
53 ########################################################################
58 my $class = ref($proto) || $proto;
60 bless ($self, $class);
62 my $file = \${$self->{FILE}};
63 my $create_function = \${$self->{CREATE_FUNCTION}};
64 my $create_type = \${$self->{CREATE_TYPE}};
65 my $found_comment = \${$self->{FOUND_COMMENT}};
66 my $found_declaration = \${$self->{FOUND_DECLARATION}};
67 my $found_function = \${$self->{FOUND_FUNCTION}};
68 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
69 my $found_line = \${$self->{FOUND_LINE}};
70 my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
71 my $found_statement = \${$self->{FOUND_STATEMENT}};
72 my $found_type = \${$self->{FOUND_TYPE}};
73 my $found_variable = \${$self->{FOUND_VARIABLE}};
77 $$create_function = sub { return new c_function; };
78 $$create_type = sub { return new c_type; };
79 $$found_comment = sub { return 1; };
80 $$found_declaration = sub { return 1; };
81 $$found_function = sub { return 1; };
82 $$found_function_call = sub { return 1; };
83 $$found_line = sub { return 1; };
84 $$found_preprocessor = sub { return 1; };
85 $$found_statement = sub { return 1; };
86 $$found_type = sub { return 1; };
87 $$found_variable = sub { return 1; };
92 ########################################################################
93 # set_found_comment_callback
95 sub set_found_comment_callback($$) {
98 my $found_comment = \${$self->{FOUND_COMMENT}};
100 $$found_comment = shift;
103 ########################################################################
104 # set_found_declaration_callback
106 sub set_found_declaration_callback($$) {
109 my $found_declaration = \${$self->{FOUND_DECLARATION}};
111 $$found_declaration = shift;
114 ########################################################################
115 # set_found_function_callback
117 sub set_found_function_callback($$) {
120 my $found_function = \${$self->{FOUND_FUNCTION}};
122 $$found_function = shift;
125 ########################################################################
126 # set_found_function_call_callback
128 sub set_found_function_call_callback($$) {
131 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
133 $$found_function_call = shift;
136 ########################################################################
137 # set_found_line_callback
139 sub set_found_line_callback($$) {
142 my $found_line = \${$self->{FOUND_LINE}};
144 $$found_line = shift;
147 ########################################################################
148 # set_found_preprocessor_callback
150 sub set_found_preprocessor_callback($$) {
153 my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
155 $$found_preprocessor = shift;
158 ########################################################################
159 # set_found_statement_callback
161 sub set_found_statement_callback($$) {
164 my $found_statement = \${$self->{FOUND_STATEMENT}};
166 $$found_statement = shift;
169 ########################################################################
170 # set_found_type_callback
172 sub set_found_type_callback($$) {
175 my $found_type = \${$self->{FOUND_TYPE}};
177 $$found_type = shift;
180 ########################################################################
181 # set_found_variable_callback
183 sub set_found_variable_callback($$) {
186 my $found_variable = \${$self->{FOUND_VARIABLE}};
188 $$found_variable = shift;
192 ########################################################################
195 sub _format_c_type($$) {
201 if (/^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
202 my $return_type = $1;
203 my @arguments = split(/\s*,\s*/, $2);
204 foreach my $argument (@arguments) {
205 if ($argument =~ s/^(\w+(?:\s*\*)*)\s*\w+$/$1/) {
206 $argument =~ s/\s+/ /g;
207 $argument =~ s/\s*\*\s*/*/g;
208 $argument =~ s/(\*+)$/ $1/;
212 $_ = "$return_type (*)(" . join(", ", @arguments) . ")";
219 ########################################################################
222 # FIXME: Use caller (See man perlfunc)
224 sub _parse_c_warning($$$$$$) {
233 my $file = \${$self->{FILE}};
235 $message = "warning" if !$message;
239 my @lines = split(/\n/, $_);
241 $current .= $lines[0] . "\n" if $lines[0];
242 $current .= $lines[1] . "\n" if $lines[1];
246 (my $package, my $filename, my $line) = caller(0);
247 $output->write("*** caller ***: $filename:$line\n");
251 $output->write("$$file:$line." . ($column + 1) . ": $context: $message: \\\n$current");
253 $output->write("$$file:$line." . ($column + 1) . ": $context: $message\n");
257 ########################################################################
260 sub _parse_c_error($$$$$$) {
269 $message = "parse error" if !$message;
272 if($output->prefix) {
273 # $output->write("\n");
277 $self->_parse_c_warning($_, $line, $column, $context, $message);
282 ########################################################################
285 sub _update_c_position($$$$) {
290 my $refcolumn = shift;
292 my $line = $$refline;
293 my $column = $$refcolumn;
296 if(s/^[^\n\t\'\"]*//s) {
297 $column += length($&);
302 while(/^./ && !s/^\'//) {
304 $column += length($1);
308 $column += length($1);
311 $column += length($1);
319 while(/^./ && !s/^\"//) {
321 $column += length($1);
325 $column += length($1);
328 $column += length($1);
338 $column = $column + 8 - $column % 8;
343 $$refcolumn = $column;
346 ########################################################################
347 # __parse_c_until_one_of
349 sub __parse_c_until_one_of($$$$$$$) {
352 my $characters = shift;
353 my $on_same_level = shift;
354 my $refcurrent = shift;
356 my $refcolumn = shift;
359 local $_ = $$refcurrent;
360 my $line = $$refline;
361 my $column = $$refcolumn;
364 if(!defined($match)) {
366 $match = \$blackhole;
371 while(/^[^$characters]/s || $level > 0) {
375 if(s/^[^\(\)\[\]\{\}\n\t\'\"]*//s) {
378 } elsif ($on_same_level) {
379 if(s/^[^$characters\(\)\[\]\{\}\n\t\'\"]*//s) {
383 if(s/^[^$characters\n\t\'\"]*//s) {
390 while(/^./ && !s/^\'//) {
406 $$match .= $submatch;
407 $column += length($submatch);
410 while(/^./ && !s/^\"//) {
426 $$match .= $submatch;
427 $column += length($submatch);
428 } elsif($on_same_level && s/^[\(\[\{]//) {
432 $$match .= $submatch;
434 } elsif($on_same_level && s/^[\)\]\}]//) {
439 $$match .= $submatch;
443 $$match .= $submatch;
449 $$match .= $submatch;
455 $$match .= $submatch;
456 $column = $column + 8 - $column % 8;
458 $$match .= $submatch;
459 $column += length($submatch);
465 $$refcolumn = $column;
469 ########################################################################
470 # _parse_c_until_one_of
472 sub _parse_c_until_one_of($$$$$$) {
475 my $characters = shift;
476 my $refcurrent = shift;
478 my $refcolumn = shift;
481 return $self->__parse_c_until_one_of($characters, 0, $refcurrent, $refline, $refcolumn, $match);
484 ########################################################################
485 # _parse_c_on_same_level_until_one_of
487 sub _parse_c_on_same_level_until_one_of($$$$$$) {
490 my $characters = shift;
491 my $refcurrent = shift;
493 my $refcolumn = shift;
496 return $self->__parse_c_until_one_of($characters, 1, $refcurrent, $refline, $refcolumn, $match);
499 ########################################################################
502 sub parse_c_block($$$$$$$) {
505 my $refcurrent = shift;
507 my $refcolumn = shift;
509 my $refstatements = shift;
510 my $refstatements_line = shift;
511 my $refstatements_column = shift;
513 local $_ = $$refcurrent;
514 my $line = $$refline;
515 my $column = $$refcolumn;
517 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
527 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
529 my $statements_line = $line;
530 my $statements_column = $column;
535 $self->_parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
539 $statements .= $match;
555 $$refcolumn = $column;
556 $$refstatements = $statements;
557 $$refstatements_line = $statements_line;
558 $$refstatements_column = $statements_column;
563 ########################################################################
564 # parse_c_declaration
566 sub parse_c_declaration($$$$$$$$$$$$) {
569 my $found_declaration = \${$self->{FOUND_DECLARATION}};
570 my $found_function = \${$self->{FOUND_FUNCTION}};
572 my $refcurrent = shift;
574 my $refcolumn = shift;
576 local $_ = $$refcurrent;
577 my $line = $$refline;
578 my $column = $$refcolumn;
580 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
582 my $begin_line = $line;
583 my $begin_column = $column + 1;
585 my $end_line = $begin_line;
586 my $end_column = $begin_column;
587 $self->_update_c_position($_, \$end_line, \$end_column);
589 if(!&$$found_declaration($begin_line, $begin_column, $end_line, $end_column, $_)) {
594 my $function = shift;
597 my $calling_convention = shift;
598 my $return_type = shift;
600 my @arguments = shift;
601 my @argument_lines = shift;
602 my @argument_columns = shift;
607 if(s/^WINE_(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
608 $self->_update_c_position($&, \$line, \$column);
609 } elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
610 $self->_update_c_position($&, \$line, \$column);
611 $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
615 } elsif(s/^(?:DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
616 $self->_update_c_position($&, \$line, \$column);
620 my @argument_columns;
622 if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
625 } elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
626 $self->_update_c_position($&, \$line, \$column);
627 } elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
628 $self->_update_c_position($&, \$line, \$column);
629 } elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
630 $self->_update_c_position($&, \$line, \$column);
631 } elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
632 $self->_update_c_position($&, \$line, \$column);
633 } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
634 $self->_update_c_position($&, \$line, \$column);
635 } elsif(s/^(?:__asm__|asm)\s*\(//) {
636 $self->_update_c_position($&, \$line, \$column);
637 } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
639 } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
641 } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
642 if(&$$found_function($function))
644 my $statements = $function->statements;
645 my $statements_line = $function->statements_line;
646 my $statements_column = $function->statements_column;
648 if(defined($statements)) {
649 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
655 $self->_parse_c_error($_, $line, $column, "declaration");
660 $$refcolumn = $column;
665 ########################################################################
668 sub _parse_c($$$$$$) {
672 my $refcurrent = shift;
674 my $refcolumn = shift;
676 my $refmatch = shift;
678 local $_ = $$refcurrent;
679 my $line = $$refline;
680 my $column = $$refcolumn;
683 if(s/^(?:$pattern)//s) {
684 $self->_update_c_position($&, \$line, \$column);
690 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
694 $$refcolumn = $column;
701 ########################################################################
704 sub parse_c_enum($$$$) {
707 my $refcurrent = shift;
709 my $refcolumn = shift;
711 local $_ = $$refcurrent;
712 my $line = $$refline;
713 my $column = $$refcolumn;
715 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
717 if (!s/^enum\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
720 my $_name = $1 || "";
722 $self->_update_c_position($&, \$line, \$column);
727 while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
729 if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
730 $self->_parse_c_error($_, $line, $column, "enum");
733 my $enum_value = $2 || "";
735 # $output->write("enum:$_name:$enum_name:$enum_value\n");
738 if ($self->_parse_c(',', \$_, \$line, \$column)) {
740 } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
743 my $tuple_line = $line;
744 my $tuple_column = $column - 1;
748 my @argument_columns;
750 if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
751 \@arguments, \@argument_lines, \@argument_columns))
753 $self->_parse_c_error($_, $line, $column, "enum");
757 if ($#arguments >= 0) {
758 $name = $arguments[0];
763 $self->_parse_c_error($_, $line, $column, "enum");
767 $self->_update_c_position($_, \$line, \$column);
771 $$refcolumn = $column;
775 ########################################################################
778 sub parse_c_expression($$$$) {
781 my $refcurrent = shift;
783 my $refcolumn = shift;
785 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
787 local $_ = $$refcurrent;
788 my $line = $$refline;
789 my $column = $$refcolumn;
791 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
794 if(s/^(.*?)(\w+\s*\()/$2/s) {
795 $self->_update_c_position($1, \$line, \$column);
797 my $begin_line = $line;
798 my $begin_column = $column + 1;
803 my @argument_columns;
804 if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
808 if(&$$found_function_call($begin_line, $begin_column, $line, $column, $name, \@arguments))
810 while(defined(my $argument = shift @arguments) &&
811 defined(my $argument_line = shift @argument_lines) &&
812 defined(my $argument_column = shift @argument_columns))
814 $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
822 $self->_update_c_position($_, \$line, \$column);
826 $$refcolumn = $column;
831 ########################################################################
834 sub parse_c_file($$$$) {
837 my $found_comment = \${$self->{FOUND_COMMENT}};
838 my $found_line = \${$self->{FOUND_LINE}};
840 my $refcurrent = shift;
842 my $refcolumn = shift;
844 local $_ = $$refcurrent;
845 my $line = $$refline;
846 my $column = $$refcolumn;
848 my $declaration = "";
849 my $declaration_line = $line;
850 my $declaration_column = $column;
852 my $previous_line = 0;
853 my $previous_column = -1;
855 my $preprocessor_condition;
862 while($plevel > 0 || $blevel > 0) {
864 $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
866 if($line != $previous_line) {
867 &$$found_line($line);
868 } elsif(0 && $column == $previous_column) {
869 $self->_parse_c_error($_, $line, $column, "file", "no progress");
871 # &$$found_line("$line.$column");
873 $previous_line = $line;
874 $previous_column = $column;
876 if($match !~ /^\s+$/s && $options->debug) {
877 $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
880 if(!$declaration && $match =~ s/^\s+//s) {
881 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
885 $declaration .= $match;
888 if ($declaration =~ s/^extern\s*\"C\"//s) {
890 $self->_update_c_position($&, \$line, \$column);
892 $declaration_line = $line;
893 $declaration_column = $column;
898 } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
900 $self->_update_c_position($&, \$line, \$column);
902 $declaration_line = $line;
903 $declaration_column = $column;
908 } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
910 if ($plevel > 2 || !s/^\)//) {
911 $declaration = "$prefix$declaration";
914 $self->_update_c_position($&, \$line, \$column);
919 my @argument_columns;
921 if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
922 \@arguments, \@argument_lines, \@argument_columns))
924 $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
928 $declaration_line = $line;
929 $declaration_column = $column;
933 } elsif ($declaration =~ s/^(?:DEFINE_SHLGUID)\s*\(.*?\)//s) {
934 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
935 } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
936 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
937 } elsif ($declaration =~ s/^ICOM_DEFINE\(\s*(\w+)\s*,\s*(\w+)\s*\)\s*//s) {
938 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
944 while(s/^.*?\n//) { $blank_lines++; }
947 $declaration_line = $line;
948 $declaration_column = $column;
950 $declaration .= "\n" x $blank_lines;
958 my $preprocessor_line = $line;
959 my $preprocessor_column = $column;
961 my $preprocessor = $&;
962 while(s/^(.*?)\\\s*\n//) {
964 $preprocessor .= "$1\n";
966 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
969 $preprocessor .= "$1$3";
973 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
983 if($preprocessor =~ /^\#\s*if/) {
984 if($preprocessor =~ /^\#\s*if\s*0/) {
989 if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
990 $preprocessor_condition = "defined(WORD_BIGENDIAN)";
991 # $output->write("'$preprocessor_condition':'$declaration'\n")
993 $preprocessor_condition = "";
996 } elsif($preprocessor =~ /^\#\s*else/) {
997 if ($preprocessor_condition ne "") {
998 $preprocessor_condition =~ "!$preprocessor_condition";
999 $preprocessor_condition =~ s/^!!/!/;
1000 # $output->write("'$preprocessor_condition':'$declaration'\n")
1002 } elsif($preprocessor =~ /^\#\s*endif/) {
1010 if ($preprocessor_condition ne "") {
1011 # $output->write("'$preprocessor_condition':'$declaration'\n");
1012 $preprocessor_condition = "";
1017 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
1022 if(s/^\/\*.*?\*\///s) {
1023 &$$found_comment($line, $column + 1, $&);
1029 $column += length($_);
1031 } elsif(s/^\/\/(.*?)\n//) {
1032 &$$found_comment($line, $column + 1, $&);
1041 $line += $blank_lines;
1042 if($blank_lines > 0) {
1047 $declaration_line = $line;
1048 $declaration_column = $column;
1049 } elsif($blank_lines > 0) {
1050 $declaration .= "\n" x $blank_lines;
1072 $self->_parse_c_error($_, $line, $column, "file", ") without (");
1075 if($plevel == 1 && $declaration =~ /^__ASM_GLOBAL_FUNC/) {
1076 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1079 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1081 $declaration_line = $line;
1082 $declaration_column = $column;
1090 $self->_parse_c_error($_, $line, $column, "file", "} without {");
1095 if($declaration =~ /^typedef/s ||
1096 $declaration =~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)*(?:interface|struct|union)(?:\s+\w+)?\s*\{/s)
1099 } elsif($plevel == 1 && $blevel == 1) {
1100 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1103 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1105 $declaration_line = $line;
1106 $declaration_column = $column;
1107 } elsif($column == 1 && !$extern_c) {
1108 $self->_parse_c_error("", $line, $column, "file", "inner } ends on column 1");
1112 if(0 && $blevel == 1 &&
1113 $declaration !~ /^typedef/ &&
1114 $declaration !~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)?(?:interface|struct|union)(?:\s+\w+)?\s*\{/s &&
1115 $declaration =~ /^(?:\w+(?:\s*\*)*\s+)*(\w+)\s*\(\s*(?:(?:\w+\s*,\s*)*(\w+))?\s*\)\s*(.*?);$/s &&
1116 $1 ne "ICOM_VTABLE" && defined($2) && $2 ne "void" && $3) # K&R
1118 $self->_parse_c_warning("", $line, $column, "file", "function $1: warning: function has K&R format");
1119 } elsif($plevel == 1 && $blevel == 1) {
1120 $declaration =~ s/\s*;$//;
1121 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
1124 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1126 $declaration_line = $line;
1127 $declaration_column = $column;
1129 } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
1133 $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
1139 $$refcolumn = $column;
1144 ########################################################################
1147 sub parse_c_function($$$$$) {
1150 my $file = \${$self->{FILE}};
1151 my $create_function = \${$self->{CREATE_FUNCTION}};
1153 my $refcurrent = shift;
1154 my $refline = shift;
1155 my $refcolumn = shift;
1157 my $reffunction = shift;
1159 local $_ = $$refcurrent;
1160 my $line = $$refline;
1161 my $column = $$refcolumn;
1164 my $calling_convention = "";
1169 my @argument_columns;
1171 my $statements_line;
1172 my $statements_column;
1174 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1176 my $begin_line = $line;
1177 my $begin_column = $column + 1;
1179 if($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
1183 # $self->_parse_c_warning($_, $line, $column, "function", "");
1186 while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1187 'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1188 'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1189 'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1190 \$_, \$line, \$column, \$match))
1192 if($match =~ /^(?:extern|static)$/) {
1199 if($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1201 } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1204 if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
1208 $self->_parse_c('inline|FAR', \$_, \$line, \$column);
1210 $self->_parse_c($CALL_CONVENTION,
1211 \$_, \$line, \$column, \$calling_convention);
1214 # FIXME: ???: Old variant of __attribute((const))
1215 $self->_parse_c('(?:const|volatile)', \$_, \$line, \$column);
1217 if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
1223 $self->_update_c_position($&, \$line, \$column);
1227 if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1233 $self->_update_c_position($&, \$line, \$column);
1235 $self->_parse_c_error($_, $line, $column, "function");
1241 if($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
1246 # FIXME: Implement proper handling of K&R C functions
1247 $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
1250 $output->write("K&R: $kar\n");
1253 if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1257 my $end_line = $line;
1258 my $end_column = $column;
1262 $$refcolumn = $column;
1264 my $function = &$$create_function;
1266 $function->file($$file);
1267 $function->begin_line($begin_line);
1268 $function->begin_column($begin_column);
1269 $function->end_line($end_line);
1270 $function->end_column($end_column);
1271 $function->linkage($linkage);
1272 $function->return_type($return_type);
1273 $function->calling_convention($calling_convention);
1274 $function->name($name);
1275 # if(defined($argument_types)) {
1276 # $function->argument_types([@$argument_types]);
1278 # if(defined($argument_names)) {
1279 # $function->argument_names([@$argument_names]);
1281 $function->statements_line($statements_line);
1282 $function->statements_column($statements_column);
1283 $function->statements($statements);
1285 $$reffunction = $function;
1290 ########################################################################
1291 # parse_c_function_call
1293 sub parse_c_function_call($$$$$$$$) {
1296 my $refcurrent = shift;
1297 my $refline = shift;
1298 my $refcolumn = shift;
1300 my $refname = shift;
1301 my $refarguments = shift;
1302 my $refargument_lines = shift;
1303 my $refargument_columns = shift;
1305 local $_ = $$refcurrent;
1306 my $line = $$refline;
1307 my $column = $$refcolumn;
1312 my @argument_columns;
1314 if(s/^(\w+)(\s*)(?=\()//s) {
1315 $self->_update_c_position($&, \$line, \$column);
1319 if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1328 $$refcolumn = $column;
1331 @$refarguments = @arguments;
1332 @$refargument_lines = @argument_lines;
1333 @$refargument_columns = @argument_columns;
1338 ########################################################################
1339 # parse_c_preprocessor
1341 sub parse_c_preprocessor($$$$) {
1344 my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
1346 my $refcurrent = shift;
1347 my $refline = shift;
1348 my $refcolumn = shift;
1350 local $_ = $$refcurrent;
1351 my $line = $$refline;
1352 my $column = $$refcolumn;
1354 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1356 my $begin_line = $line;
1357 my $begin_column = $column + 1;
1359 if(!&$$found_preprocessor($begin_line, $begin_column, "$_")) {
1363 if(/^\#\s*define\s*(.*?)$/s) {
1364 $self->_update_c_position($_, \$line, \$column);
1365 } elsif(/^\#\s*else/s) {
1366 $self->_update_c_position($_, \$line, \$column);
1367 } elsif(/^\#\s*endif/s) {
1368 $self->_update_c_position($_, \$line, \$column);
1369 } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
1370 $self->_update_c_position($_, \$line, \$column);
1371 } elsif(/^\#\s*include\s+(.*?)$/s) {
1372 $self->_update_c_position($_, \$line, \$column);
1373 } elsif(/^\#\s*undef\s+(.*?)$/s) {
1374 $self->_update_c_position($_, \$line, \$column);
1376 $self->_parse_c_error($_, $line, $column, "preprocessor");
1381 $$refcolumn = $column;
1386 ########################################################################
1389 sub parse_c_statement($$$$) {
1392 my $refcurrent = shift;
1393 my $refline = shift;
1394 my $refcolumn = shift;
1396 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1398 local $_ = $$refcurrent;
1399 my $line = $$refline;
1400 my $column = $$refcolumn;
1402 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1404 $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1406 # $output->write("$line.$column: statement: '$_'\n");
1412 my $statements_line;
1413 my $statements_column;
1414 if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1417 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1420 } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1421 $self->_update_c_position($&, \$line, \$column);
1427 my @argument_columns;
1428 if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1432 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1433 if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1436 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1438 while(defined(my $argument = shift @arguments) &&
1439 defined(my $argument_line = shift @argument_lines) &&
1440 defined(my $argument_column = shift @argument_columns))
1442 $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1444 } elsif(s/^else//) {
1445 $self->_update_c_position($&, \$line, \$column);
1446 if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1449 } elsif(s/^return//) {
1450 $self->_update_c_position($&, \$line, \$column);
1451 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1452 if(!$self->parse_c_expression(\$_, \$line, \$column)) {
1455 } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1458 # $self->_parse_c_error($_, $line, $column, "statement");
1461 $self->_update_c_position($_, \$line, \$column);
1465 $$refcolumn = $column;
1470 ########################################################################
1471 # parse_c_statements
1473 sub parse_c_statements($$$$) {
1476 my $refcurrent = shift;
1477 my $refline = shift;
1478 my $refcolumn = shift;
1480 my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1482 local $_ = $$refcurrent;
1483 my $line = $$refline;
1484 my $column = $$refcolumn;
1486 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1488 # $output->write("$line.$column: statements: '$_'\n");
1491 my $statement_line = $line;
1492 my $statement_column = $column;
1494 my $previous_line = -1;
1495 my $previous_column = -1;
1499 while($plevel > 0 || $blevel > 0) {
1501 $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1503 if($previous_line == $line && $previous_column == $column) {
1504 $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1506 $previous_line = $line;
1507 $previous_column = $column;
1509 # $output->write("'$match' '$_'\n");
1511 $statement .= $match;
1516 } elsif(s/^[\)\]]//) {
1519 $self->_parse_c_error($_, $line, $column, "statements");
1529 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1532 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1534 $statement_line = $line;
1535 $statement_column = $column;
1538 if($plevel == 1 && $blevel == 1) {
1539 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1543 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1545 $statement_line = $line;
1546 $statement_column = $column;
1550 } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1554 $self->_parse_c_error($_, $line, $column, "statements");
1558 $self->_update_c_position($_, \$line, \$column);
1562 $$refcolumn = $column;
1567 ########################################################################
1568 # parse_c_struct_union
1570 sub parse_c_struct_union($$$$$$$$$) {
1573 my $refcurrent = shift;
1574 my $refline = shift;
1575 my $refcolumn = shift;
1577 my $refkind = shift;
1578 my $ref_name = shift;
1579 my $reffield_type_names = shift;
1580 my $reffield_names = shift;
1581 my $refnames = shift;
1583 local $_ = $$refcurrent;
1584 my $line = $$refline;
1585 my $column = $$refcolumn;
1589 my @field_type_names = ();
1590 my @field_names = ();
1593 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1595 if (!s/^(interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1601 $self->_update_c_position($&, \$line, \$column);
1606 while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
1609 my $field_type_name;
1612 if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
1613 $field_type_name =~ s/\s+/ /g;
1615 push @field_type_names, $field_type_name;
1616 push @field_names, $field_name;
1617 # $output->write("$kind:$_name:$field_type_name:$field_name\n");
1619 $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
1622 if ($self->_parse_c(';', \$_, \$line, \$column)) {
1624 } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
1627 my $tuple_line = $line;
1628 my $tuple_column = $column - 1;
1632 my @argument_columns;
1634 if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
1635 \@arguments, \@argument_lines, \@argument_columns))
1637 $self->_parse_c_error($_, $line, $column, "$kind");
1640 foreach my $argument (@arguments) {
1641 my $name = $argument;
1648 $self->_parse_c_error($_, $line, $column, "$kind");
1654 $$refcolumn = $column;
1657 $$ref_name = $_name;
1658 @$reffield_type_names = @field_type_names;
1659 @$reffield_names = @field_names;
1660 @$refnames = @names;
1665 ########################################################################
1668 sub parse_c_tuple($$$$$$$) {
1671 my $refcurrent = shift;
1672 my $refline = shift;
1673 my $refcolumn = shift;
1675 # FIXME: Should not write directly
1677 my $item_lines = shift;
1678 my $item_columns = shift;
1680 local $_ = $$refcurrent;
1682 my $line = $$refline;
1683 my $column = $$refcolumn;
1693 my $item_line = $line;
1694 my $item_column = $column + 1;
1697 while($plevel > 0) {
1699 $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1707 push @$item_lines, $item_line;
1708 push @$item_columns, $item_column;
1709 push @$items, $item;
1719 push @$item_lines, $item_line;
1720 push @$item_columns, $item_column;
1721 push @$items, $item;
1722 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1724 $item_column = $column + 1;
1736 $$refcolumn = $column;
1741 ########################################################################
1744 sub parse_c_type($$$$$) {
1747 my $refcurrent = shift;
1748 my $refline = shift;
1749 my $refcolumn = shift;
1751 my $reftype = shift;
1753 local $_ = $$refcurrent;
1754 my $line = $$refline;
1755 my $column = $$refcolumn;
1759 $self->_parse_c("(?:const|volatile)", \$_, \$line, \$column);
1761 if($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1763 } elsif($self->_parse_c('(?:enum\s+|interface\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
1764 \$_, \$line, \$column, \$type))
1774 $$refcolumn = $column;
1781 ########################################################################
1784 sub parse_c_typedef($$$$) {
1787 my $create_type = \${$self->{CREATE_TYPE}};
1788 my $found_type = \${$self->{FOUND_TYPE}};
1789 my $preprocessor_condition = \${$self->{PREPROCESSOR_CONDITION}};
1791 my $refcurrent = shift;
1792 my $refline = shift;
1793 my $refcolumn = shift;
1795 local $_ = $$refcurrent;
1796 my $line = $$refline;
1797 my $column = $$refcolumn;
1801 if (!$self->_parse_c("typedef", \$_, \$line, \$column)) {
1809 } elsif ($self->parse_c_enum(\$_, \$line, \$column)) {
1815 my @field_type_names;
1820 } elsif ($self->parse_c_struct_union(\$_, \$line, \$column,
1821 \$kind, \$_name, \@field_type_names, \@field_names, \@names))
1824 foreach my $name (@names)
1826 if ($name =~ /^\w+$/)
1832 $base_name="$kind $_name" if (!defined $base_name and defined $_name);
1833 $base_name=$kind if (!defined $base_name);
1834 foreach my $name (@names) {
1835 if ($name =~ /^\w+$/) {
1836 my $type = &$$create_type();
1839 $type->_name($_name);
1841 $type->field_type_names([@field_type_names]);
1842 $type->field_names([@field_names]);
1844 &$$found_type($type);
1845 } elsif ($name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
1846 my $type_name = "$base_name $1";
1849 my $type = &$$create_type();
1853 $type->field_type_names([$type_name]);
1854 $type->field_names([""]);
1856 &$$found_type($type);
1858 $self->_parse_c_error($_, $line, $column, "typedef 2");
1870 } elsif ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name)) {
1871 $type_name =~ s/\s+/ /g;
1873 if(defined($type_name) && defined($name)) {
1874 my $type = &$$create_type();
1876 if (length($name) == 0) {
1877 $self->_parse_c_error($_, $line, $column, "typedef");
1882 $type->field_type_names([$type_name]);
1883 $type->field_names([""]);
1885 &$$found_type($type);
1888 if (0 && $_ && !/^,/) {
1889 $self->_parse_c_error($_, $line, $column, "typedef");
1892 $self->_parse_c_error($_, $line, $column, "typedef");
1897 $$refcolumn = $column;
1902 ########################################################################
1905 sub parse_c_variable($$$$$$$) {
1908 my $found_variable = \${$self->{FOUND_VARIABLE}};
1910 my $refcurrent = shift;
1911 my $refline = shift;
1912 my $refcolumn = shift;
1914 my $reflinkage = shift;
1915 my $reftype = shift;
1916 my $refname = shift;
1918 local $_ = $$refcurrent;
1919 my $line = $$refline;
1920 my $column = $$refcolumn;
1922 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1924 my $begin_line = $line;
1925 my $begin_column = $column + 1;
1932 # $self->_parse_c_warning($_, $line, $column, "variable");
1935 while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1936 'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1937 'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1938 'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1939 \$_, \$line, \$column, \$match))
1941 if ($match =~ /^(?:extern|static)$/) {
1945 $self->_parse_c_warning($_, $line, $column, "repeated linkage (ignored): $match");
1947 } elsif ($match =~ /^(?:signed|unsigned)$/) {
1951 $self->_parse_c_warning($_, $line, $column, "repeated sign (ignored): $match");
1962 } elsif (s/^(enum\s+|interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1965 $self->_update_c_position($&, \$line, \$column);
1967 if(defined($_name)) {
1968 $type = "$kind $_name { }";
1970 $type = "$kind { }";
1974 } 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) {
1990 $type = $self->_format_c_type($type);
1993 } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*)\s*:\s*(\d+)$//s) {
1994 $type = "$sign$1:$2";
1996 $type = $self->_format_c_type($type);
1999 } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*\s*\(\s*(?:$CALL_CONVENTION)?(?:\s*\*)*)\s*(\w+)\s*(\)\s*\(.*?\))$//s) {
2000 $type = $self->_format_c_type("$sign$1$3");
2004 } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
2008 $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
2014 } elsif($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
2017 } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
2018 \$_, \$line, \$column, \$match))
2022 } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
2025 } elsif(s/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
2028 $self->_update_c_position($&, \$line, \$column);
2030 if(defined($_name)) {
2031 $type = "struct $_name { }";
2033 $type = "struct { }";
2035 } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
2042 # $output->write("*** $type: '$_'\n");
2044 # $self->_parse_c_warning($_, $line, $column, "variable2", "");
2048 } elsif(s/^WINAPI\s*//) {
2049 $self->_update_c_position($&, \$line, \$column);
2054 } elsif(s/^(\((?:$CALL_CONVENTION)?\s*\*?\s*(?:$CALL_CONVENTION)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
2055 $self->_update_c_position($&, \$line, \$column);
2060 $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
2061 if(s/^\)//) { $column++; }
2062 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
2064 if(!s/^(?:=\s*|,\s*|$)//) {
2067 } elsif(s/^(?:\*\s*)*(?:const\s+|volatile\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
2068 $self->_update_c_position($&, \$line, \$column);
2078 # $output->write("$type: $name: '$_'\n");
2082 $$refcolumn = $column;
2084 $$reflinkage = $linkage;
2088 if(&$$found_variable($begin_line, $begin_column, $linkage, $type, $name))