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