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

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