Sweden-Number/tools/winapi_check/winapi_parser.pm

package winapi_parser;

use strict;

sub parse_c_file {
    my $options = shift;
    my $output = shift;
    my $file = shift;
    my $function_found_callback = shift;
    my $preprocessor_found_callback = shift;

    my $documentation;
    my $return_type;
    my $calling_convention;
    my $function = "";
    my $arguments;
    my $statements;

    my $function_begin = sub {
	$documentation = shift;
	$return_type= shift;
	$calling_convention = shift;
	$function = shift;
	$arguments = shift;

	$statements = "";
    };
    my $function_end = sub {
	&$function_found_callback($documentation,$return_type,$calling_convention,$function,$arguments,$statements);

	$function = "";
    };

    my @comments = ();
    my $level = 0;
    my $again = 0;
    my $lookahead = 0;
    my $lookahead_count = 0;

    print STDERR "Processing file '$file' ... " if $options->verbose;
    open(IN, "< $file") || die "<internal>: $file: $!\n";
    $/ = "\n";
    while($again || defined(my $line = <IN>)) {
	if(!$again) {
	    chomp $line;

	    if($lookahead) {
		$lookahead = 0;
		$_ .= "\n" . $line;
	    } else {
		$_ = $line;
		$lookahead_count = 0;
	    }
	    $lookahead_count++;
	    print "$level: $line\n" if $options->debug >= 2;
	} else {
	    $lookahead_count = 0;
	    $again = 0;
	}

	# Merge conflicts in file?
	if(/^(<<<<<<<|=======|>>>>>>>)/) {
	    $output->write("$file: merge conflicts in file\n");
	    last;
	}
      
	# remove comments
	if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) { push @comments, $2; $again = 1; next };
	if(/^(.*?)\/\*/s) {
	    $lookahead = 1;
	    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) {
		if(defined($3)) {
		    &$preprocessor_found_callback($1, $3);
		} else {
		    &$preprocessor_found_callback($1, "");
		}
		$again = 1;
		next;
	    }
	}

	my $documentation; 
	{
	    my $n = $#comments;
	    while($n >= 0 && $comments[$n] !~ /\/\*\*/) { $n-- }
	    if(defined($comments[$n]) && $n >= 0) {
		$documentation = $comments[$n];
	    } else {
		$documentation = "";
	    }
	}

	if($level > 0)
	{
	    my $line;
	    s/^([^\{\}]*)//s;
	    $line = $1;
	    if(/^(\{)/) {
		$_ = $'; $again = 1;
		$line .= $1;
		print "+1: $_\n" if $options->debug >= 2;
		$level++;
	    } elsif(/^(\})/) {
		$_ = $'; $again = 1;
		$line .= $1 if $level > 1;
		print "-1: $_\n" if $options->debug >= 2; 
		$level--;
	    }
	    if($line !~ /^\s*$/) {
		$statements .= "$line\n";
	    }	    
	    if($function && $level == 0) {
		&$function_end;
	    }
	    next;
	} elsif(/((struct\s+|union\s+|enum\s+)?\w+((\s*\*)+\s*|\s+))((__cdecl|__stdcall|VFWAPIV|VFWAPI|WINAPIV|WINAPI)\s+)?(\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/s) {
	    $_ = $'; $again = 1;

	    if($10 eq ";") {
		next;
	    } elsif($10 eq "{")  {	
		$level++;
	    }	    
	    
	    my $return_type = $1;
	    my $calling_convention = $6;
	    my $name = $7;
	    my $arguments = $9;

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

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

	    $name =~ s/^REGS_FUNC\((.*?)\)/$1/;

	    $arguments =~ y/\t\n/  /;
	    $arguments =~ s/^\s*(.*?)\s*$/$1/;
	    if($arguments eq "") { $arguments = "void" }
	    
	    my @arguments = split(/,/, $arguments);
	    foreach my $n (0..$#arguments) {
		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)|\s*)\s*//;
		if($argument =~ /^...$/) {
		    $argument = "...";
		} elsif($argument =~ /^((struct\s+|union\s+|enum\s+)?\w+)\s*((\*\s*?)*)\s*/) {
		    $argument = "$1";
		    if($3 ne "") {
			$argument .= " $3";
		    }
		} else {
		    die "$file: $.: syntax error: '$argument'\n";
		}
		$arguments[$n] = $argument;
		#print "  " . ($n + 1) . ": '" . $arguments[$n] . "'\n";
	    }
	    if($#arguments == 0 && $arguments[0] =~ /^void$/i) { $#arguments = -1;  } 

	    if($options->debug) {
		print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
	    }
	    &$function_begin($documentation,$return_type,$calling_convention,$name,\@arguments);

	} elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
	    $_ = $'; $again = 1;
	    my @arguments = ("HDC16");
	    &$function_begin($documentation,$2, "WINAPI", $3, \@arguments);
	    &$function_end;
	} elsif(/DC_(GET_VAL_32)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
	    $_ = $'; $again = 1;
	    my @arguments = ("HDC");
	    &$function_begin($documentation,$2, "WINAPI", $3, \@arguments);
	    &$function_end;
	} elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
	    $_ = $'; $again = 1;
	    my @arguments16 = ("HDC16", "LP" . $5 . "16");
	    my @arguments32 = ("HDC", "LP" . $5);
	    &$function_begin($documentation,"BOOL16", "WINAPI", $2 . "16", \@arguments16);
	    &$function_end;
	    &$function_begin($documentation,"BOOL", "WINAPI", $2, \@arguments32);
	    &$function_end;
	} elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
	    $_ = $'; $again = 1;
	    my @arguments16 = ("HDC16", "INT16");
	    my @arguments32 = ("HDC", "INT");
	    &$function_begin($documentation,"INT16", "WINAPI", $2 . "16", \@arguments16);
	    &$function_end;
	    &$function_begin($documentation,"INT", "WINAPI", $2, \@arguments32);
	    &$function_end;
	} elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
	    $_ = $'; $again = 1;
	    my @arguments16 = ("HWAVEIN16");
	    my @arguments32 = ("HWAVEIN");
	    &$function_begin($documentation,"UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
	    &$function_end;
	    &$function_begin($documentation,"UINT", "WINAPI", "waveIn" . $1, \@arguments32);
	    &$function_end;	    
	} elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
	    $_ = $'; $again = 1;
	    my @arguments16 = ("HWAVEOUT16");
	    my @arguments32 = ("HWAVEOUT");
	    &$function_begin($documentation,"UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
	    &$function_end;
	    &$function_begin($documentation,"UINT", "WINAPI", "waveOut" . $1, \@arguments32);	    
	    &$function_end;
	} elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
	    $_ = $'; $again = 1;
	    if($1 eq "1") {
		my @arguments16 = ("HWAVEOUT16", $4);
		my @arguments32 = ("HWAVEOUT", $4);
		&$function_begin($documentation,"UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
		&$function_end;
		&$function_begin($documentation,"UINT", "WINAPI", "waveOut" . $2, \@arguments32);
		&$function_end;
	    } elsif($1 eq 2) {
		my @arguments16 = ("UINT16", $4);
		my @arguments32 = ("UINT", $4);
		&$function_begin($documentation,"UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
		&$function_end;
		&$function_begin($documentation,"UINT", "WINAPI", "waveOut" . $2, \@arguments32);
		&$function_end;
	    }
	} elsif(/;/s) {
	    $_ = $'; $again = 1;
	} elsif(/\{/s) {
	    $_ = $'; $again = 1;
	    print "+1: $_\n" if $options->debug >= 2;
	    $level++;
        } else {
	    $lookahead = 1;
	}
    }
    close(IN);
    print STDERR "done\n" if $options->verbose;
    $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
}

1;