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