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 $linkage;
  14     my $return_type;
  15     my $calling_convention;
  16     my $function = "";
  17     my $argument_types;
  18     my $argument_names;
  19     my $statements;
  20
  21     my $function_begin = sub {
  22         $documentation = shift;
  23         $linkage = shift;
  24         $return_type= shift;
  25         $calling_convention = shift;
  26         $function = shift;
  27         $argument_types = shift;
  28         $argument_names = shift;
  29
  30         if($#$argument_names == -1) {
  31             foreach my $n (0..$#$argument_types) {
  32                 push @$argument_names, "";
  33             }
  34         }
  35
  36         $statements = "";
  37     };
  38     my $function_end = sub {
  39         &$function_found_callback($documentation,$linkage,$return_type,$calling_convention,
  40                                   $function,$argument_types,$argument_names,$statements);
  41         $function = "";
  42     };
  43
  44     my %regs_entrypoints;
  45     my @comments = ();
  46     my $level = 0;
  47     my $extern_c = 0;
  48     my $again = 0;
  49     my $lookahead = 0;
  50     my $lookahead_count = 0;
  51
  52     print STDERR "Processing file '$file' ... " if $options->verbose;
  53     open(IN, "< $file") || die "<internal>: $file: $!\n";
  54     $/ = "\n";
  55     while($again || defined(my $line = <IN>)) {
  56         if(!$again) {
  57             chomp $line;
  58
  59             if($lookahead) {
  60                 $lookahead = 0;
  61                 $_ .= "\n" . $line;
  62             } else {
  63                 $_ = $line;
  64                 $lookahead_count = 0;
  65             }
  66             $lookahead_count++;
  67             print " $level($lookahead_count): $line\n" if $options->debug >= 2;
  68             print "*** $_\n" if $options->debug >= 3;
  69         } else {
  70             $lookahead_count = 0;
  71             $again = 0;
  72         }
  73
  74         # Merge conflicts in file?
  75         if(/^(<<<<<<<|=======|>>>>>>>)/) {
  76             $output->write("$file: merge conflicts in file\n");
  77             last;
  78         }
  79
  80         # remove C comments
  81         if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) { push @comments, $2; $again = 1; next }
  82         if(/^(.*?)\/\*/s) {
  83             $lookahead = 1;
  84             next;
  85         }
  86
  87         # remove C++ comments
  88         while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1 }
  89         if($again) { next; }
  90
  91         # remove empty rows
  92         if(/^\s*$/) { next; }
  93
  94         # remove preprocessor directives
  95         if(s/^\s*\#/\#/m) {
  96             if(/^\\#.*?\\$/m) {
  97                 $lookahead = 1;
  98                 next;
  99             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
 100                 if(defined($3)) {
 101                     &$preprocessor_found_callback($1, $3);
 102                 } else {
 103                     &$preprocessor_found_callback($1, "");
 104                 }
 105                 next;
 106             }
 107         }
 108
 109         # Remove extern "C"
 110         if(s/^\s*extern\s+"C"\s+\{//m) {
 111             $extern_c = 1;
 112             $again = 1;
 113             next;
 114         }
 115
 116         my $documentation;
 117         {
 118             my $n = $#comments;
 119             while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ || $comments[$n] =~ /^\/\*\*+\//)) { $n-- }
 120             if(defined($comments[$n]) && $n >= 0) {
 121                 $documentation = $comments[$n];
 122             } else {
 123                 $documentation = "";
 124             }
 125         }
 126
 127         if($level > 0)
 128         {
 129             my $line = "";
 130             while(/^[^\{\}]/) {
 131                 s/^([^\{\}\'\"]*)//s;
 132                 $line .= $1;
 133                 if(s/^\'//) {
 134                     $line .= "\'";
 135                     while(/^./ && !s/^\'//) {
 136                         s/^([^\'\\]*)//s;
 137                         $line .= $1;
 138                         if(s/^\\//) {
 139                             $line .= "\\";
 140                             if(s/^(.)//s) {
 141                                 $line .= $1;
 142                                 if($1 eq "0") {
 143                                     s/^(\d{0,3})//s;
 144                                     $line .= $1;
 145                                 }
 146                             }
 147                         }
 148                     }
 149                     $line .= "\'";
 150                 } elsif(s/^\"//) {
 151                     $line .= "\"";
 152                     while(/^./ && !s/^\"//) {
 153                         s/^([^\"\\]*)//s;
 154                         $line .= $1;
 155                         if(s/^\\//) {
 156                             $line .= "\\";
 157                             if(s/^(.)//s) {
 158                                 $line .= $1;
 159                                 if($1 eq "0") {
 160                                     s/^(\d{0,3})//s;
 161                                     $line .= $1;
 162                                 }
 163                             }
 164                         }
 165                     }
 166                     $line .= "\"";
 167                 }
 168             }
 169
 170             if(s/^\{//) {
 171                 $_ = $'; $again = 1;
 172                 $line .= "{";
 173                 print "+1: \{$_\n" if $options->debug >= 2;
 174                 $level++;
 175             } elsif(s/^\}//) {
 176                 $_ = $'; $again = 1;
 177                 $line .= "}" if $level > 1;
 178                 print "-1: \}$_\n" if $options->debug >= 2;
 179                 $level--;
 180                 if($level == -1 && $extern_c) {
 181                     $extern_c = 0;
 182                     $level = 0;
 183                 }
 184             }
 185
 186             if($line !~ /^\s*$/) {
 187                 $statements .= "$line\n";
 188             }
 189
 190             if($function && $level == 0) {
 191                 &$function_end;
 192             }
 193             next;
 194         } elsif(/(extern\s+|static\s+)?((struct\s+|union\s+|enum\s+)?\w+((\s*\*)+\s*|\s+))
 195             ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
 196             (\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/sx)
 197         {
 198             $_ = $'; $again = 1;
 199
 200             if($11 eq "{")  {
 201                 $level++;
 202             }
 203
 204             my $linkage = $1;
 205             my $return_type = $2;
 206             my $calling_convention = $7;
 207             my $name = $8;
 208             my $arguments = $10;
 209
 210             if(!defined($linkage)) {
 211                 $linkage = "";
 212             }
 213
 214             if(!defined($calling_convention)) {
 215                 $calling_convention = "";
 216             }
 217
 218             $linkage =~ s/\s*$//;
 219
 220             $return_type =~ s/\s*$//;
 221             $return_type =~ s/\s*\*\s*/*/g;
 222             $return_type =~ s/(\*+)/ $1/g;
 223
 224             if($regs_entrypoints{$name}) {
 225                 $name = $regs_entrypoints{$name};
 226             }
 227
 228             $arguments =~ y/\t\n/  /;
 229             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 230             if($arguments eq "") { $arguments = "void" }
 231
 232             my @argument_types;
 233             my @argument_names;
 234             my @arguments = split(/,/, $arguments);
 235             foreach my $n (0..$#arguments) {
 236                 my $argument_type = "";
 237                 my $argument_name = "";
 238                 my $argument = $arguments[$n];
 239                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 240                 # print "  " . ($n + 1) . ": '$argument'\n";
 241                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
 242                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|\s*)\s*//;
 243                 if($argument =~ /^\.\.\.$/) {
 244                     $argument_type = "...";
 245                     $argument_name = "...";
 246                 } elsif($argument =~ /^((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)(?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*((?:const)?\s*(?:\*\s*?)*)\s*(?:WINE_UNUSED\s+)?(\w*)\s*(?:\[\]|\s+OPTIONAL)?/) {
 247                     $argument_type = "$1";
 248                     if($2 ne "") {
 249                         $argument_type .= " $2";
 250                     }
 251                     $argument_name = $3;
 252
 253                     $argument_type =~ s/\s*const\s*/ /;
 254                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
 255
 256                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
 257                 } else {
 258                     die "$file: $.: syntax error: '$argument'\n";
 259                 }
 260                 $argument_types[$n] = $argument_type;
 261                 $argument_names[$n] = $argument_name;
 262                 # print "  " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
 263             }
 264             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
 265                 $#argument_types = -1;
 266                 $#argument_names = -1;
 267             }
 268
 269             if($options->debug) {
 270                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
 271             }
 272
 273             &$function_begin($documentation,$linkage,$return_type,$calling_convention,$name,\@argument_types,\@argument_names);
 274             if($level == 0) {
 275                 &$function_end;
 276             }
 277         } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 278             $_ = $'; $again = 1;
 279             my @arguments = ("HDC16");
 280             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
 281             &$function_end;
 282         } elsif(/DC_(GET_VAL)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
 283             $_ = $'; $again = 1;
 284             my $return16 = $3 . "16";
 285             my $return32 = $3;
 286             my $name16 = $2 . "16";
 287             my $name32 = $2;
 288             my @arguments16 = ("HDC16");
 289             my @arguments32 = ("HDC");
 290
 291             if($name16 eq "COLORREF16") { $name16 = "COLORREF"; }
 292
 293             &$function_begin($documentation, "", $name16, "WINAPI", $return16, \@arguments16);
 294             &$function_end;
 295             &$function_begin($documentation, "", $name32, "WINAPI", $return32, \@arguments32);
 296             &$function_end;
 297         } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 298             $_ = $'; $again = 1;
 299             my @arguments16 = ("HDC16", "LP" . $5 . "16");
 300             my @arguments32 = ("HDC", "LP" . $5);
 301             &$function_begin($documentation, "", "BOOL16", "WINAPI", $2 . "16", \@arguments16);
 302             &$function_end;
 303             &$function_begin($documentation, "", "BOOL", "WINAPI", $2, \@arguments32);
 304             &$function_end;
 305         } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 306             $_ = $'; $again = 1;
 307             my @arguments16 = ("HDC16", "INT16");
 308             my @arguments32 = ("HDC", "INT");
 309             &$function_begin($documentation, "", "INT16", "WINAPI", $2 . "16", \@arguments16);
 310             &$function_end;
 311             &$function_begin($documentation, "", "INT", "WINAPI", $2, \@arguments32);
 312             &$function_end;
 313         } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 314             $_ = $'; $again = 1;
 315             my @arguments16 = ("HWAVEIN16");
 316             my @arguments32 = ("HWAVEIN");
 317             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
 318             &$function_end;
 319             &$function_begin($documentation, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
 320             &$function_end;
 321         } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 322             $_ = $'; $again = 1;
 323             my @arguments16 = ("HWAVEOUT16");
 324             my @arguments32 = ("HWAVEOUT");
 325             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
 326             &$function_end;
 327             &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
 328             &$function_end;
 329         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 330             $_ = $'; $again = 1;
 331             if($1 eq "1") {
 332                 my @arguments16 = ("HWAVEOUT16", $4);
 333                 my @arguments32 = ("HWAVEOUT", $4);
 334                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
 335                 &$function_end;
 336                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 337                 &$function_end;
 338             } elsif($1 eq 2) {
 339                 my @arguments16 = ("UINT16", $4);
 340                 my @arguments32 = ("UINT", $4);
 341                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
 342                 &$function_end;
 343                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 344                 &$function_end;
 345             }
 346         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
 347             $_ = $'; $again = 1;
 348             $regs_entrypoints{$2} = $1;
 349         } elsif(/\'[^\']*\'/s) {
 350             $_ = $'; $again = 1;
 351         } elsif(/\"[^\"]*\"/s) {
 352             $_ = $'; $again = 1;
 353         } elsif(/;/s) {
 354             $_ = $'; $again = 1;
 355         } elsif(/extern\s+"C"\s+{/s) {
 356             $_ = $'; $again = 1;
 357         } elsif(/\{/s) {
 358             $_ = $'; $again = 1;
 359             print "+1: $_\n" if $options->debug >= 2;
 360             $level++;
 361         } else {
 362             $lookahead = 1;
 363         }
 364     }
 365     close(IN);
 366     print STDERR "done\n" if $options->verbose;
 367     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
 368 }
 369
 370 1;