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