git.oblomov.eu Git - wine/blob - 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 $output = shift;
   8     my $file = shift;
   9     my $function_found_callback = shift;
  10     my $preprocessor_found_callback = shift;
  11
  12     my $documentation;
  13     my $return_type;
  14     my $calling_convention;
  15     my $function = "";
  16     my $arguments;
  17     my $statements;
  18
  19     my $function_begin = sub {
  20         $documentation = shift;
  21         $return_type= shift;
  22         $calling_convention = shift;
  23         $function = shift;
  24         $arguments = shift;
  25
  26         $statements = "";
  27     };
  28     my $function_end = sub {
  29         &$function_found_callback($documentation,$return_type,$calling_convention,$function,$arguments,$statements);
  30
  31         $function = "";
  32     };
  33
  34     my @comments = ();
  35     my $level = 0;
  36     my $again = 0;
  37     my $lookahead = 0;
  38     my $lookahead_count = 0;
  39
  40     print STDERR "Processing file '$file' ... " if $options->verbose;
  41     open(IN, "< $file") || die "<internal>: $file: $!\n";
  42     $/ = "\n";
  43     while($again || defined(my $line = <IN>)) {
  44         if(!$again) {
  45             chomp $line;
  46
  47             if($lookahead) {
  48                 $lookahead = 0;
  49                 $_ .= "\n" . $line;
  50             } else {
  51                 $_ = $line;
  52                 $lookahead_count = 0;
  53             }
  54             $lookahead_count++;
  55             print "$level: $line\n" if $options->debug >= 2;
  56         } else {
  57             $lookahead_count = 0;
  58             $again = 0;
  59         }
  60
  61         # Merge conflicts in file?
  62         if(/^(<<<<<<<|=======|>>>>>>>)/) {
  63             $output->write("$file: merge conflicts in file\n");
  64             last;
  65         }
  66
  67         # remove comments
  68         if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) { push @comments, $2; $again = 1; next };
  69         if(/^(.*?)\/\*/s) {
  70             $lookahead = 1;
  71             next;
  72         }
  73
  74         # remove empty rows
  75         if(/^\s*$/) { next; }
  76
  77         # remove preprocessor directives
  78         if(s/^\s*\#/\#/m) {
  79             if(/^\\#.*?\\$/m) {
  80                 $lookahead = 1;
  81                 next;
  82             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
  83                 if(defined($3)) {
  84                     &$preprocessor_found_callback($1, $3);
  85                 } else {
  86                     &$preprocessor_found_callback($1, "");
  87                 }
  88                 $again = 1;
  89                 next;
  90             }
  91         }
  92
  93         my $documentation;
  94         {
  95             my $n = $#comments;
  96             while($n >= 0 && $comments[$n] !~ /\/\*\*/) { $n-- }
  97             if(defined($comments[$n]) && $n >= 0) {
  98                 $documentation = $comments[$n];
  99             } else {
 100                 $documentation = "";
 101             }
 102         }
 103
 104         if($level > 0)
 105         {
 106             my $line;
 107             s/^([^\{\}]*)//s;
 108             $line = $1;
 109             if(/^(\{)/) {
 110                 $_ = $'; $again = 1;
 111                 $line .= $1;
 112                 print "+1: $_\n" if $options->debug >= 2;
 113                 $level++;
 114             } elsif(/^(\})/) {
 115                 $_ = $'; $again = 1;
 116                 $line .= $1 if $level > 1;
 117                 print "-1: $_\n" if $options->debug >= 2;
 118                 $level--;
 119             }
 120             if($line !~ /^\s*$/) {
 121                 $statements .= "$line\n";
 122             }
 123             if($function && $level == 0) {
 124                 &$function_end;
 125             }
 126             next;
 127         } elsif(/((struct\s+|union\s+|enum\s+)?\w+((\s*\*)+\s*|\s+))((__cdecl|__stdcall|VFWAPIV|VFWAPI|WINAPIV|WINAPI)\s+)?(\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/s) {
 128             $_ = $'; $again = 1;
 129
 130             if($10 eq ";") {
 131                 next;
 132             } elsif($10 eq "{")  {
 133                 $level++;
 134             }
 135
 136             my $return_type = $1;
 137             my $calling_convention = $6;
 138             my $name = $7;
 139             my $arguments = $9;
 140
 141             if(!defined($calling_convention)) {
 142                 $calling_convention = "";
 143             }
 144
 145             $return_type =~ s/\s*$//;
 146             $return_type =~ s/\s*\*\s*/*/g;
 147             $return_type =~ s/(\*+)/ $1/g;
 148
 149             $name =~ s/^REGS_FUNC\((.*?)\)/$1/;
 150
 151             $arguments =~ y/\t\n/  /;
 152             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 153             if($arguments eq "") { $arguments = "void" }
 154
 155             my @arguments = split(/,/, $arguments);
 156             foreach my $n (0..$#arguments) {
 157                 my $argument = $arguments[$n];
 158                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 159                 #print "  " . ($n + 1) . ": '$argument'\n";
 160                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
 161                 $argument =~ s/^(const(?=\s)|\s*)\s*//;
 162                 if($argument =~ /^...$/) {
 163                     $argument = "...";
 164                 } elsif($argument =~ /^((struct\s+|union\s+|enum\s+)?\w+)\s*((\*\s*?)*)\s*/) {
 165                     $argument = "$1";
 166                     if($3 ne "") {
 167                         $argument .= " $3";
 168                     }
 169                 } else {
 170                     die "$file: $.: syntax error: '$argument'\n";
 171                 }
 172                 $arguments[$n] = $argument;
 173                 #print "  " . ($n + 1) . ": '" . $arguments[$n] . "'\n";
 174             }
 175             if($#arguments == 0 && $arguments[0] =~ /^void$/i) { $#arguments = -1;  }
 176
 177             if($options->debug) {
 178                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
 179             }
 180             &$function_begin($documentation,$return_type,$calling_convention,$name,\@arguments);
 181
 182         } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 183             $_ = $'; $again = 1;
 184             my @arguments = ("HDC16");
 185             &$function_begin($documentation,$2, "WINAPI", $3, \@arguments);
 186             &$function_end;
 187         } elsif(/DC_(GET_VAL_32)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
 188             $_ = $'; $again = 1;
 189             my @arguments = ("HDC");
 190             &$function_begin($documentation,$2, "WINAPI", $3, \@arguments);
 191             &$function_end;
 192         } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 193             $_ = $'; $again = 1;
 194             my @arguments16 = ("HDC16", "LP" . $5 . "16");
 195             my @arguments32 = ("HDC", "LP" . $5);
 196             &$function_begin($documentation,"BOOL16", "WINAPI", $2 . "16", \@arguments16);
 197             &$function_end;
 198             &$function_begin($documentation,"BOOL", "WINAPI", $2, \@arguments32);
 199             &$function_end;
 200         } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 201             $_ = $'; $again = 1;
 202             my @arguments16 = ("HDC16", "INT16");
 203             my @arguments32 = ("HDC", "INT");
 204             &$function_begin($documentation,"INT16", "WINAPI", $2 . "16", \@arguments16);
 205             &$function_end;
 206             &$function_begin($documentation,"INT", "WINAPI", $2, \@arguments32);
 207             &$function_end;
 208         } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 209             $_ = $'; $again = 1;
 210             my @arguments16 = ("HWAVEIN16");
 211             my @arguments32 = ("HWAVEIN");
 212             &$function_begin($documentation,"UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
 213             &$function_end;
 214             &$function_begin($documentation,"UINT", "WINAPI", "waveIn" . $1, \@arguments32);
 215             &$function_end;
 216         } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 217             $_ = $'; $again = 1;
 218             my @arguments16 = ("HWAVEOUT16");
 219             my @arguments32 = ("HWAVEOUT");
 220             &$function_begin($documentation,"UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
 221             &$function_end;
 222             &$function_begin($documentation,"UINT", "WINAPI", "waveOut" . $1, \@arguments32);
 223             &$function_end;
 224         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 225             $_ = $'; $again = 1;
 226             if($1 eq "1") {
 227                 my @arguments16 = ("HWAVEOUT16", $4);
 228                 my @arguments32 = ("HWAVEOUT", $4);
 229                 &$function_begin($documentation,"UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
 230                 &$function_end;
 231                 &$function_begin($documentation,"UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 232                 &$function_end;
 233             } elsif($1 eq 2) {
 234                 my @arguments16 = ("UINT16", $4);
 235                 my @arguments32 = ("UINT", $4);
 236                 &$function_begin($documentation,"UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
 237                 &$function_end;
 238                 &$function_begin($documentation,"UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 239                 &$function_end;
 240             }
 241         } elsif(/;/s) {
 242             $_ = $'; $again = 1;
 243         } elsif(/\{/s) {
 244             $_ = $'; $again = 1;
 245             print "+1: $_\n" if $options->debug >= 2;
 246             $level++;
 247         } else {
 248             $lookahead = 1;
 249         }
 250     }
 251     close(IN);
 252     print STDERR "done\n" if $options->verbose;
 253     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
 254 }
 255
 256 1;