tools/winapi/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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17 #
  18
  19 package winapi_parser;
  20
  21 use strict;
  22
  23 use output qw($output);
  24 use options qw($options);
  25
  26 # Defined a couple common regexp tidbits
  27 my $CALL_CONVENTION="__cdecl|__stdcall|" .
  28                     "__RPC_API|__RPC_STUB|__RPC_USER|RPC_ENTRY|" .
  29                     "RPC_VAR_ENTRY|STDMETHODCALLTYPE|NET_API_FUNCTION|" .
  30                     "CALLBACK|CDECL|NTAPI|PASCAL|APIENTRY|" .
  31                     "SEC_ENTRY|VFWAPI|VFWAPIV|WINGDIPAPI|WMIAPI|WINAPI|WINAPIV|";
  32
  33 sub parse_c_file($$) {
  34     my $file = shift;
  35     my $callbacks = shift;
  36
  37     my $empty_callback = sub { };
  38
  39     my $c_comment_found_callback = $$callbacks{c_comment_found} || $empty_callback;
  40     my $cplusplus_comment_found_callback = $$callbacks{cplusplus_comment_found} || $empty_callback;
  41     my $function_create_callback = $$callbacks{function_create} || $empty_callback;
  42     my $function_found_callback = $$callbacks{function_found} || $empty_callback;
  43     my $type_create_callback = $$callbacks{type_create} || $empty_callback;
  44     my $type_found_callback = $$callbacks{type_found} || $empty_callback;
  45     my $preprocessor_found_callback = $$callbacks{preprocessor_found} || $empty_callback;
  46
  47     # global
  48     my $debug_channels = [];
  49
  50     my $in_function = 0;
  51     my $function_begin;
  52     my $function_end;
  53     {
  54         my $documentation_line;
  55         my $documentation;
  56         my $function_line;
  57         my $linkage;
  58         my $return_type;
  59         my $calling_convention;
  60         my $internal_name = "";
  61         my $argument_types;
  62         my $argument_names;
  63         my $argument_documentations;
  64         my $statements_line;
  65         my $statements;
  66
  67         $function_begin = sub {
  68             $documentation_line = shift;
  69             $documentation = shift;
  70             $function_line = shift;
  71             $linkage = shift;
  72             $return_type= shift;
  73             $calling_convention = shift;
  74             $internal_name = shift;
  75             $argument_types = shift;
  76             $argument_names = shift;
  77             $argument_documentations = shift;
  78
  79             if(defined($argument_names) && defined($argument_types) &&
  80                $#$argument_names == -1)
  81             {
  82                 foreach my $n (0..$#$argument_types) {
  83                     push @$argument_names, "";
  84                 }
  85             }
  86
  87             if(defined($argument_documentations) &&
  88                $#$argument_documentations == -1)
  89             {
  90                 foreach my $n (0..$#$argument_documentations) {
  91                     push @$argument_documentations, "";
  92                 }
  93             }
  94
  95             $in_function = 1;
  96         };
  97
  98         $function_end = sub {
  99             $statements_line = shift;
 100             $statements = shift;
 101
 102             my $function = &$function_create_callback();
 103
 104             if(!defined($documentation_line)) {
 105                 $documentation_line = 0;
 106             }
 107
 108             $function->file($file);
 109             $function->debug_channels([@$debug_channels]);
 110             $function->documentation_line($documentation_line);
 111             $function->documentation($documentation);
 112             $function->function_line($function_line);
 113             $function->linkage($linkage);
 114             $function->return_type($return_type);
 115             $function->calling_convention($calling_convention);
 116             $function->internal_name($internal_name);
 117             if(defined($argument_types)) {
 118                 $function->argument_types([@$argument_types]);
 119             }
 120             if(defined($argument_names)) {
 121                 $function->argument_names([@$argument_names]);
 122             }
 123             if(defined($argument_documentations)) {
 124                 $function->argument_documentations([@$argument_documentations]);
 125             }
 126             $function->statements_line($statements_line);
 127             $function->statements($statements);
 128
 129             &$function_found_callback($function);
 130
 131             $in_function = 0;
 132         };
 133     }
 134
 135     my $in_type = 0;
 136     my $type_begin;
 137     my $type_end;
 138     {
 139         my $type;
 140
 141         $type_begin = sub {
 142             $type = shift;
 143             $in_type = 1;
 144         };
 145
 146         $type_end = sub {
 147             my $names = shift;
 148
 149             foreach my $name (@$names) {
 150                 if($type =~ /^(?:enum|interface|struct|union)/) {
 151                     # $output->write("typedef $type {\n");
 152                     # $output->write("} $name;\n");
 153                 } else {
 154                     # $output->write("typedef $type $name;\n");
 155                 }
 156             }
 157             $in_type = 0;
 158         };
 159     }
 160
 161     my %regs_entrypoints;
 162     my @comment_lines = ();
 163     my @comments = ();
 164     my $statements_line;
 165     my $statements;
 166     my $level = 0;
 167     my $extern_c = 0;
 168     my $again = 0;
 169     my $lookahead = 0;
 170     my $lookahead_count = 0;
 171
 172     print STDERR "Processing file '$file' ... " if $options->verbose;
 173     open(IN, "< $file") || die "<internal>: $file: $!\n";
 174     local $_ = "";
 175     readmore: while($again || defined(my $line = <IN>)) {
 176         $_ = "" if !defined($_);
 177         if(!$again) {
 178             chomp $line;
 179
 180             if($lookahead) {
 181                 $lookahead = 0;
 182                 $_ .= "\n" . $line;
 183                 $lookahead_count++;
 184             } else {
 185                 $_ = $line;
 186                 $lookahead_count = 0;
 187             }
 188             $output->write(" $level($lookahead_count): $line\n") if $options->debug >= 2;
 189             $output->write("*** $_\n") if $options->debug >= 3;
 190         } else {
 191             $lookahead_count = 0;
 192             $again = 0;
 193         }
 194
 195         # CVS merge conflicts in file?
 196         if(/^(<<<<<<<|=======|>>>>>>>)/) {
 197             $output->write("$file: merge conflicts in file\n");
 198             last;
 199         }
 200
 201         my $prefix="";
 202         while ($_ ne "")
 203         {
 204             if (s/^([^\"\/]+|\"(?:[^\\\"]*|\\.)*\")//)
 205             {
 206                 $prefix.=$1;
 207             }
 208             elsif (/^\/\*/)
 209             {
 210                 # remove C comments
 211                 if(s/^(\/\*.*?\*\/)//s) {
 212                     my @lines = split(/\n/, $1);
 213                     push @comment_lines, $.;
 214                     push @comments, $1;
 215                     &$c_comment_found_callback($. - $#lines, $., $1);
 216                     if($#lines <= 0) {
 217                         $_ = "$prefix $_";
 218                     } else {
 219                         $_ = $prefix . ("\n" x $#lines) . $_;
 220                     }
 221                     $again = 1;
 222                 } else {
 223                     $_ = "$prefix$_";
 224                     $lookahead = 1;
 225                 }
 226                 next readmore;
 227             }
 228             elsif (s/^(\/\/.*)$//)
 229             {
 230                 # remove C++ comments
 231                 &$cplusplus_comment_found_callback($., $1);
 232                 $again = 1;
 233             }
 234             elsif (s/^(.)//)
 235             {
 236                 $prefix.=$1;
 237             }
 238         }
 239         $_=$prefix;
 240
 241         # remove preprocessor directives
 242         if(s/^\s*\#/\#/s) {
 243             if(/^(\#.*?)\\$/s) {
 244                 $_ = "$1\n";
 245                 $lookahead = 1;
 246                 next;
 247             } elsif(s/^\#\s*(\w+)((?:\s+(.*?))?\s*)$//s) {
 248                 my @lines = split(/\n/, $2);
 249                 if($#lines > 0) {
 250                     $_ = "\n" x $#lines;
 251                 }
 252                 if(defined($3)) {
 253                     &$preprocessor_found_callback($1, $3);
 254                 } else {
 255                     &$preprocessor_found_callback($1, "");
 256                 }
 257                 $again = 1;
 258                 next;
 259             }
 260         }
 261
 262         # Remove extern "C"
 263         if(s/^\s*extern\s+"C"\s+\{//m) {
 264             $extern_c = 1;
 265             $again = 1;
 266             next;
 267         }
 268
 269         my $documentation_line;
 270         my $documentation;
 271         my @argument_documentations = ();
 272         {
 273             my $n = $#comments;
 274             while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ ||
 275                               $comments[$n] =~ /^\/\*\*+\/$/))
 276             {
 277                 $n--;
 278             }
 279
 280             if(defined($comments[$n]) && $n >= 0) {
 281                 my @lines = split(/\n/, $comments[$n]);
 282
 283                 $documentation_line = $comment_lines[$n] - scalar(@lines) + 1;
 284                 $documentation = $comments[$n];
 285
 286                 for(my $m=$n+1; $m <= $#comments; $m++) {
 287                     if($comments[$m] =~ /^\/\*\*+\/$/ ||
 288                        $comments[$m] =~ /^\/\*\s*(?:\!)?defined/) # FIXME: Kludge
 289                     {
 290                         @argument_documentations = ();
 291                         next;
 292                     }
 293                     push @argument_documentations, $comments[$m];
 294                 }
 295             } else {
 296                 $documentation = "";
 297             }
 298         }
 299
 300         if($level > 0)
 301         {
 302             my $line = "";
 303             while(/^[^\{\}]/) {
 304                 s/^([^\{\}\'\"]*)//s;
 305                 $line .= $1;
 306                 if(s/^\'//) {
 307                     $line .= "\'";
 308                     while(/^./ && !s/^\'//) {
 309                         s/^([^\'\\]*)//s;
 310                         $line .= $1;
 311                         if(s/^\\//) {
 312                             $line .= "\\";
 313                             if(s/^(.)//s) {
 314                                 $line .= $1;
 315                                 if($1 eq "0") {
 316                                     s/^(\d{0,3})//s;
 317                                     $line .= $1;
 318                                 }
 319                             }
 320                         }
 321                     }
 322                     $line .= "\'";
 323                 } elsif(s/^\"//) {
 324                     $line .= "\"";
 325                     while(/^./ && !s/^\"//) {
 326                         s/^([^\"\\]*)//s;
 327                         $line .= $1;
 328                         if(s/^\\//) {
 329                             $line .= "\\";
 330                             if(s/^(.)//s) {
 331                                 $line .= $1;
 332                                 if($1 eq "0") {
 333                                     s/^(\d{0,3})//s;
 334                                     $line .= $1;
 335                                 }
 336                             }
 337                         }
 338                     }
 339                     $line .= "\"";
 340                 }
 341             }
 342
 343             if(s/^\{//) {
 344                 $_ = $'; $again = 1;
 345                 $line .= "{";
 346                 print "+1: \{$_\n" if $options->debug >= 2;
 347                 $level++;
 348                 $statements .= $line;
 349             } elsif(s/^\}//) {
 350                 $_ = $'; $again = 1;
 351                 $line .= "}" if $level > 1;
 352                 print "-1: \}$_\n" if $options->debug >= 2;
 353                 $level--;
 354                 if($level == -1 && $extern_c) {
 355                     $extern_c = 0;
 356                     $level = 0;
 357                 }
 358                 $statements .= $line;
 359             } else {
 360                 $statements .= "$line\n";
 361             }
 362
 363             if($level == 0) {
 364                 if($in_function) {
 365                     &$function_end($statements_line, $statements);
 366                     $statements = undef;
 367                 } elsif($in_type) {
 368                     if(/^\s*((?:(?:FAR\s*)?\*\s*(?:RESTRICTED_POINTER\s+)?)?
 369                             (?:volatile\s+)?
 370                             (?:\w+|WS\(\w+\))\s*
 371                             (?:\s*,\s*(?:(?:FAR\s*)?\*+\s*(?:RESTRICTED_POINTER\s+)?)?(?:volatile\s+)?(?:\w+|WS\(\w+\)))*\s*);/sx) {
 372                         my @parts = split(/\s*,\s*/, $1);
 373                         &$type_end([@parts]);
 374                     } elsif(/;/s) {
 375                         die "$file: $.: syntax error: '$_'\n";
 376                     } else {
 377                         $lookahead = 1;
 378                     }
 379                 }
 380             }
 381             next;
 382         } elsif(/(extern\s+|static\s+)?((interface\s+|struct\s+|union\s+|enum\s+|signed\s+|unsigned\s+)?\w+((\s*\*)+\s*|\s+))
 383             (($CALL_CONVENTION)\s+)?
 384             (?:DECLSPEC_HOTPATCH\s+)?
 385             (\w+(\(\w+\))?)\s*\((.*?)\)\s*(\{|\;)/sx)
 386         {
 387             my @lines = split(/\n/, $&);
 388             my $function_line = $. - scalar(@lines) + 1;
 389
 390             $_ = $'; $again = 1;
 391
 392             if($11 eq "{")  {
 393                 $level++;
 394             }
 395
 396             my $linkage = $1;
 397             my $return_type = $2;
 398             my $calling_convention = $7;
 399             my $name = $8;
 400             my $arguments = $10;
 401
 402             if(!defined($linkage)) {
 403                 $linkage = "";
 404             }
 405
 406             if(!defined($calling_convention)) {
 407                 $calling_convention = "";
 408             }
 409
 410             $linkage =~ s/\s*$//;
 411
 412             $return_type =~ s/\s*$//;
 413             $return_type =~ s/\s*\*\s*/*/g;
 414             $return_type =~ s/(\*+)/ $1/g;
 415
 416             if($regs_entrypoints{$name}) {
 417                 $name = $regs_entrypoints{$name};
 418             }
 419
 420             $arguments =~ y/\t\n/  /;
 421             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 422             if($arguments eq "") { $arguments = "..." }
 423
 424             my @argument_types;
 425             my @argument_names;
 426             my @arguments;
 427             my $n = 0;
 428             while ($arguments =~ s/^((?:[^,\(\)]*|(?:\([^\)]*\))?)+)(?:,|$)// && $1) {
 429                 my $argument = $1;
 430                 push @arguments, $argument;
 431
 432                 my $argument_type = "";
 433                 my $argument_name = "";
 434
 435                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 436                 # print "  " . ($n + 1) . ": '$argument'\n";
 437                 $argument =~ s/^(?:IN OUT|IN|OUT)?\s+//;
 438                 $argument =~ s/^(?:const|CONST|GDIPCONST|volatile)?\s+//;
 439                 if($argument =~ /^\.\.\.$/) {
 440                     $argument_type = "...";
 441                     $argument_name = "...";
 442                 } elsif($argument =~ /^
 443                         ((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)?
 444                           (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+|ElfW\(\w+\)|WS\(\w+\)))\s*
 445                         ((?:__RPC_FAR|const|CONST|GDIPCONST|volatile)?\s*(?:\*\s*(?:__RPC_FAR|const|CONST|volatile)?\s*?)*)\s*
 446                         (\w*)\s*(\[\])?(?:\s+OPTIONAL)?$/x)
 447                 {
 448                     $argument_type = $1;
 449                     if ($2) {
 450                         $argument_type .= " $2";
 451                     }
 452                     if ($4) {
 453                         $argument_type .= "$4";
 454                     }
 455                     $argument_name = $3;
 456                 } elsif ($argument =~ /^
 457                         ((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)?
 458                           (?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
 459                         ((?:const|volatile)?\s*(?:\*\s*(?:const|volatile)?\s*?)*)\s*
 460                         (?:(?:$CALL_CONVENTION)\s+)?
 461                         \(\s*(?:$CALL_CONVENTION)?\s*\*\s*((?:\w+)?)\s*\)\s*
 462                         \(\s*(.*?)\s*\)$/x)
 463                 {
 464                     my $return_type = $1;
 465                     if($2) {
 466                         $return_type .= " $2";
 467                     }
 468                     $argument_name = $3;
 469                     my $arguments = $4;
 470
 471                     $return_type =~ s/\s+/ /g;
 472                     $arguments =~ s/\s*,\s*/,/g;
 473
 474                     $argument_type = "$return_type (*)($arguments)";
 475                 } elsif ($argument =~ /^
 476                         ((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)
 477                           (?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
 478                         ((?:const|volatile)?\s*(?:\*\s*(?:const|volatile)?\s*?)*)\s*
 479                         (\w+)\s*\[\s*(.*?)\s*\](?:\[\s*(.*?)\s*\])?$/x)
 480                 {
 481                     my $return_type = $1;
 482                     if($2) {
 483                         $return_type .= " $2";
 484                     }
 485                     $argument_name = $3;
 486
 487                     $argument_type = "$return_type\[$4\]";
 488
 489                     if (defined($5)) {
 490                         $argument_type .= "\[$5\]";
 491                     }
 492
 493                     # die "$file: $.: syntax error: '$argument_type':'$argument_name'\n";
 494                 } else {
 495                     die "$file: $.: syntax error: '$argument'\n";
 496                 }
 497
 498                 $argument_type =~ s/\s*(?:const|volatile)\s*/ /g; # Remove const/volatile
 499                 $argument_type =~ s/([^\*\(\s])\*/$1 \*/g; # Assure whitespace between non-* and *
 500                 $argument_type =~ s/,([^\s])/, $1/g; # Assure whitespace after ,
 501                 $argument_type =~ s/\*\s+\*/\*\*/g; # Remove whitespace between * and *
 502                 $argument_type =~ s/([\(\[])\s+/$1/g; # Remove whitespace after ( and [
 503                 $argument_type =~ s/\s+([\)\]])/$1/g; # Remove whitespace before ] and )
 504                 $argument_type =~ s/\s+/ /; # Remove multiple whitespace
 505                 $argument_type =~ s/^\s*(.*?)\s*$/$1/; # Remove leading and trailing whitespace
 506
 507                 $argument_name =~ s/^\s*(.*?)\s*$/$1/; # Remove leading and trailing whitespace
 508
 509                 $argument_types[$n] = $argument_type;
 510                 $argument_names[$n] = $argument_name;
 511                 # print "  " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
 512
 513                 $n++;
 514             }
 515             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
 516                 $#argument_types = -1;
 517                 $#argument_names = -1;
 518             }
 519
 520             if($options->debug) {
 521                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
 522             }
 523
 524             &$function_begin($documentation_line, $documentation,
 525                              $function_line, $linkage, $return_type, $calling_convention, $name,
 526                              \@argument_types,\@argument_names,\@argument_documentations);
 527             if($level == 0) {
 528                 &$function_end(undef, undef);
 529             }
 530             $statements_line = $.;
 531             $statements = "";
 532         } elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
 533             my @lines = split(/\n/, $&);
 534             my $function_line = $. - scalar(@lines) + 1;
 535
 536             $_ = $'; $again = 1;
 537
 538             &$function_begin($documentation_line, $documentation,
 539                              $function_line, "", "void", "__asm", $1);
 540             &$function_end($., "");
 541         } elsif(/DEFINE_THISCALL_WRAPPER\((\S*)\)/s) {
 542             my @lines = split(/\n/, $&);
 543             my $function_line = $. - scalar(@lines) + 1;
 544
 545             $_ = $'; $again = 1;
 546
 547             &$function_begin($documentation_line, $documentation,
 548                              $function_line, "", "void", "", "__thiscall_" . $1, \());
 549             &$function_end($function_line, "");
 550         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
 551             $_ = $'; $again = 1;
 552             $regs_entrypoints{$2} = $1;
 553         } elsif(/DEFAULT_DEBUG_CHANNEL\s*\((\S+)\)/s) {
 554             $_ = $'; $again = 1;
 555             unshift @$debug_channels, $1;
 556         } elsif(/(DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\((\S+)\)/s) {
 557             $_ = $'; $again = 1;
 558             push @$debug_channels, $1;
 559         } elsif(/typedef\s+(enum|interface|struct|union)(?:\s+(\w+))?\s*\{/s) {
 560             $_ = $'; $again = 1;
 561             $level++;
 562             my $type = $1;
 563             if(defined($2)) {
 564                $type .= " $2";
 565             }
 566             &$type_begin($type);
 567         } elsif(/typedef\s+
 568                 ((?:const\s+|CONST\s+|enum\s+|interface\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+|volatile\s+)*?)
 569                 (\w+)
 570                 (?:\s+const|\s+volatile)?
 571                 ((?:\s*(?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+\s*|\s+)(?:volatile\s+|DECLSPEC_ALIGN\(\d+\)\s+)?\w+\s*(?:\[[^\]]*\])*
 572                 (?:\s*,\s*(?:\s*(?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+\s*|\s+)\w+\s*(?:\[[^\]]*\])?)*)
 573                 \s*;/sx)
 574         {
 575             $_ = $'; $again = 1;
 576
 577             my $type = "$1 $2";
 578
 579             my @names;
 580             my @parts = split(/\s*,\s*/, $2);
 581             foreach my $part (@parts) {
 582                 if($part =~ /(?:\s*((?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+)\s*|\s+)(\w+)\s*(\[[^\]]*\])?/) {
 583                     my $name = $2;
 584                     if(defined($1)) {
 585                         $name = "$1$2";
 586                     }
 587                     if(defined($3)) {
 588                         $name .= $3;
 589                     }
 590                     push @names, $name;
 591                 }
 592             }
 593             &$type_begin($type);
 594             &$type_end([@names]);
 595         } elsif(/typedef\s+
 596                 (?:(?:const\s+|enum\s+|interface\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+|volatile\s+)*?)
 597                 (\w+(?:\s*\*+\s*)?)\s*
 598                 (?:(\w+)\s*)?
 599                 \((?:(\w+)\s*)?\s*(?:\*\s*(\w+)|_ATL_CATMAPFUNC)\s*\)\s*
 600                 (?:\(([^\)]*)\)|\[([^\]]*)\])\s*;/sx)
 601         {
 602             $_ = $'; $again = 1;
 603             my $type;
 604             if(defined($2) || defined($3)) {
 605                 my $cc = $2 || $3;
 606                 if(defined($5)) {
 607                     $type = "$1 ($cc *)($5)";
 608                 } else {
 609                     $type = "$1 ($cc *)[$6]";
 610                 }
 611             } else {
 612                 if(defined($5)) {
 613                     $type = "$1 (*)($5)";
 614                 } else {
 615                     $type = "$1 (*)[$6]";
 616                 }
 617             }
 618             my $name = $4;
 619             &$type_begin($type);
 620             &$type_end([$name]);
 621         } elsif(/typedef[^\{;]*;/s) {
 622             $_ = $'; $again = 1;
 623             $output->write("$file: $.: can't parse: '$&'\n");
 624         } elsif(/typedef[^\{]*\{[^\}]*\}[^;];/s) {
 625             $_ = $'; $again = 1;
 626             $output->write("$file: $.: can't parse: '$&'\n");
 627         } elsif(/\'[^\']*\'/s) {
 628             $_ = $'; $again = 1;
 629         } elsif(/\"(?:[^\\\"]*|\\.)*\"/s) {
 630             $_ = $'; $again = 1;
 631         } elsif(/;/s) {
 632             $_ = $'; $again = 1;
 633         } elsif(/extern\s+"C"\s+{/s) {
 634             $_ = $'; $again = 1;
 635         } elsif(/\{/s) {
 636             $_ = $'; $again = 1;
 637             print "+1: $_\n" if $options->debug >= 2;
 638             $level++;
 639         } else {
 640             $lookahead = 1;
 641         }
 642     }
 643     close(IN);
 644     print STDERR "done\n" if $options->verbose;
 645     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
 646 }
 647
 648 1;