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