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

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