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 $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 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 empty rows
  88         if(/^\s*$/) { next; }
  89
  90         # remove preprocessor directives
  91         if(s/^\s*\#/\#/m) {
  92             if(/^\\#.*?\\$/m) {
  93                 $lookahead = 1;
  94                 next;
  95             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
  96                 if(defined($3)) {
  97                     &$preprocessor_found_callback($1, $3);
  98                 } else {
  99                     &$preprocessor_found_callback($1, "");
 100                 }
 101                 next;
 102             }
 103         }
 104
 105         # Remove extern "C"
 106         if(s/^\s*extern\s+"C"\s+\{//m) {
 107             $extern_c = 1;
 108             $again = 1;
 109             next;
 110         }
 111
 112         my $documentation;
 113         {
 114             my $n = $#comments;
 115             while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ || $comments[$n] =~ /^\/\*\*+\//)) { $n-- }
 116             if(defined($comments[$n]) && $n >= 0) {
 117                 $documentation = $comments[$n];
 118             } else {
 119                 $documentation = "";
 120             }
 121         }
 122
 123         if($level > 0)
 124         {
 125             my $line = "";
 126             while(/^[^\{\}]/) {
 127                 s/^([^\{\}\'\"]*)//s;
 128                 $line .= $1;
 129                 if(s/^\'//) {
 130                     $line .= "\'";
 131                     while(/^./ && !s/^\'//) {
 132                         s/^([^\'\\]*)//s;
 133                         $line .= $1;
 134                         if(s/^\\//) {
 135                             $line .= "\\";
 136                             if(s/^(.)//s) {
 137                                 $line .= $1;
 138                                 if($1 eq "0") {
 139                                     s/^(\d{0,3})//s;
 140                                     $line .= $1;
 141                                 }
 142                             }
 143                         }
 144                     }
 145                     $line .= "\'";
 146                 } elsif(s/^\"//) {
 147                     $line .= "\"";
 148                     while(/^./ && !s/^\"//) {
 149                         s/^([^\"\\]*)//s;
 150                         $line .= $1;
 151                         if(s/^\\//) {
 152                             $line .= "\\";
 153                             if(s/^(.)//s) {
 154                                 $line .= $1;
 155                                 if($1 eq "0") {
 156                                     s/^(\d{0,3})//s;
 157                                     $line .= $1;
 158                                 }
 159                             }
 160                         }
 161                     }
 162                     $line .= "\"";
 163                 }
 164             }
 165
 166             if(s/^\{//) {
 167                 $_ = $'; $again = 1;
 168                 $line .= "{";
 169                 print "+1: \{$_\n" if $options->debug >= 2;
 170                 $level++;
 171             } elsif(s/^\}//) {
 172                 $_ = $'; $again = 1;
 173                 $line .= "}" if $level > 1;
 174                 print "-1: \}$_\n" if $options->debug >= 2;
 175                 $level--;
 176                 if($level == -1 && $extern_c) {
 177                     $extern_c = 0;
 178                     $level = 0;
 179                 }
 180             }
 181
 182             if($line !~ /^\s*$/) {
 183                 $statements .= "$line\n";
 184             }
 185
 186             if($function && $level == 0) {
 187                 &$function_end;
 188             }
 189             next;
 190         } 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) {
 191             $_ = $'; $again = 1;
 192
 193             if($11 eq "{")  {
 194                 $level++;
 195             }
 196
 197             my $linkage = $1;
 198             my $return_type = $2;
 199             my $calling_convention = $7;
 200             my $name = $8;
 201             my $arguments = $10;
 202
 203             if(!defined($linkage)) {
 204                 $linkage = "";
 205             }
 206
 207             if(!defined($calling_convention)) {
 208                 $calling_convention = "";
 209             }
 210
 211             $linkage =~ s/\s*$//;
 212
 213             $return_type =~ s/\s*$//;
 214             $return_type =~ s/\s*\*\s*/*/g;
 215             $return_type =~ s/(\*+)/ $1/g;
 216
 217             if($regs_entrypoints{$name}) {
 218                 $name = $regs_entrypoints{$name};
 219             }
 220
 221             $arguments =~ y/\t\n/  /;
 222             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 223             if($arguments eq "") { $arguments = "void" }
 224
 225             my @argument_types;
 226             my @argument_names;
 227             my @arguments = split(/,/, $arguments);
 228             foreach my $n (0..$#arguments) {
 229                 my $argument_type = "";
 230                 my $argument_name = "";
 231                 my $argument = $arguments[$n];
 232                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 233                 # print "  " . ($n + 1) . ": '$argument'\n";
 234                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
 235                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|\s*)\s*//;
 236                 if($argument =~ /^\.\.\.$/) {
 237                     $argument_type = "...";
 238                     $argument_name = "...";
 239                 } 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)?/) {
 240                     $argument_type = "$1";
 241                     if($2 ne "") {
 242                         $argument_type .= " $2";
 243                     }
 244                     $argument_name = $3;
 245
 246                     $argument_type =~ s/\s*const\s*/ /;
 247                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
 248
 249                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
 250                 } else {
 251                     die "$file: $.: syntax error: '$argument'\n";
 252                 }
 253                 $argument_types[$n] = $argument_type;
 254                 $argument_names[$n] = $argument_name;
 255                 # print "  " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
 256             }
 257             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
 258                 $#argument_types = -1;
 259                 $#argument_names = -1;
 260             }
 261
 262             if($options->debug) {
 263                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
 264             }
 265
 266             &$function_begin($documentation,$linkage,$return_type,$calling_convention,$name,\@argument_types,\@argument_names);
 267             if($level == 0) {
 268                 &$function_end;
 269             }
 270         } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 271             $_ = $'; $again = 1;
 272             my @arguments = ("HDC16");
 273             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
 274             &$function_end;
 275         } elsif(/DC_(GET_VAL_32)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
 276             $_ = $'; $again = 1;
 277             my @arguments = ("HDC");
 278             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
 279             &$function_end;
 280         } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 281             $_ = $'; $again = 1;
 282             my @arguments16 = ("HDC16", "LP" . $5 . "16");
 283             my @arguments32 = ("HDC", "LP" . $5);
 284             &$function_begin($documentation, "", "BOOL16", "WINAPI", $2 . "16", \@arguments16);
 285             &$function_end;
 286             &$function_begin($documentation, "", "BOOL", "WINAPI", $2, \@arguments32);
 287             &$function_end;
 288         } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 289             $_ = $'; $again = 1;
 290             my @arguments16 = ("HDC16", "INT16");
 291             my @arguments32 = ("HDC", "INT");
 292             &$function_begin($documentation, "", "INT16", "WINAPI", $2 . "16", \@arguments16);
 293             &$function_end;
 294             &$function_begin($documentation, "", "INT", "WINAPI", $2, \@arguments32);
 295             &$function_end;
 296         } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 297             $_ = $'; $again = 1;
 298             my @arguments16 = ("HWAVEIN16");
 299             my @arguments32 = ("HWAVEIN");
 300             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
 301             &$function_end;
 302             &$function_begin($documentation, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
 303             &$function_end;
 304         } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 305             $_ = $'; $again = 1;
 306             my @arguments16 = ("HWAVEOUT16");
 307             my @arguments32 = ("HWAVEOUT");
 308             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
 309             &$function_end;
 310             &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
 311             &$function_end;
 312         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 313             $_ = $'; $again = 1;
 314             if($1 eq "1") {
 315                 my @arguments16 = ("HWAVEOUT16", $4);
 316                 my @arguments32 = ("HWAVEOUT", $4);
 317                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
 318                 &$function_end;
 319                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 320                 &$function_end;
 321             } elsif($1 eq 2) {
 322                 my @arguments16 = ("UINT16", $4);
 323                 my @arguments32 = ("UINT", $4);
 324                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
 325                 &$function_end;
 326                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 327                 &$function_end;
 328             }
 329         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
 330             $_ = $'; $again = 1;
 331             $regs_entrypoints{$2} = $1;
 332         } elsif(/\'[^\']*\'/s) {
 333             $_ = $'; $again = 1;
 334         } elsif(/\"[^\"]*\"/s) {
 335             $_ = $'; $again = 1;
 336         } elsif(/;/s) {
 337             $_ = $'; $again = 1;
 338         } elsif(/extern\s+"C"\s+{/s) {
 339             $_ = $'; $again = 1;
 340         } elsif(/\{/s) {
 341             $_ = $'; $again = 1;
 342             print "+1: $_\n" if $options->debug >= 2;
 343             $level++;
 344         } else {
 345             $lookahead = 1;
 346         }
 347     }
 348     close(IN);
 349     print STDERR "done\n" if $options->verbose;
 350     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
 351 }
 352
 353 1;