Made a new improved version of winapi-check in perl.
[wine] / tools / winapi_check / winapi_parser.pm
1 package winapi_parser;
2
3 use strict;
4
5 sub parse_c_file {
6     my $options = shift;
7     my $file = shift;
8     my $function_found_callback = shift;
9
10     my $level = 0;
11     my $again = 0;
12     my $lookahead = 0;
13     my $lookahead_count = 0;
14
15     print STDERR "Processing file '$file' ... " if $options->verbose;
16     open(IN, "< $file") || die "<internal>: $file: $!\n";
17     $/ = "\n";
18     while($again || defined(my $line = <IN>)) {
19         if(!$again) {
20             chomp $line;
21
22             if($lookahead) {
23                 $lookahead = 0;
24                 $_ .= "\n" . $line;
25             } else {
26                 $_ = $line;
27                 $lookahead_count = 0;
28             }
29             $lookahead_count++;
30             print "$level: $line\n" if $options->debug >= 2;
31         } else {
32             $lookahead_count = 0;
33             $again = 0;
34         }
35        
36         # remove comments
37         if(s/^(.*?)\/\*.*?\*\/(.*)$/$1 $2/s) { $again = 1; next };
38         if(/^(.*?)\/\*/s) {
39             $lookahead = 1;
40             next;
41         }
42
43         # remove empty rows
44         if(/^\s*$/) { next; }
45
46         # remove preprocessor directives
47         if(s/^\s*\#.*$//m) { $again = 1; next; }
48
49         if($level > 0)
50         {
51             s/^[^\{\}]*//s;
52             if(/^\{/) {
53                 $_ = $'; $again = 1;
54                 print "+1: $_\n" if $options->debug >= 2;
55                 $level++;
56             } elsif(/^\}/) {
57                 $_ = $'; $again = 1;
58                 print "-1: $_\n" if $options->debug >= 2; 
59                 $level--;
60             }
61             next;
62         } elsif(/((struct\s+|union\s+|enum\s+)?\w+((\s*\*)+\s*|\s+))(__cdecl|__stdcall|VFWAPIV|VFWAPI|WINAPIV|WINAPI)\s+(\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/s) {
63             $_ = $'; $again = 1;
64
65             if($9 eq ";") {
66                 next;
67             } elsif($9 eq "{")  {               
68                 $level++;
69             }
70
71             my $return_type = $1;
72             my $calling_convention = $5;
73             my $name = $6;
74             my $arguments = $8;
75
76             $return_type =~ s/\s*$//;
77             $return_type =~ s/\s*\*\s*/*/g;
78             $return_type =~ s/(\*+)/ $1/g;
79
80             $name =~ s/^REGS_FUNC\((.*?)\)/$1/;
81
82             $arguments =~ y/\t\n/  /;
83             $arguments =~ s/^\s*(.*?)\s*$/$1/;
84             if($arguments eq "") { $arguments = "void" }
85             
86             my @arguments = split(/,/, $arguments);
87             foreach my $n (0..$#arguments) {
88                 my $argument = $arguments[$n];
89                 $argument =~ s/^\s*(.*?)\s*$/$1/;
90                 #print "  " . ($n + 1) . ": '$argument'\n";
91                 $argument =~ s/^(const(?=\s)|IN(?=\s)|OUT(?=\s)|(\s*))\s*//;
92                 if($argument =~ /^...$/) {
93                     $argument = "...";
94                 } elsif($argument =~ /^((struct\s+|union\s+|enum\s+)?\w+)\s*((\*\s*?)*)\s*/) {
95                     $argument = "$1";
96                     if($3 ne "") {
97                         $argument .= " $3";
98                     }
99                 } else {
100                     die "$file: $.: syntax error: '$argument'\n";
101                 }
102                 $arguments[$n] = $argument;
103                 #print "  " . ($n + 1) . ": '" . $arguments[$n] . "'\n";
104             }
105             if($#arguments == 0 && $arguments[0] =~ /^void$/i) { $#arguments = -1;  } 
106
107             if($options->debug) {
108                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
109             }
110             &$function_found_callback($return_type,$calling_convention,$name,\@arguments);
111
112         } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
113             $_ = $'; $again = 1;
114             my @arguments = ("HDC16");
115             &$function_found_callback($2, "WINAPI", $3, \@arguments);
116         } elsif(/DC_(GET_VAL_32)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
117             $_ = $'; $again = 1;
118             my @arguments = ("HDC");
119             &$function_found_callback($2, "WINAPI", $3, \@arguments);
120         } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
121             $_ = $'; $again = 1;
122             my @arguments16 = ("HDC16", "LP" . $5 . "16");
123             my @arguments32 = ("HDC", "LP" . $5);
124             &$function_found_callback("BOOL16", "WINAPI", $2 . "16", \@arguments16);
125             &$function_found_callback("BOOL", "WINAPI", $2, \@arguments32);
126         } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
127             $_ = $'; $again = 1;
128             my @arguments16 = ("HDC16", "INT16");
129             my @arguments32 = ("HDC", "INT");
130             &$function_found_callback("INT16", "WINAPI", $2 . "16", \@arguments16);
131             &$function_found_callback("INT", "WINAPI", $2, \@arguments32);
132         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
133             $_ = $'; $again = 1;
134             print "$_";
135             if($1 eq "1") {
136                 my @arguments16 = ("HWAVEOUT16", $4);
137                 my @arguments32 = ("HWAVEOUT", $4);
138                 &$function_found_callback("UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
139                 &$function_found_callback("UINT", "WINAPI", "waveOut" . $2, \@arguments32);
140             } elsif($1 eq 2) {
141                 my @arguments16 = ("UINT16", $4);
142                 my @arguments32 = ("UINT", $4);
143                 &$function_found_callback("UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
144                 &$function_found_callback("UINT", "WINAPI", "waveOut" . $2, \@arguments32)
145             }
146         } elsif(/;/s) {
147             $_ = $'; $again = 1;
148         } elsif(/\{/s) {
149             $_ = $'; $again = 1;
150             print "+1: $_\n" if $options->debug >= 2;
151             $level++;
152         } else {
153             $lookahead = 1;
154         }
155     }
156     close(IN);
157     print STDERR "done\n" if $options->verbose;
158     print "$file: <>: not at toplevel at end of file\n" unless $level == 0;
159 }
160
161 1;