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($line !~ /^\s*$/) {
 297                 $statements .= "$line\n";
 298             }
 299
 300             if($level == 0) {
 301                 if($in_function) {
 302                     &$function_end($statements);
 303                     $statements = undef;
 304                 } elsif($in_type) {
 305                     if(/^\s*(?:WINE_PACKED\s+)?((?:\*\s*)?\w+\s*(?:\s*,\s*(?:\*+\s*)?\w+)*\s*);/s) {
 306                         my @parts = split(/\s*,\s*/, $1);
 307                         &$type_end([@parts]);
 308                     } elsif(/;/s) {
 309                         die "$file: $.: syntax error: '$_'\n";
 310                     } else {
 311                         $lookahead = 1;
 312                     }
 313                 }
 314             }
 315             next;
 316         } elsif(/(extern\s+|static\s+)?((struct\s+|union\s+|enum\s+|signed\s+|unsigned\s+)?\w+((\s*\*)+\s*|\s+))
 317             ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
 318             (\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/sx)
 319         {
 320             my @lines = split(/\n/, $&);
 321             my $function_line = $. - scalar(@lines) + 1;
 322
 323             $_ = $'; $again = 1;
 324
 325             if($11 eq "{")  {
 326                 $level++;
 327             }
 328
 329             my $linkage = $1;
 330             my $return_type = $2;
 331             my $calling_convention = $7;
 332             my $name = $8;
 333             my $arguments = $10;
 334
 335             if(!defined($linkage)) {
 336                 $linkage = "";
 337             }
 338
 339             if(!defined($calling_convention)) {
 340                 $calling_convention = "";
 341             }
 342
 343             $linkage =~ s/\s*$//;
 344
 345             $return_type =~ s/\s*$//;
 346             $return_type =~ s/\s*\*\s*/*/g;
 347             $return_type =~ s/(\*+)/ $1/g;
 348
 349             if($regs_entrypoints{$name}) {
 350                 $name = $regs_entrypoints{$name};
 351             }
 352
 353             $arguments =~ y/\t\n/  /;
 354             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 355             if($arguments eq "") { $arguments = "..." }
 356
 357             my @argument_types;
 358             my @argument_names;
 359             my @arguments = split(/,/, $arguments);
 360             foreach my $n (0..$#arguments) {
 361                 my $argument_type = "";
 362                 my $argument_name = "";
 363                 my $argument = $arguments[$n];
 364                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 365                 # print "  " . ($n + 1) . ": '$argument'\n";
 366                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
 367                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|\s*)\s*//;
 368                 if($argument =~ /^\.\.\.$/) {
 369                     $argument_type = "...";
 370                     $argument_name = "...";
 371                 } elsif($argument =~ /^
 372                         ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
 373                           (?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
 374                         ((?:const)?\s*(?:\*\s*?)*)\s*
 375                         (?:WINE_UNUSED\s+)?(\w*)\s*(?:\[\]|\s+OPTIONAL)?/x)
 376                 {
 377                     $argument_type = "$1";
 378                     if($2 ne "") {
 379                         $argument_type .= " $2";
 380                     }
 381                     $argument_name = $3;
 382
 383                     $argument_type =~ s/\s*const\s*/ /;
 384                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
 385
 386                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
 387                 } else {
 388                     die "$file: $.: syntax error: '$argument'\n";
 389                 }
 390                 $argument_types[$n] = $argument_type;
 391                 $argument_names[$n] = $argument_name;
 392                 # print "  " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
 393             }
 394             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
 395                 $#argument_types = -1;
 396                 $#argument_names = -1;
 397             }
 398
 399             if($options->debug) {
 400                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
 401             }
 402
 403             &$function_begin($documentation_line, $documentation,
 404                              $function_line, $linkage, $return_type, $calling_convention, $name,
 405                              \@argument_types,\@argument_names,\@argument_documentations);
 406             if($level == 0) {
 407                 &$function_end(undef);
 408             }
 409             $statements = "";
 410         } elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
 411             my @lines = split(/\n/, $&);
 412             my $function_line = $. - scalar(@lines) + 1;
 413
 414             $_ = $'; $again = 1;
 415
 416             &$function_begin($documentation_line, $documentation,
 417                              $function_line, "", "void", "__asm", $1);
 418             &$function_end("");
 419         } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 420             my @lines = split(/\n/, $&);
 421             my $function_line = $. - scalar(@lines) + 1;
 422
 423             $_ = $'; $again = 1;
 424             my @arguments16 = ("HWAVEIN16");
 425             my @arguments32 = ("HWAVEIN");
 426             &$function_begin($documentation_line, $documentation,
 427                              $function_line,  "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
 428             &$function_end("");
 429             &$function_begin($documentation_line, $documentation,
 430                              $function_line, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
 431             &$function_end("");
 432         } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 433             my @lines = split(/\n/, $&);
 434             my $function_line = $. - scalar(@lines) + 1;
 435
 436             $_ = $'; $again = 1;
 437
 438             my @arguments16 = ("HWAVEOUT16");
 439             my @arguments32 = ("HWAVEOUT");
 440             &$function_begin($documentation_line, $documentation,
 441                              $function_line, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
 442             &$function_end("");
 443             &$function_begin($documentation_line, $documentation,
 444                              $function_line, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
 445             &$function_end("");
 446         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 447             my @lines = split(/\n/, $&);
 448             my $function_line = $. - scalar(@lines) + 1;
 449
 450             $_ = $'; $again = 1;
 451
 452             if($1 eq "1") {
 453                 my @arguments16 = ("HWAVEOUT16", $4);
 454                 my @arguments32 = ("HWAVEOUT", $4);
 455                 &$function_begin($documentation_line, $documentation,
 456                                  $function_line, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
 457                 &$function_end("");
 458                 &$function_begin($documentation_line, $documentation,
 459                                  $function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 460                 &$function_end("");
 461             } elsif($1 eq 2) {
 462                 my @arguments16 = ("UINT16", $4);
 463                 my @arguments32 = ("UINT", $4);
 464                 &$function_begin($documentation_line, $documentation,
 465                                  $function_line, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
 466                 &$function_end("");
 467                 &$function_begin($documentation_line, $documentation,
 468                                  $function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 469                 &$function_end("");
 470             }
 471         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
 472             $_ = $'; $again = 1;
 473             $regs_entrypoints{$2} = $1;
 474         } elsif(/DEFAULT_DEBUG_CHANNEL\s*\((\S+)\)/s) {
 475             $_ = $'; $again = 1;
 476             unshift @$debug_channels, $1;
 477         } elsif(/(DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\((\S+)\)/s) {
 478             $_ = $'; $again = 1;
 479             push @$debug_channels, $1;
 480         } elsif(/typedef\s+(enum|struct|union)(?:\s+(\w+))?\s*\{/s) {
 481             $_ = $'; $again = 1;
 482             $level++;
 483             my $type = $1;
 484             if(defined($2)) {
 485                $type .= " $2";
 486             }
 487             &$type_begin($type);
 488         } elsif(/typedef\s+
 489                 ((?:const\s+|enum\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+)*?)
 490                 (\w+)
 491                 (?:\s+const)?
 492                 ((?:\s*\*+\s*|\s+)\w+\s*(?:\[[^\]]*\])?
 493                 (?:\s*,\s*(?:\s*\*+\s*|\s+)\w+\s*(?:\[[^\]]*\])?)*)
 494                 \s*;/sx)
 495         {
 496             $_ = $'; $again = 1;
 497
 498             my $type = "$1 $2";
 499
 500             my @names;
 501             my @parts = split(/\s*,\s*/, $2);
 502             foreach my $part (@parts) {
 503                 if($part =~ /(?:\s*(\*+)\s*|\s+)(\w+)\s*(\[[^\]]*\])?/) {
 504                     my $name = $2;
 505                     if(defined($1)) {
 506                         $name = "$1$2";
 507                     }
 508                     if(defined($3)) {
 509                         $name .= $3;
 510                     }
 511                     push @names, $name;
 512                 }
 513             }
 514             &$type_begin($type);
 515             &$type_end([@names]);
 516         } elsif(/typedef\s+
 517                 (?:(?:const\s+|enum\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+)*?)
 518                 (\w+)\s+
 519                 (?:(\w+)\s*)?
 520                 \((?:(\w+)\s+)?\s*\*\s*(\w+)\s*\)\s*
 521                 (?:\(([^\)]*)\)|\[([^\]]*)\])\s*;/sx)
 522         {
 523             $_ = $'; $again = 1;
 524             my $type;
 525             if(defined($2) || defined($3)) {
 526                 my $cc = $2 || $3;
 527                 if(defined($5)) {
 528                     $type = "$1 ($cc *)($5)";
 529                 } else {
 530                     $type = "$1 ($cc *)[$6]";
 531                 }
 532             } else {
 533                 if(defined($5)) {
 534                     $type = "$1 (*)($5)";
 535                 } else {
 536                     $type = "$1 (*)[$6]";
 537                 }
 538             }
 539             my $name = $4;
 540             &$type_begin($type);
 541             &$type_end([$name]);
 542         } elsif(/typedef[^\{;]*;/s) {
 543             $_ = $'; $again = 1;
 544             $output->write("$file: $.: can't parse: '$&'\n");
 545         } elsif(/typedef[^\{]*\{[^\}]*\}[^;];/s) {
 546             $_ = $'; $again = 1;
 547             $output->write("$file: $.: can't parse: '$&'\n");
 548         } elsif(/\'[^\']*\'/s) {
 549             $_ = $'; $again = 1;
 550         } elsif(/\"[^\"]*\"/s) {
 551             $_ = $'; $again = 1;
 552         } elsif(/;/s) {
 553             $_ = $'; $again = 1;
 554         } elsif(/extern\s+"C"\s+{/s) {
 555             $_ = $'; $again = 1;
 556         } elsif(/\{/s) {
 557             $_ = $'; $again = 1;
 558             print "+1: $_\n" if $options->debug >= 2;
 559             $level++;
 560         } else {
 561             $lookahead = 1;
 562         }
 563     }
 564     close(IN);
 565     print STDERR "done\n" if $options->verbose;
 566     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
 567 }
 568
 569 1;