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