git.oblomov.eu Git - wine/blob - tools/winapi_check/winapi_parser.pm

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