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+))((__cdecl|__stdcall|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?(\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/s) {
 195             $_ = $'; $again = 1;
 196
 197             if($11 eq "{")  {
 198                 $level++;
 199             }
 200
 201             my $linkage = $1;
 202             my $return_type = $2;
 203             my $calling_convention = $7;
 204             my $name = $8;
 205             my $arguments = $10;
 206
 207             if(!defined($linkage)) {
 208                 $linkage = "";
 209             }
 210
 211             if(!defined($calling_convention)) {
 212                 $calling_convention = "";
 213             }
 214
 215             $linkage =~ s/\s*$//;
 216
 217             $return_type =~ s/\s*$//;
 218             $return_type =~ s/\s*\*\s*/*/g;
 219             $return_type =~ s/(\*+)/ $1/g;
 220
 221             if($regs_entrypoints{$name}) {
 222                 $name = $regs_entrypoints{$name};
 223             }
 224
 225             $arguments =~ y/\t\n/  /;
 226             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 227             if($arguments eq "") { $arguments = "void" }
 228
 229             my @argument_types;
 230             my @argument_names;
 231             my @arguments = split(/,/, $arguments);
 232             foreach my $n (0..$#arguments) {
 233                 my $argument_type = "";
 234                 my $argument_name = "";
 235                 my $argument = $arguments[$n];
 236                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 237                 # print "  " . ($n + 1) . ": '$argument'\n";
 238                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
 239                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|\s*)\s*//;
 240                 if($argument =~ /^\.\.\.$/) {
 241                     $argument_type = "...";
 242                     $argument_name = "...";
 243                 } 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)?/) {
 244                     $argument_type = "$1";
 245                     if($2 ne "") {
 246                         $argument_type .= " $2";
 247                     }
 248                     $argument_name = $3;
 249
 250                     $argument_type =~ s/\s*const\s*/ /;
 251                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
 252
 253                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
 254                 } else {
 255                     die "$file: $.: syntax error: '$argument'\n";
 256                 }
 257                 $argument_types[$n] = $argument_type;
 258                 $argument_names[$n] = $argument_name;
 259                 # print "  " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
 260             }
 261             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
 262                 $#argument_types = -1;
 263                 $#argument_names = -1;
 264             }
 265
 266             if($options->debug) {
 267                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
 268             }
 269
 270             &$function_begin($documentation,$linkage,$return_type,$calling_convention,$name,\@argument_types,\@argument_names);
 271             if($level == 0) {
 272                 &$function_end;
 273             }
 274         } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 275             $_ = $'; $again = 1;
 276             my @arguments = ("HDC16");
 277             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
 278             &$function_end;
 279         } elsif(/DC_(GET_VAL_32)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
 280             $_ = $'; $again = 1;
 281             my @arguments = ("HDC");
 282             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
 283             &$function_end;
 284         } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 285             $_ = $'; $again = 1;
 286             my @arguments16 = ("HDC16", "LP" . $5 . "16");
 287             my @arguments32 = ("HDC", "LP" . $5);
 288             &$function_begin($documentation, "", "BOOL16", "WINAPI", $2 . "16", \@arguments16);
 289             &$function_end;
 290             &$function_begin($documentation, "", "BOOL", "WINAPI", $2, \@arguments32);
 291             &$function_end;
 292         } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 293             $_ = $'; $again = 1;
 294             my @arguments16 = ("HDC16", "INT16");
 295             my @arguments32 = ("HDC", "INT");
 296             &$function_begin($documentation, "", "INT16", "WINAPI", $2 . "16", \@arguments16);
 297             &$function_end;
 298             &$function_begin($documentation, "", "INT", "WINAPI", $2, \@arguments32);
 299             &$function_end;
 300         } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 301             $_ = $'; $again = 1;
 302             my @arguments16 = ("HWAVEIN16");
 303             my @arguments32 = ("HWAVEIN");
 304             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
 305             &$function_end;
 306             &$function_begin($documentation, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
 307             &$function_end;
 308         } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 309             $_ = $'; $again = 1;
 310             my @arguments16 = ("HWAVEOUT16");
 311             my @arguments32 = ("HWAVEOUT");
 312             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
 313             &$function_end;
 314             &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
 315             &$function_end;
 316         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 317             $_ = $'; $again = 1;
 318             if($1 eq "1") {
 319                 my @arguments16 = ("HWAVEOUT16", $4);
 320                 my @arguments32 = ("HWAVEOUT", $4);
 321                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
 322                 &$function_end;
 323                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 324                 &$function_end;
 325             } elsif($1 eq 2) {
 326                 my @arguments16 = ("UINT16", $4);
 327                 my @arguments32 = ("UINT", $4);
 328                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
 329                 &$function_end;
 330                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 331                 &$function_end;
 332             }
 333         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
 334             $_ = $'; $again = 1;
 335             $regs_entrypoints{$2} = $1;
 336         } elsif(/\'[^\']*\'/s) {
 337             $_ = $'; $again = 1;
 338         } elsif(/\"[^\"]*\"/s) {
 339             $_ = $'; $again = 1;
 340         } elsif(/;/s) {
 341             $_ = $'; $again = 1;
 342         } elsif(/extern\s+"C"\s+{/s) {
 343             $_ = $'; $again = 1;
 344         } elsif(/\{/s) {
 345             $_ = $'; $again = 1;
 346             print "+1: $_\n" if $options->debug >= 2;
 347             $level++;
 348         } else {
 349             $lookahead = 1;
 350         }
 351     }
 352     close(IN);
 353     print STDERR "done\n" if $options->verbose;
 354     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
 355 }
 356
 357 1;