Added regedit unit test, a couple minor changes to regedit.
[wine] / tools / winapi / c_parser.pm
1 #
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
3 #
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
8 #
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12 # Lesser General Public License for more details.
13 #
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17 #
18
19 package c_parser;
20
21 use strict;
22
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
25
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw();
29
30 use options qw($options);
31 use output qw($output);
32
33 use c_function;
34
35 ########################################################################
36 # new
37 #
38 sub new {
39     my $proto = shift;
40     my $class = ref($proto) || $proto;
41     my $self  = {};
42     bless ($self, $class);
43
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}};
54
55     $$file = shift;
56
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; };
66
67     return $self;
68 }
69
70 ########################################################################
71 # set_found_comment_callback
72 #
73 sub set_found_comment_callback {
74     my $self = shift;
75
76     my $found_comment = \${$self->{FOUND_COMMENT}};
77
78     $$found_comment = shift;
79 }
80
81 ########################################################################
82 # set_found_declaration_callback
83 #
84 sub set_found_declaration_callback {
85     my $self = shift;
86
87     my $found_declaration = \${$self->{FOUND_DECLARATION}};
88
89     $$found_declaration = shift;
90 }
91
92 ########################################################################
93 # set_found_function_callback
94 #
95 sub set_found_function_callback {
96     my $self = shift;
97
98     my $found_function = \${$self->{FOUND_FUNCTION}};
99
100     $$found_function = shift;
101 }
102
103 ########################################################################
104 # set_found_function_call_callback
105 #
106 sub set_found_function_call_callback {
107     my $self = shift;
108
109     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
110
111     $$found_function_call = shift;
112 }
113
114 ########################################################################
115 # set_found_line_callback
116 #
117 sub set_found_line_callback {
118     my $self = shift;
119
120     my $found_line = \${$self->{FOUND_LINE}};
121
122     $$found_line = shift;
123 }
124
125 ########################################################################
126 # set_found_preprocessor_callback
127 #
128 sub set_found_preprocessor_callback {
129     my $self = shift;
130
131     my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
132
133     $$found_preprocessor = shift;
134 }
135
136 ########################################################################
137 # set_found_statement_callback
138 #
139 sub set_found_statement_callback {
140     my $self = shift;
141
142     my $found_statement = \${$self->{FOUND_STATEMENT}};
143
144     $$found_statement = shift;
145 }
146
147 ########################################################################
148 # set_found_variable_callback
149 #
150 sub set_found_variable_callback {
151     my $self = shift;
152
153     my $found_variable = \${$self->{FOUND_VARIABLE}};
154
155     $$found_variable = shift;
156 }
157
158 ########################################################################
159 # _parse_c
160
161 sub _parse_c {
162     my $self = shift;
163
164     my $pattern = shift;
165     my $refcurrent = shift;
166     my $refline = shift;
167     my $refcolumn = shift;
168
169     my $refmatch = shift;
170
171     local $_ = $$refcurrent;
172     my $line = $$refline;
173     my $column = $$refcolumn;
174
175     my $match;
176     if(s/^(?:$pattern)//s) {
177         $self->_update_c_position($&, \$line, \$column);
178         $match = $&;
179     } else {
180         return 0;
181     }
182
183     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
184
185     $$refcurrent = $_;
186     $$refline = $line;
187     $$refcolumn = $column;
188
189     $$refmatch = $match;
190
191     return 1;
192 }
193
194 ########################################################################
195 # _parse_c_error
196 #
197 # FIXME: Use caller (See man perlfunc)
198
199 sub _parse_c_error {
200     my $self = shift;
201
202     my $file = \${$self->{FILE}};
203
204     local $_ = shift;
205     my $line = shift;
206     my $column = shift;
207     my $context = shift;
208     my $message = shift;
209
210     $message = "parse error" if !$message;
211
212     my $current = "";
213     if($_) {
214         my @lines = split(/\n/, $_);
215
216         $current .= $lines[0] . "\n" if $lines[0];
217         $current .= $lines[1] . "\n" if $lines[1];
218     }
219
220     if($output->prefix) {
221         $output->write("\n");
222         $output->prefix("");
223     }
224
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");
229     }
230
231     exit 1;
232 }
233
234 ########################################################################
235 # _parse_c_warning
236
237 sub _parse_c_warning {
238     my $self = shift;
239
240     my $line = shift;
241     my $column = shift;
242     my $message = shift;
243
244     $output->write("$line." . ($column + 1) . ": $message\n");
245 }
246
247 ########################################################################
248 # _parse_c_until_one_of
249
250 sub _parse_c_until_one_of {
251     my $self = shift;
252
253     my $characters = shift;
254     my $refcurrent = shift;
255     my $refline = shift;
256     my $refcolumn = shift;
257     my $match = shift;
258
259     local $_ = $$refcurrent;
260     my $line = $$refline;
261     my $column = $$refcolumn;
262
263     if(!defined($match)) {
264         my $blackhole;
265         $match = \$blackhole;
266     }
267
268     $$match = "";
269     while(/^[^$characters]/s) {
270         my $submatch = "";
271
272         if(s/^[^$characters\n\t\'\"]*//s) {
273             $submatch .= $&;
274         }
275
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;
288                         }
289                     }
290                 }
291             }
292             $submatch .= "\'";
293
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;
308                         }
309                     }
310                 }
311             }
312             $submatch .= "\"";
313
314             $$match .= $submatch;
315             $column += length($submatch);
316         } elsif(s/^\n//) {
317             $submatch .= "\n";
318
319             $$match .= $submatch;
320             $line++;
321             $column = 0;
322         } elsif(s/^\t//) {
323             $submatch .= "\t";
324
325             $$match .= $submatch;
326             $column = $column + 8 - $column % 8;
327         } else {
328             $$match .= $submatch;
329             $column += length($submatch);
330         }
331     }
332
333     $$refcurrent = $_;
334     $$refline = $line;
335     $$refcolumn = $column;
336     return 1;
337 }
338
339 ########################################################################
340 # _update_c_position
341
342 sub _update_c_position {
343     my $self = shift;
344
345     local $_ = shift;
346     my $refline = shift;
347     my $refcolumn = shift;
348
349     my $line = $$refline;
350     my $column = $$refcolumn;
351
352     while($_) {
353         if(s/^[^\n\t\'\"]*//s) {
354             $column += length($&);
355         }
356
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);
369                         }
370                     }
371                 }
372             }
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);
386                         }
387                     }
388                 }
389             }
390             $column++;
391         } elsif(s/^\n//) {
392             $line++;
393             $column = 0;
394         } elsif(s/^\t//) {
395             $column = $column + 8 - $column % 8;
396         }
397     }
398
399     $$refline = $line;
400     $$refcolumn = $column;
401 }
402
403 ########################################################################
404 # parse_c_block
405
406 sub parse_c_block {
407     my $self = shift;
408
409     my $refcurrent = shift;
410     my $refline = shift;
411     my $refcolumn = shift;
412
413     my $refstatements = shift;
414     my $refstatements_line = shift;
415     my $refstatements_column = shift;
416
417     local $_ = $$refcurrent;
418     my $line = $$refline;
419     my $column = $$refcolumn;
420
421     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
422
423     my $statements;
424     if(s/^\{//) {
425         $column++;
426         $statements = "";
427     } else {
428         return 0;
429     }
430
431     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
432
433     my $statements_line = $line;
434     my $statements_column = $column;
435
436     my $plevel = 1;
437     while($plevel > 0) {
438         my $match;
439         $self->_parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
440
441         $column++;
442
443         $statements .= $match;
444         if(s/^\}//) {
445             $plevel--;
446             if($plevel > 0) {
447                 $statements .= "}";
448             }
449         } elsif(s/^\{//) {
450             $plevel++;
451             $statements .= "{";
452         } else {
453             return 0;
454         }
455     }
456
457     $$refcurrent = $_;
458     $$refline = $line;
459     $$refcolumn = $column;
460     $$refstatements = $statements;
461     $$refstatements_line = $statements_line;
462     $$refstatements_column = $statements_column;
463
464     return 1;
465 }
466
467 ########################################################################
468 # parse_c_declaration
469
470 sub parse_c_declaration {
471     my $self = shift;
472
473     my $found_declaration = \${$self->{FOUND_DECLARATION}};
474     my $found_function = \${$self->{FOUND_FUNCTION}};
475
476     my $refcurrent = shift;
477     my $refline = shift;
478     my $refcolumn = shift;
479
480     local $_ = $$refcurrent;
481     my $line = $$refline;
482     my $column = $$refcolumn;
483
484     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
485
486     my $begin_line = $line;
487     my $begin_column = $column + 1;
488
489     my $end_line = $begin_line;
490     my $end_column = $begin_column;
491     $self->_update_c_position($_, \$end_line, \$end_column);
492
493     if(!&$$found_declaration($begin_line, $begin_column, $end_line, $end_column, $_)) {
494         return 1;
495     }
496
497     # Function
498     my $function = shift;
499
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;
507
508     # Variable
509     my $type;
510
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++;
520         }
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))
532         {
533             my $statements = $function->statements;
534             my $statements_line = $function->statements_line;
535             my $statements_column = $function->statements_column;
536
537             if(defined($statements)) {
538                 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
539                     return 0;
540                 }
541             }
542         }
543     } else {
544         $self->_parse_c_error($_, $line, $column, "declaration");
545     }
546
547     $$refcurrent = $_;
548     $$refline = $line;
549     $$refcolumn = $column;
550
551     return 1;
552 }
553
554 ########################################################################
555 # parse_c_declarations
556
557 sub parse_c_declarations {
558     my $self = shift;
559
560     my $refcurrent = shift;
561     my $refline = shift;
562     my $refcolumn = shift;
563
564     return 1;
565 }
566
567 ########################################################################
568 # parse_c_expression
569
570 sub parse_c_expression {
571     my $self = shift;
572
573     my $refcurrent = shift;
574     my $refline = shift;
575     my $refcolumn = shift;
576
577     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
578
579     local $_ = $$refcurrent;
580     my $line = $$refline;
581     my $column = $$refcolumn;
582
583     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
584
585     while($_) {
586         if(s/^(.*?)(\w+\s*\()/$2/s) {
587             $self->_update_c_position($1, \$line, \$column);
588
589             my $begin_line = $line;
590             my $begin_column = $column + 1;
591
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;
598             }
599
600             if(&$$found_function_call($begin_line, $begin_column, $line, $column, $name, \@arguments))
601             {
602                 while(defined(my $argument = shift @arguments) &&
603                       defined(my $argument_line = shift @argument_lines) &&
604                       defined(my $argument_column = shift @argument_columns))
605                 {
606                     $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
607                 }
608             }
609         } else {
610             $_ = "";
611         }
612     }
613
614     $self->_update_c_position($_, \$line, \$column);
615
616     $$refcurrent = $_;
617     $$refline = $line;
618     $$refcolumn = $column;
619
620     return 1;
621 }
622
623 ########################################################################
624 # parse_c_file
625
626 sub parse_c_file {
627     my $self = shift;
628
629     my $found_comment = \${$self->{FOUND_COMMENT}};
630     my $found_line = \${$self->{FOUND_LINE}};
631
632     my $refcurrent = shift;
633     my $refline = shift;
634     my $refcolumn = shift;
635
636     local $_ = $$refcurrent;
637     my $line = $$refline;
638     my $column = $$refcolumn;
639
640     my $declaration = "";
641     my $declaration_line = $line;
642     my $declaration_column = $column;
643
644     my $previous_line = 0;
645     my $previous_column = -1;
646
647     my $if = 0;
648     my $if0 = 0;
649
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);
655
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");
662         }
663         $previous_line = $line;
664         $previous_column = $column;
665
666         # $output->write("file: $plevel $blevel: '$match'\n");
667
668         if(!$declaration && $match =~ s/^\s+//s) {
669             $self->_update_c_position($&, \$declaration_line, \$declaration_column);
670         }
671         if(!$if0) {
672             $declaration .= $match;
673         } else {
674             my $blank_lines = 0;
675
676             local $_ = $match;
677             while(s/^.*?\n//) { $blank_lines++; }
678
679             if(!$declaration) {
680                 $declaration_line = $line;
681                 $declaration_column = $column;
682             } else {
683                 $declaration .= "\n" x $blank_lines;
684             }
685
686         }
687
688         if(/^[\#\/]/) {
689             my $blank_lines = 0;
690             if(s/^\#\s*//) {
691                 my $preprocessor_line = $line;
692                 my $preprocessor_column = $column;
693
694                 my $preprocessor = $&;
695                 while(s/^(.*?)\\\s*\n//) {
696                     $blank_lines++;
697                     $preprocessor .= "$1\n";
698                 }
699                 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
700                     $_ = "$2\n$_";
701                     if(defined($3)) {
702                         $preprocessor .= "$1$3";
703                     } else {
704                         $preprocessor .= $1;
705                     }
706                 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
707                     if(defined($2)) {
708                         $_ = "$2\n$_";
709                     } else {
710                         $blank_lines++;
711                     }
712                     $preprocessor .= $1;
713                 }
714
715                 if($if0 && $preprocessor =~ /^\#\s*endif/) {
716                     if($if0 > 0) {
717                         if($if > 0) {
718                             $if--;
719                         } else {
720                             $if0--;
721                         }
722                     }
723                 } elsif($preprocessor =~ /^\#\s*if/) {
724                     if($preprocessor =~ /^\#\s*if\s*0/) {
725                         $if0++;
726                     } elsif($if0 > 0) {
727                         $if++;
728                     }
729                 }
730
731                 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
732                      return 0;
733                 }
734             }
735
736             if(s/^\/\*.*?\*\///s) {
737                 &$$found_comment($line, $column + 1, $&);
738                 local $_ = $&;
739                 while(s/^.*?\n//) {
740                     $blank_lines++;
741                 }
742                 if($_) {
743                     $column += length($_);
744                 }
745             } elsif(s/^\/\/(.*?)\n//) {
746                 &$$found_comment($line, $column + 1, $&);
747                 $blank_lines++;
748             } elsif(s/^\///) {
749                 if(!$if0) {
750                     $declaration .= $&;
751                     $column++;
752                 }
753             }
754
755             $line += $blank_lines;
756             if($blank_lines > 0) {
757                 $column = 0;
758             }
759
760             if(!$declaration) {
761                 $declaration_line = $line;
762                 $declaration_column = $column;
763             } elsif($blank_lines > 0) {
764                 $declaration .= "\n" x $blank_lines;
765             }
766
767             next;
768         }
769
770         $column++;
771
772         if($if0) {
773             s/^.//;
774             next;
775         }
776
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;
789                 }
790                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
791                 $declaration = "";
792                 $declaration_line = $line;
793                 $declaration_column = $column;
794             }
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)
803             {
804                 # Nothing
805             } elsif($plevel == 1 && $blevel == 1) {
806                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
807                     return 0;
808                 }
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");
815             }
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
823             {
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;
829                 }
830                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
831                 $declaration = "";
832                 $declaration_line = $line;
833                 $declaration_column = $column;
834             }
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'");
840         }
841     }
842
843     $$refcurrent = $_;
844     $$refline = $line;
845     $$refcolumn = $column;
846
847     return 1;
848 }
849
850 ########################################################################
851 # parse_c_function
852
853 sub parse_c_function {
854     my $self = shift;
855
856     my $file = \${$self->{FILE}};
857     my $create_function = \${$self->{CREATE_FUNCTION}};
858
859     my $refcurrent = shift;
860     my $refline = shift;
861     my $refcolumn = shift;
862
863     my $reffunction = shift;
864
865     local $_ = $$refcurrent;
866     my $line = $$refline;
867     my $column = $$refcolumn;
868
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;
879
880     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
881
882     my $begin_line = $line;
883     my $begin_column = $column + 1;
884
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))
890     {
891         if($match =~ /^extern|static$/) {
892             if(!$linkage) {
893                 $linkage = $match;
894             }
895         }
896     }
897
898
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;
908         }
909
910         $self->_parse_c("__cdecl|__stdcall|inline|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK|WINE_UNUSED|PASCAL",
911                         \$_, \$line, \$column, \$calling_convention);
912
913         if(!$self->_parse_c('\w+', \$_, \$line, \$column, \$name)) {
914             return 0;
915         }
916
917         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
918             return 0;
919         }
920     }
921
922     my $kar;
923     # FIXME: Implement proper handling of K&R C functions
924     $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
925
926     if($kar) {
927         $output->write("K&R: $kar\n");
928     }
929
930     if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
931         return 0;
932     }
933
934     my $end_line = $line;
935     my $end_column = $column;
936
937     $$refcurrent = $_;
938     $$refline = $line;
939     $$refcolumn = $column;
940
941     my $function = &$$create_function;
942
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]);
954     # }
955     # if(defined($argument_names)) {
956     #     $function->argument_names([@$argument_names]);
957     # }
958     $function->statements_line($statements_line);
959     $function->statements_column($statements_column);
960     $function->statements($statements);
961
962     $$reffunction = $function;
963
964     return 1;
965 }
966
967 ########################################################################
968 # parse_c_function_call
969
970 sub parse_c_function_call {
971     my $self = shift;
972
973     my $refcurrent = shift;
974     my $refline = shift;
975     my $refcolumn = shift;
976
977     my $refname = shift;
978     my $refarguments = shift;
979     my $refargument_lines = shift;
980     my $refargument_columns = shift;
981
982     local $_ = $$refcurrent;
983     my $line = $$refline;
984     my $column = $$refcolumn;
985
986     my $name;
987     my @arguments;
988     my @argument_lines;
989     my @argument_columns;
990
991     if(s/^(\w+)(\s*)(?=\()//s) {
992         $self->_update_c_position($&, \$line, \$column);
993
994         $name = $1;
995
996         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
997             return 0;
998         }
999     } else {
1000         return 0;
1001     }
1002
1003     $$refcurrent = $_;
1004     $$refline = $line;
1005     $$refcolumn = $column;
1006
1007     $$refname = $name;
1008     @$refarguments = @arguments;
1009     @$refargument_lines = @argument_lines;
1010     @$refargument_columns = @argument_columns;
1011
1012     return 1;
1013 }
1014
1015 ########################################################################
1016 # parse_c_preprocessor
1017
1018 sub parse_c_preprocessor {
1019     my $self = shift;
1020
1021     my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
1022
1023     my $refcurrent = shift;
1024     my $refline = shift;
1025     my $refcolumn = shift;
1026
1027     local $_ = $$refcurrent;
1028     my $line = $$refline;
1029     my $column = $$refcolumn;
1030
1031     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1032
1033     my $begin_line = $line;
1034     my $begin_column = $column + 1;
1035
1036     if(!&$$found_preprocessor($begin_line, $begin_column, "$_")) {
1037         return 1;
1038     }
1039
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");
1056     }
1057
1058     $$refcurrent = $_;
1059     $$refline = $line;
1060     $$refcolumn = $column;
1061
1062     return 1;
1063 }
1064
1065 ########################################################################
1066 # parse_c_statement
1067
1068 sub parse_c_statement {
1069     my $self = shift;
1070
1071     my $refcurrent = shift;
1072     my $refline = shift;
1073     my $refcolumn = shift;
1074
1075     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1076
1077     local $_ = $$refcurrent;
1078     my $line = $$refline;
1079     my $column = $$refcolumn;
1080
1081     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1082
1083     $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1084
1085     # $output->write("$line.$column: statement: '$_'\n");
1086
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;
1095         }
1096         if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1097             return 0;
1098         }
1099     } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1100         $self->_update_c_position($&, \$line, \$column);
1101
1102         my $name = $1;
1103
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;
1109         }
1110
1111         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1112         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1113             return 0;
1114         }
1115         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1116
1117         while(defined(my $argument = shift @arguments) &&
1118               defined(my $argument_line = shift @argument_lines) &&
1119               defined(my $argument_column = shift @argument_columns))
1120         {
1121             $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1122         }
1123     } elsif(s/^else//) {
1124         $self->_update_c_position($&, \$line, \$column);
1125         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1126             return 0;
1127         }
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;
1133         }
1134     } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1135         # Nothing
1136     } else {
1137         # $self->_parse_c_error($_, $line, $column, "statement");
1138     }
1139
1140     $self->_update_c_position($_, \$line, \$column);
1141
1142     $$refcurrent = $_;
1143     $$refline = $line;
1144     $$refcolumn = $column;
1145
1146     return 1;
1147 }
1148
1149 ########################################################################
1150 # parse_c_statements
1151
1152 sub parse_c_statements {
1153     my $self = shift;
1154
1155     my $refcurrent = shift;
1156     my $refline = shift;
1157     my $refcolumn = shift;
1158
1159     my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
1160
1161     local $_ = $$refcurrent;
1162     my $line = $$refline;
1163     my $column = $$refcolumn;
1164
1165     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1166
1167     # $output->write("$line.$column: statements: '$_'\n");
1168
1169     my $statement = "";
1170     my $statement_line = $line;
1171     my $statement_column = $column;
1172
1173     my $previous_line = -1;
1174     my $previous_column = -1;
1175
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);
1181
1182         if($previous_line == $line && $previous_column == $column) {
1183             $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1184         }
1185         $previous_line = $line;
1186         $previous_column = $column;
1187
1188         # $output->write("'$match' '$_'\n");
1189
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");
1199             }
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;
1210                 }
1211                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1212                 $statement = "";
1213                 $statement_line = $line;
1214                 $statement_column = $column;
1215             }
1216         } elsif(s/^;//) {
1217             if($plevel == 1 && $blevel == 1) {
1218                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1219                     return 0;
1220                 }
1221
1222                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1223                 $statement = "";
1224                 $statement_line = $line;
1225                 $statement_column = $column;
1226             } else {
1227                 $statement .= $&;
1228             }
1229         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1230             $plevel = 0;
1231             $blevel = 0;
1232         } else {
1233             $self->_parse_c_error($_, $line, $column, "statements");
1234         }
1235     }
1236
1237     $self->_update_c_position($_, \$line, \$column);
1238
1239     $$refcurrent = $_;
1240     $$refline = $line;
1241     $$refcolumn = $column;
1242
1243     return 1;
1244 }
1245
1246 ########################################################################
1247 # parse_c_tuple
1248
1249 sub parse_c_tuple {
1250     my $self = shift;
1251
1252     my $refcurrent = shift;
1253     my $refline = shift;
1254     my $refcolumn = shift;
1255
1256     # FIXME: Should not write directly
1257     my $items = shift;
1258     my $item_lines = shift;
1259     my $item_columns = shift;
1260
1261     local $_ = $$refcurrent;
1262
1263     my $line = $$refline;
1264     my $column = $$refcolumn;
1265
1266     my $item;
1267     if(s/^\(//) {
1268         $column++;
1269         $item = "";
1270     } else {
1271         return 0;
1272     }
1273
1274     my $item_line = $line;
1275     my $item_column = $column + 1;
1276
1277     my $plevel = 1;
1278     while($plevel > 0) {
1279         my $match;
1280         $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1281
1282         $column++;
1283
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 .= ")";
1294             }
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 .= ",";
1309             }
1310         } else {
1311             return 0;
1312         }
1313     }
1314
1315     $$refcurrent = $_;
1316     $$refline = $line;
1317     $$refcolumn = $column;
1318
1319     return 1;
1320 }
1321
1322 ########################################################################
1323 # parse_c_type
1324
1325 sub parse_c_type {
1326     my $self = shift;
1327
1328     my $refcurrent = shift;
1329     my $refline = shift;
1330     my $refcolumn = shift;
1331
1332     my $reftype = shift;
1333
1334     local $_ = $$refcurrent;
1335     my $line = $$refline;
1336     my $column = $$refcolumn;
1337
1338     my $type;
1339
1340     $self->_parse_c("const", \$_, \$line, \$column);
1341
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;
1350     }
1351     $type =~ s/\s//g;
1352
1353     $$refcurrent = $_;
1354     $$refline = $line;
1355     $$refcolumn = $column;
1356
1357     $$reftype = $type;
1358
1359     return 1;
1360 }
1361
1362 ########################################################################
1363 # parse_c_typedef
1364
1365 sub parse_c_typedef {
1366     my $self = shift;
1367
1368     my $refcurrent = shift;
1369     my $refline = shift;
1370     my $refcolumn = shift;
1371
1372     my $reftype = shift;
1373
1374     local $_ = $$refcurrent;
1375     my $line = $$refline;
1376     my $column = $$refcolumn;
1377
1378     my $type;
1379
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;
1386     }
1387
1388     $$refcurrent = $_;
1389     $$refline = $line;
1390     $$refcolumn = $column;
1391
1392     $$reftype = $type;
1393
1394     return 1;
1395 }
1396
1397 ########################################################################
1398 # parse_c_variable
1399
1400 sub parse_c_variable {
1401     my $self = shift;
1402
1403     my $found_variable = \${$self->{FOUND_VARIABLE}};
1404
1405     my $refcurrent = shift;
1406     my $refline = shift;
1407     my $refcolumn = shift;
1408
1409     my $reflinkage = shift;
1410     my $reftype = shift;
1411     my $refname = shift;
1412
1413     local $_ = $$refcurrent;
1414     my $line = $$refline;
1415     my $column = $$refcolumn;
1416
1417     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1418
1419     my $begin_line = $line;
1420     my $begin_column = $column + 1;
1421
1422     my $linkage = "";
1423     my $type = "";
1424     my $name = "";
1425
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))
1431     {
1432         if($match =~ /^extern|static$/) {
1433             if(!$linkage) {
1434                 $linkage = $match;
1435             }
1436         }
1437     }
1438
1439     my $finished = 0;
1440
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))
1451     {
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);
1459
1460         if(defined($1)) {
1461             $type = "struct $1 { }";
1462         } else {
1463             $type = "struct { }";
1464         }
1465         if(defined($2)) {
1466             my $stars = $2;
1467             $stars =~ s/\s//g;
1468             if($stars) {
1469                 $type .= " $type";
1470             }
1471         }
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;
1477     }
1478
1479     # $output->write("$type: '$_'\n");
1480
1481     if($finished) {
1482         # Nothing
1483     } elsif(s/^WINAPI\s*//) {
1484         $self->_update_c_position($&, \$line, \$column);
1485     }
1486
1487     if($finished) {
1488         # Nothing
1489     } elsif(s/^(\((?:__cdecl)?\s*\*?\s*(?:__cdecl)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
1490         $self->_update_c_position($&, \$line, \$column);
1491
1492         $name = $1;
1493         $name =~ s/\s//g;
1494
1495         $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
1496         if(s/^\)//) { $column++; }
1497         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1498
1499         if(!s/^(?:=\s*|,\s*|$)//) {
1500             return 0;
1501         }
1502     } elsif(s/^(?:\*\s*)*(?:const\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
1503         $self->_update_c_position($&, \$line, \$column);
1504
1505         $name = $1;
1506         $name =~ s/\s//g;
1507     } elsif(/^$/) {
1508         $name = "";
1509     } else {
1510         return 0;
1511     }
1512
1513     # $output->write("$type: $name: '$_'\n");
1514
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)
1524     {
1525         $self->_update_c_position($&, \$line, \$column);
1526
1527         $type = $1;
1528         $name = $2;
1529
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);
1534
1535         if(defined($1)) {
1536             $type = "struct $1 { }";
1537         } else {
1538             $type = "struct { }";
1539         }
1540         my $stars = $2;
1541         $stars =~ s/\s//g;
1542         if($stars) {
1543             $type .= " $type";
1544         }
1545
1546         $name = $3;
1547     } else {
1548         return 0;
1549     }
1550
1551     if(!$name) {
1552         $name = "<name>";
1553     }
1554
1555     $$refcurrent = $_;
1556     $$refline = $line;
1557     $$refcolumn = $column;
1558
1559     $$reflinkage = $linkage;
1560     $$reftype = $type;
1561     $$refname = $name;
1562
1563     if(&$$found_variable($begin_line, $begin_column, $linkage, $type, $name))
1564     {
1565         # Nothing
1566     }
1567
1568     return 1;
1569 }
1570
1571 1;