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