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

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