Sweden-Number/tools/winedump/function_grep.pl

#! /usr/bin/perl

# Copyright 2000 Patrik Stridvall

use strict;

my $invert = 0;
my $pattern;
my @files = ();

while(defined($_ = shift)) {
    if(/^-/) {
	if(/^-v$/) {
	    $invert = 1;
	}
    } else {
	if(!defined($pattern)) {
	    $pattern = $_;
	} else {
	    push @files, $_;
	}
    }
}

foreach my $file (@files) {
    open(IN, "< $file");

    my $level = 0;
    my $extern_c = 0;

    my $again = 0;
    my $lookahead = 0;
    while($again || defined(my $line = <IN>)) {
	if(!$again) {
	    chomp $line;
	    if($lookahead) {
		$lookahead = 0;
		$_ .= "\n" . $line;
	    } else {
		$_ = $line;
	    }
	} else {
	    $again = 0;
	}

	# remove C comments
	if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) { 
	    $again = 1;
	    next;
	} elsif(/^(.*?)\/\*/s) {
	    $lookahead = 1;
	    next;
	}

	# remove C++ comments
	while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
	if($again) { next; }

	# remove empty rows
	if(/^\s*$/) { next; }

	# remove preprocessor directives
	if(s/^\s*\#/\#/m) {
	    if(/^\#.*?\\$/m) {
		$lookahead = 1;
		next;
	    } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
		next;
	    }
	}

	# Remove extern "C"
	if(s/^\s*extern\s+"C"\s+\{//m) { 
	    $extern_c = 1;
	    $again = 1;
	    next; 
	}

	if($level > 0)
	{
	    my $line = "";
	    while(/^[^\{\}]/) {
		s/^([^\{\}\'\"]*)//s;
		$line .= $1;
	        if(s/^\'//) {
		    $line .= "\'";
		    while(/^./ && !s/^\'//) {
			s/^([^\'\\]*)//s;
			$line .= $1;
			if(s/^\\//) {
			    $line .= "\\";
			    if(s/^(.)//s) {
				$line .= $1;
				if($1 eq "0") {
				    s/^(\d{0,3})//s;
				    $line .= $1;
				}
			    }
			}
		    }
		    $line .= "\'";
		} elsif(s/^\"//) {
		    $line .= "\"";
		    while(/^./ && !s/^\"//) {
			s/^([^\"\\]*)//s;
			$line .= $1;
			if(s/^\\//) {
			    $line .= "\\";
			    if(s/^(.)//s) {
				$line .= $1;
				if($1 eq "0") {
				    s/^(\d{0,3})//s;
				    $line .= $1;
				}
			    }
			}
		    }
		    $line .= "\"";
		}
	    }

	    if(s/^\{//) {
		$_ = $'; $again = 1;
		$line .= "{";
		$level++;
	    } elsif(s/^\}//) {
		$_ = $'; $again = 1;
		$line .= "}" if $level > 1;
		$level--;
		if($level == -1 && $extern_c) {
		    $extern_c = 0;
		    $level = 0;
		}
	    }

	    next;
	} elsif(/^class[^\}]*{/) {
	    $_ = $'; $again = 1;
	    $level++;
	    next;
	} elsif(/^class[^\}]*$/) {
	    $lookahead = 1;
	    next;
	} elsif(/^typedef[^\}]*;/) {
	    next;
        } elsif(/(extern\s+|static\s+)?
		(?:__inline__\s+|__inline\s+|inline\s+)?
		((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
		((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
		((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
		(?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
                (\{|\;)/sx)
	{
	    $_ = $'; $again = 1;
	    if($11 eq "{")  {
		$level++;
	    }

	    my $linkage = $1;
            my $return_type = $2;
            my $calling_convention = $7;
            my $name = $8;
            my $arguments = $10;
	    
            if(!defined($linkage)) {
                $linkage = "";
            }

            if(!defined($calling_convention)) {
                $calling_convention = "";
            }

            $linkage =~ s/\s*$//;

            $return_type =~ s/\s*$//;
            $return_type =~ s/\s*\*\s*/*/g;
            $return_type =~ s/(\*+)/ $1/g;

            $arguments =~ y/\t\n/  /;
            $arguments =~ s/^\s*(.*?)\s*$/$1/;
            if($arguments eq "") { $arguments = "void" }

            my @argument_types;
            my @argument_names;
            my @arguments = split(/,/, $arguments);
            foreach my $n (0..$#arguments) {
                my $argument_type = "";
                my $argument_name = "";
                my $argument = $arguments[$n];
                $argument =~ s/^\s*(.*?)\s*$/$1/;
                # print "  " . ($n + 1) . ": '$argument'\n";
                $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
                $argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
                if($argument =~ /^\.\.\.$/) {
                    $argument_type = "...";
                    $argument_name = "...";
                } elsif($argument =~ /^
                        ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
                          (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
                        ((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
                        (?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
			(\w*)\s*
			(?:\[\]|\s+OPTIONAL)?/x)
                {
                    $argument_type = "$1";
                    if($2 ne "") {
                        $argument_type .= " $2";
                    }
                    $argument_name = $3;

                    $argument_type =~ s/\s*const\s*/ /;
                    $argument_type =~ s/^\s*(.*?)\s*$/$1/;

                    $argument_name =~ s/^\s*(.*?)\s*$/$1/;
                } else {
                    die "$file: $.: syntax error: '$argument'\n";
                }
                $argument_types[$n] = $argument_type;
                $argument_names[$n] = $argument_name;
                # print "  " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
            }
            if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
                $#argument_types = -1;
                $#argument_names = -1;
            }

	    @arguments = ();
            foreach my $n (0..$#argument_types) {
		if($argument_names[$n] && $argument_names[$n] ne "...") {
		    if($argument_types[$n] !~ /\*$/) {
			$arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
		    } else {
			$arguments[$n] = $argument_types[$n] . $argument_names[$n];
		    }
		} else {
		    $arguments[$n] = $argument_types[$n];
		}
	    }

	    $arguments = join(", ", @arguments);
	    if(!$arguments) { $arguments = "void"; }

	    if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
		if($calling_convention) {
		    print "$return_type $calling_convention $name($arguments)\n";
		} else {
		    if($return_type =~ /\*$/) {
			print "$return_type$name($arguments)\n";
		    } else {
			print "$return_type $name($arguments)\n";
		    }
		}
	    }
        } elsif(/\'[^\']*\'/s) {
            $_ = $'; $again = 1;
        } elsif(/\"[^\"]*\"/s) {
            $_ = $'; $again = 1;
        } elsif(/;/s) {
            $_ = $'; $again = 1;
        } elsif(/extern\s+"C"\s+{/s) {
            $_ = $'; $again = 1;
        } elsif(/\{/s) {
            $_ = $'; $again = 1;
            $level++;
        } else {
            $lookahead = 1;
        }
    }
    close(IN);	
}