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