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