tools/winapi_check/winapi_parser.pm

   1 package winapi_parser;
   2
   3 use strict;
   4
   5 sub parse_c_file {
   6     my $options = shift;
   7     my $output = shift;
   8     my $file = shift;
   9     my $function_found_callback = shift;
  10     my $preprocessor_found_callback = shift;
  11
  12     my $documentation;
  13     my $linkage;
  14     my $return_type;
  15     my $calling_convention;
  16     my $function = "";
  17     my $arguments;
  18     my $statements;
  19
  20     my $function_begin = sub {
  21         $documentation = shift;
  22         $linkage = shift;
  23         $return_type= shift;
  24         $calling_convention = shift;
  25         $function = shift;
  26         $arguments = shift;
  27
  28         $statements = "";
  29     };
  30     my $function_end = sub {
  31         &$function_found_callback($documentation,$linkage,$return_type,$calling_convention,$function,$arguments,$statements);
  32
  33         $function = "";
  34     };
  35
  36     my %regs_entrypoints;
  37     my @comments = ();
  38     my $level = 0;
  39     my $extern_c = 0;
  40     my $again = 0;
  41     my $lookahead = 0;
  42     my $lookahead_count = 0;
  43
  44     print STDERR "Processing file '$file' ... " if $options->verbose;
  45     open(IN, "< $file") || die "<internal>: $file: $!\n";
  46     $/ = "\n";
  47     while($again || defined(my $line = <IN>)) {
  48         if(!$again) {
  49             chomp $line;
  50
  51             if($lookahead) {
  52                 $lookahead = 0;
  53                 $_ .= "\n" . $line;
  54             } else {
  55                 $_ = $line;
  56                 $lookahead_count = 0;
  57             }
  58             $lookahead_count++;
  59             print " $level($lookahead_count): $line\n" if $options->debug >= 2;
  60             print "*** $_\n" if $options->debug >= 3;
  61         } else {
  62             $lookahead_count = 0;
  63             $again = 0;
  64         }
  65
  66         # Merge conflicts in file?
  67         if(/^(<<<<<<<|=======|>>>>>>>)/) {
  68             $output->write("$file: merge conflicts in file\n");
  69             last;
  70         }
  71
  72         # remove comments
  73         if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) { push @comments, $2; $again = 1; next };
  74         if(/^(.*?)\/\*/s) {
  75             $lookahead = 1;
  76             next;
  77         }
  78
  79         # remove empty rows
  80         if(/^\s*$/) { next; }
  81
  82         # remove preprocessor directives
  83         if(s/^\s*\#/\#/m) {
  84             if(/^\\#.*?\\$/m) {
  85                 $lookahead = 1;
  86                 next;
  87             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
  88                 if(defined($3)) {
  89                     &$preprocessor_found_callback($1, $3);
  90                 } else {
  91                     &$preprocessor_found_callback($1, "");
  92                 }
  93                 next;
  94             }
  95         }
  96
  97         # Remove extern "C"
  98         if(s/^\s*extern\s+"C"\s+\{//m) {
  99             $extern_c = 1;
 100             $again = 1;
 101             next;
 102         }
 103
 104         my $documentation;
 105         {
 106             my $n = $#comments;
 107             while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ || $comments[$n] =~ /^\/\*\*+\//)) { $n-- }
 108             if(defined($comments[$n]) && $n >= 0) {
 109                 $documentation = $comments[$n];
 110             } else {
 111                 $documentation = "";
 112             }
 113         }
 114
 115         if($level > 0)
 116         {
 117             my $line = "";
 118             while(/^[^\{\}]/) {
 119                 s/^([^\{\}\'\"]*)//s;
 120                 $line .= $1;
 121                 if(s/^\'//) {
 122                     $line .= "\'";
 123                     while(/^./ && !s/^\'//) {
 124                         s/^([^\'\\]*)//s;
 125                         $line .= $1;
 126                         if(s/^\\//) {
 127                             $line .= "\\";
 128                             if(s/^(.)//s) {
 129                                 $line .= $1;
 130                                 if($1 eq "0") {
 131                                     s/^(\d{0,3})//s;
 132                                     $line .= $1;
 133                                 }
 134                             }
 135                         }
 136                     }
 137                     $line .= "\'";
 138                 } elsif(s/^\"//) {
 139                     $line .= "\"";
 140                     while(/^./ && !s/^\"//) {
 141                         s/^([^\"\\]*)//s;
 142                         $line .= $1;
 143                         if(s/^\\//) {
 144                             $line .= "\\";
 145                             if(s/^(.)//s) {
 146                                 $line .= $1;
 147                                 if($1 eq "0") {
 148                                     s/^(\d{0,3})//s;
 149                                     $line .= $1;
 150                                 }
 151                             }
 152                         }
 153                     }
 154                     $line .= "\"";
 155                 }
 156             }
 157
 158             if(s/^\{//) {
 159                 $_ = $'; $again = 1;
 160                 $line .= "{";
 161                 print "+1: \{$_\n" if $options->debug >= 2;
 162                 $level++;
 163             } elsif(s/^\}//) {
 164                 $_ = $'; $again = 1;
 165                 $line .= "}" if $level > 1;
 166                 print "-1: \}$_\n" if $options->debug >= 2;
 167                 $level--;
 168                 if($level == -1 && $extern_c) {
 169                     $extern_c = 0;
 170                     $level = 0;
 171                 }
 172             }
 173
 174             if($line !~ /^\s*$/) {
 175                 $statements .= "$line\n";
 176             }
 177
 178             if($function && $level == 0) {
 179                 &$function_end;
 180             }
 181             next;
 182         } elsif(/(extern\s+|static\s+)?((struct\s+|union\s+|enum\s+)?\w+((\s*\*)+\s*|\s+))((__cdecl|__stdcall|VFWAPIV|VFWAPI|WINAPIV|WINAPI)\s+)?(\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/s) {
 183             $_ = $'; $again = 1;
 184
 185             if($11 eq "{")  {
 186                 $level++;
 187             }
 188
 189             my $linkage = $1;
 190             my $return_type = $2;
 191             my $calling_convention = $7;
 192             my $name = $8;
 193             my $arguments = $10;
 194
 195             if(!defined($linkage)) {
 196                 $linkage = "";
 197             }
 198
 199             if(!defined($calling_convention)) {
 200                 $calling_convention = "";
 201             }
 202
 203             $linkage =~ s/\s*$//;
 204
 205             $return_type =~ s/\s*$//;
 206             $return_type =~ s/\s*\*\s*/*/g;
 207             $return_type =~ s/(\*+)/ $1/g;
 208
 209             if($regs_entrypoints{$name}) {
 210                 $name = $regs_entrypoints{$name};
 211             }
 212
 213             $arguments =~ y/\t\n/  /;
 214             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 215             if($arguments eq "") { $arguments = "void" }
 216
 217             my @arguments = split(/,/, $arguments);
 218             foreach my $n (0..$#arguments) {
 219                 my $argument = $arguments[$n];
 220                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 221                 #print "  " . ($n + 1) . ": '$argument'\n";
 222                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
 223                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|\s*)\s*//;
 224                 if($argument =~ /^...$/) {
 225                     $argument = "...";
 226                 } elsif($argument =~ /^((struct\s+|union\s+|enum\s+)?\w+)\s*((\*\s*?)*)\s*/) {
 227                     $argument = "$1";
 228                     if($3 ne "") {
 229                         $argument .= " $3";
 230                     }
 231                 } else {
 232                     die "$file: $.: syntax error: '$argument'\n";
 233                 }
 234                 $arguments[$n] = $argument;
 235                 #print "  " . ($n + 1) . ": '" . $arguments[$n] . "'\n";
 236             }
 237             if($#arguments == 0 && $arguments[0] =~ /^void$/i) { $#arguments = -1;  }
 238
 239             if($options->debug) {
 240                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
 241             }
 242
 243             &$function_begin($documentation,$linkage,$return_type,$calling_convention,$name,\@arguments);
 244             if($level == 0) {
 245                 &$function_end;
 246             }
 247         } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 248             $_ = $'; $again = 1;
 249             my @arguments = ("HDC16");
 250             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
 251             &$function_end;
 252         } elsif(/DC_(GET_VAL_32)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
 253             $_ = $'; $again = 1;
 254             my @arguments = ("HDC");
 255             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
 256             &$function_end;
 257         } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 258             $_ = $'; $again = 1;
 259             my @arguments16 = ("HDC16", "LP" . $5 . "16");
 260             my @arguments32 = ("HDC", "LP" . $5);
 261             &$function_begin($documentation, "", "BOOL16", "WINAPI", $2 . "16", \@arguments16);
 262             &$function_end;
 263             &$function_begin($documentation, "", "BOOL", "WINAPI", $2, \@arguments32);
 264             &$function_end;
 265         } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 266             $_ = $'; $again = 1;
 267             my @arguments16 = ("HDC16", "INT16");
 268             my @arguments32 = ("HDC", "INT");
 269             &$function_begin($documentation, "", "INT16", "WINAPI", $2 . "16", \@arguments16);
 270             &$function_end;
 271             &$function_begin($documentation, "", "INT", "WINAPI", $2, \@arguments32);
 272             &$function_end;
 273         } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 274             $_ = $'; $again = 1;
 275             my @arguments16 = ("HWAVEIN16");
 276             my @arguments32 = ("HWAVEIN");
 277             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
 278             &$function_end;
 279             &$function_begin($documentation, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
 280             &$function_end;
 281         } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 282             $_ = $'; $again = 1;
 283             my @arguments16 = ("HWAVEOUT16");
 284             my @arguments32 = ("HWAVEOUT");
 285             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
 286             &$function_end;
 287             &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
 288             &$function_end;
 289         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
 290             $_ = $'; $again = 1;
 291             if($1 eq "1") {
 292                 my @arguments16 = ("HWAVEOUT16", $4);
 293                 my @arguments32 = ("HWAVEOUT", $4);
 294                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
 295                 &$function_end;
 296                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 297                 &$function_end;
 298             } elsif($1 eq 2) {
 299                 my @arguments16 = ("UINT16", $4);
 300                 my @arguments32 = ("UINT", $4);
 301                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
 302                 &$function_end;
 303                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
 304                 &$function_end;
 305             }
 306         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
 307             $_ = $'; $again = 1;
 308             $regs_entrypoints{$2} = $1;
 309         } elsif(/\'[^\']*\'/s) {
 310             $_ = $'; $again = 1;
 311         } elsif(/\"[^\"]*\"/s) {
 312             $_ = $'; $again = 1;
 313         } elsif(/;/s) {
 314             $_ = $'; $again = 1;
 315         } elsif(/extern\s+"C"\s+{/s) {
 316             $_ = $'; $again = 1;
 317         } elsif(/\{/s) {
 318             $_ = $'; $again = 1;
 319             print "+1: $_\n" if $options->debug >= 2;
 320             $level++;
 321         } else {
 322             $lookahead = 1;
 323         }
 324     }
 325     close(IN);
 326     print STDERR "done\n" if $options->verbose;
 327     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
 328 }
 329
 330 1;