#!/usr/bin/perl
#
# This script checks to make sure no allocated memory is lost.
# Based on great Dan Carpenter's work.
# Enhanced by Oleg Drokin to understand missing last reference on assignments, exported stuff, equivalent variables,
#                          chained assignments, double free, free of null values, assignments/returns/comparisons of
#			   already freed values.
# Adapted to wine by Michael Stefaniuc
#
# BUGS:
#   Exporting only understands indirections, there is no way to determine static local and global variables yet. (Almost fixed now, I think).
#   If the malloc/free is done conditionally on some nontrivial expression, we do not understand it. (false memleaks)
#   It does not know about switch/case
#   if ( (a = b) == NULL) stuff is missed as a=b assignment.
#   Alloc/free functions list can be bigger
#   a[i]=kmalloc() ; i++ ; a[i]=smth; produces false "memleak" warning.
#

use smatch;
use ifcond;

# Set this to 1, if your functions are not supposed to export any stuff
# on returning negative values (errors?). This produces lots of false positives,
# but it also catches some real bugs, so you probably want to try with and without this setting.
$EXPORTED_ON_EXIT_IS_BAD = 0;

# Set this to 1 to mark variables passed to other functions by address as "exported"
# (not reported as leaked later on). Set to 0 otherwise
$REFERENCE_BY_ADDRESS_IS_EXPORTED = 1;

# Enable list_funcs functions
$ENABLE_LIST_FUNCS = 1;

# If this is set to 0, and we try to merge complex variable and one of the merging values is
# empty, the merge result will be empty too. This probably looses some valid errors, but
# also gets rids of some false positives like on in fs/select.c::sys_poll(). This is because
# of "copy of ..." stuff interaction, but I have not yet found how to deal with it.
$RESET_SINGLE_STRUCTURES = 0;

# Do not print a warning if possible redundant always true/false comparison detected
$NO_REDUNDANT_COMP = 1;

# In some cases it is ok to free NULL variable. Then set this var.
$FREE_NULL_IS_OK = 1;

# These functions return pointer to newly allocated memory but also
# "free" a pointer passed to them. The values is the position of the
# argument that gets "freed".
my %realloc_funcs = ( "CryptMemRealloc" => 1,
                      "GlobalReAlloc" => 1,
                      "heap_realloc" => 1,
                      "heap_realloc_zero" => 1,
                      "HeapReAlloc" => 3,
                      "LocalReAlloc" => 1,
                      "msi_realloc" => 1,
                      "msi_realloc_zero" => 1,
                      "realloc" => 1,
                      "ReAlloc" => 1,
                      "RtlReAllocateHeap" => 3,
);

# These functions return pointer to newly allocated memory. We care
# about the key and not the value.
my %alloc_funcs = ( %realloc_funcs,
		    "alloc" => 1,
		    "Alloc" => 1,
		    "calloc" => 1,
		    "CoTaskMemAlloc" => 1,
		    "CryptMemAlloc" => 1,
		    "DllAllocSplMem" => 1,
		    "DPSP_CreateSPPlayerData" => 1,
		    "GdipAlloc" => 1,
		    "GlobalAlloc" => 1,
		    "heap_alloc" => 1,
		    "heap_alloc_zero" => 1,
		    "HeapAlloc" => 1,
		    "I_RpcAllocate" => 1,
		    "LocalAlloc" => 1,
		    "malloc" => 1,
		    "mem_alloc" => 1,
		    "MemAlloc" => 1,
		    "MPR_Alloc" => 1,
		    "msi_alloc" => 1,
		    "msi_alloc_zero" => 1,
		    "MSVCRT_calloc" => 1,
		    "MSVCRT_malloc" => 1,
		    "MyMalloc" => 1,
		    "rpcrt4_conn_np_alloc" => 1,
		    "RtlAllocateHeap" => 1,
		    "SAFEARRAY_Malloc" => 1,
		    "strdup" => 1,
		    "und_alloc" => 1,
		    "WINECON_Init" => 1,
);

# Functions with an "undef" value take only one argument and "free" it.
# Freeing functions with more than one argument have as value the
# number of the argument to be freed.
my %free_funcs = ( %realloc_funcs,
		   "assembly_release" => undef,
		   "CoTaskMemFree" => undef,
		   "CryptMemFree" => undef,
		   "DllFreeSplMem" => undef,
		   "FD31_DestroyPrivate" => undef,
		   "free" => undef,
		   "Free" => undef,
		   "GdipFree" => undef,
		   "GlobalFree" => undef,
		   "heap_free" => undef,
		   "HeapFree" => 3,
		   "HTTP_FreeTokens" => undef,
		   "I_RpcFree" => undef,
		   "ImmDestroyContext" => undef,
		   "LocalFree" => undef,
		   "LsaFreeMemory" => undef,
		   "mem_free" => undef,
		   "MemFree" => undef,
		   "MoFreeMediaType" => undef,
		   "MPR_Free" => undef,
		   "msi_free" => undef,
		   "MSVCRT_free" => undef,
		   "MyFree" => undef,
		   "PlaySound_Free" => undef,
		   "ReleaseHelpViewer" => undef,
		   "rot_entry_delete" => undef,
		   "rot_entry_release" => undef,
		   "RtlFreeHeap" => 3,
		   "SAFEARRAY_Free" => undef,
		   "SHDestroyPropSheetExtArray" => undef,
		   "ShellLink_Release" => undef,
		   "SHRegCloseUSKey" => undef,
		   "und_free" => undef,
		   "WINECON_Delete" => undef,
);

# These functions take multiple aruments, if any of tracked vars is passed to
# such functions, it is marked as "exported" (so we do not report it as leaked
# on function exit). We care only about the key and not the value.
my %list_funcs = ("Control_UnloadApplet" => 1,
		  "CreateStreamOnHGlobal" => 1,
		  "DOSVM_QueueEvent" => 1,
		  "DPA_InsertPtr" => 1,
		  "DPA_SetPtr" => 1,
		  "EMF_Create_HENHMETAFILE" => 1,
		  "GLOBAL_CreateBlock" => 1,
		  "list_add_after" => 1,
		  "list_add_before" => 1,
		  "list_add_head" => 1,
		  "list_add_tail" => 1,
		  "MapLS" => 1,
		  "Parser_Create" => 1,
		  "PostMessageA" => 1,
		  "PostMessageW" => 1,
		  "push_task" => 1,
		  "putenv" => 1,
		  "queue_file_op" => 1,
		  "RtlInitAnsiString" => 1,
		  "RtlInitAnsiStringEx" => 1,
		  "RtlInitString" => 1,
		  "RtlInitUnicodeString" => 1,
		  "RtlInitUnicodeStringEx" => 1,
		  "SELECTOR_AllocBlock" => 1,
		  "SetClipboardData" => 1,
		  "SetPropA" => 1,
		  "SetPropW" => 1,
		  "SetWindowLongA" => 1,
		  "SetWindowLongW" => 1,
		  "TlsSetValue" => 1,
		  "TransformFilter_Create" => 1,
);

# These functions are passing one of their arguments back
# (as in ptr1 = strcpy(ptr,"blah").
# The key is the function name and the value is the argument's number that is
# passed back by this function.
my %ptrback_funcs = ("_mbscat" => 1,
		     "_mbscpy" => 1,
		     "_mbsncpy" => 1,
		     "_mbsnbcpy" => 1,
		     "lstrcat" => 1,
		     "lstrcatA" => 1,
		     "lstrcatW" => 1,
		     "lstrcpy" => 1,
		     "lstrcpyA" => 1,
		     "lstrcpyW" => 1,
		     "lstrcpyn" => 1,
		     "lstrcpynA" => 1,
		     "lstrcpynW" => 1,
		     "memcpy" => 1,
		     "memmove" => 1,
		     "strcat" => 1,
		     "strcatW" => 1,
		     "strcpy" => 1,
		     "strcpyW" => 1,
		     "strncat" => 1,
		     "strncpy" => 1,
		     "strncpyW" => 1,
		     "wcscat" => 1,
		     "wcscpy" => 1,
		     "wcsncat" => 1,
		     "wcsncpy" => 1,
);


my (@globals) = (); # global/static variables
my (@autos) = (); # auto variables
my ($blocks_depth) = 0; # Depth of current code block

sub error_msg{
    my $msg = shift;
    my $var = shift;
    print get_filename(), " ", get_start_line($var), " ", get_lineno(), " ", get_func_pos(), " $msg\n";
}

# Check if variable is global
sub is_var_global($) {
    my ($name) = $_[0];
    my ($var);
    for $var (@globals) {
	if ( $var->{name} eq $name ) {
	    # Found it
	    return 1;
	}
    }
    return 0;
}

# Checks if there is such var.
sub is_var_in_scope($) {
    my ($name) = $_[0];
    my ($var);

    if ( $RESET_SINGLE_STRUCTURES && $name =~ /(?:indirect_ref|array_ref|component_ref)/ ) {
	# Assume that structures arrays and pointers are always exist
	return 1;
    }

    for $var (@globals) {
	if ( $var->{name} eq $name ) {
	    # Found it
	    return 1;
	}
    }
    for $var (@autos) {
	if ( $var->{name} eq $name ) {
	    # Found it
	    return 1;
	}
    }
    return 0;
}

# Now that we have several classes of "free" functions,
# this code can be reused, so I separated it.
sub mark_var_freed($) {
	my ($var) = $_[0];
	my ($state) = get_state($var);
	if ( $state eq "null" && ! ($var =~ /array_ref/) ) {
	    error_msg("Freeing null pointer $var", $var) unless $FREE_NULL_IS_OK;
	}
	if ( $state eq "free" ) {
	    error_msg("Freeing already freed $var", $var);
	}

	if ($state){
	    set_state($var, "free");
	    # Also free all the vars that refer to same place
	    if ( $state eq "copied" || $state eq "exported") {
		my ($vars);
		foreach $vars (state_names()){
		    if ( get_state($vars) eq "copy of $var") {
			set_state($vars, "free");
		    }
		}
	    }
	    if ( $state =~ /copy of (.*)/) {
		my ($ref) = $1;
		my ($vars);
		set_state($ref, "free");
		foreach $vars (state_names()){
		    if ( get_state($vars) eq "copy of $ref") {
			set_state($vars, "free");
		    }
		}
	    }
	}
}

# This function searches for the first unbalanced ')' in a string and
# returns the string up to the ')' (not included).
sub get_str_close_bracket($) {
    my $str = shift;
    my $count = 1; # We are searching for the first unbalanced ')'

    while ($str =~ m/[^()]*(\(|\))/g) {
	if ($1 eq ')') {
	    $count--;
	    if ($count == 0) {
		last;
	    }
	} else {
	    $count++;
	}
    }
    if ($count > 0) {
	# Couldn't find an unbalanced ')'
	return ($str);
    }
    return substr($str, 0, pos($str) - 1);
}

# This function extracts nth (n is passed in second argument to function)
# from list of arguments passed in 1st argument (doh, what a construction).
sub extract_argument($$) {
    my ($arglist) = $_[0];
    my ($argnum) = $_[1];
    my (@args) = split ( /, /, $arglist);
    my ($retval);
    my ($argcur) = 1;

    # XXX make something more intelligent here, what if there was some
    # embedded func call or calculation?

    return $args[$argnum-1];
}
# These merge rules are grown from real observation on Linux kernel sources.
sub merge_pointer_states($$$){
    my ($name, $one, $two) = @_;

    if ( (!$one || !$two) && !is_var_in_scope($name) ) {
	return 0; # some stale states should be reset.
    } 

    if ( ($one eq "free" && $two eq "null") || ($one eq "null" && $two eq "free") ) {
	return "free";
    }
    if ( ($one eq "free" && $two eq "non_null") || ($one eq "non_null" && $two eq "free") ) {
	return "non_null";
    }
    # ??? This is uncertain.
#    if ( ($one eq "free" && $two eq "undefined") || ($one eq "undefined" && $two eq "free") ) {
#	return "free";
#    }

    if ( $one =~ /copy of .*/ && $two =~ /copy of .*/ ) {
	return $one; # Heavy black magic.
    }
    if ( ($one =~ /copy of .*/ && $two eq "free") || ($one eq "free" && $two =~ /copy of .*/) ) {
	return "free";
    }
    if ( ($one =~ /(copy of .*)/ && $two eq "non_null") || ($one eq "non_null" && $two =~ /(copy of .*)/) ) {
	return $1;
    }
    if ( ($one =~ /copy of .*/ && $two eq "null") || ($one eq "null" && $two =~ /copy of .*/) ) {
	return "null";
    }
    if ( ($one =~ /(copy of .*)/ && $two eq "undefined") || ($one eq "undefined" && $two =~ /(copy of .*)/) ) {
	return $1;
    }
    if ( ($one eq "exported" && $two eq "null") || ($one eq "null" && $two eq "exported") ) {
	return "exported";
    }
    if ( ($one eq "exported" && $two eq "non_null") || ($one eq "non_null" && $two eq "exported") ) {
	return "exported";
    }
    # ??? I am not sure, but it seems that if we return "free" here, we will hit lots of false stuff
    if ( ($one eq "exported" && $two eq "free") || ($one eq "free" && $two eq "exported") ) {
	return "exported";
    }
    if ( ($one eq "exported" && $two eq "undefined") || ($one eq "undefined" && $two eq "exported") ) {
	return "exported";
    }
    if ( ($one eq "exported" && $two =~ /^copy of /) || ($one =~ /^copy of / && $two eq "exported") ) {
	return "exported";
    }
    if ( ($one eq "copied" && $two eq "null") || ($one eq "null" && $two eq "copied") ) {
	return "copied";
    }
    if ( ($one eq "copied" && $two eq "non_null") || ($one eq "non_null" && $two eq "copied") ) {
	return "copied";
    }
    if ( ($one eq "copied" && $two eq "free") || ($one eq "free" && $two eq "copied") ) {
	return "free";
    }
    if ( ($one eq "copied" && $two eq "undefined") || ($one eq "copied" && $two eq "undefined") ) {
	return "copied";
    }
    if ( ($one eq "exported" && $two eq "copied") || ($one eq "copied" && $two eq "exported") ) {
	return "copied";
    }
    return merge_rules($name, $one, $two);
}
sub merge_rules($$$){
    my ($name, $one, $two) = @_;

    # there are two kinds of states here.
    # ones that end in __function that store the
    # the name of the function that possibly returned null.
    #
    # we treat each type of state differently but in this 
    # case we want to treat them both the same.

    if ($one eq "__none" || !$one){
	return $two;
    }
    if ($two eq "__none" || !$two){
	return $one;
    }

    my $quoted_two = quotemeta $two;
    if ($one =~ /^$quoted_two$/){
	return $one;
    }

#print get_lineno() . "Undefined! $name, $one, $two\n";
    return "undefined";
}
add_merge_function(\&merge_pointer_states);

sub dereference_and_get_var_value($) {
    my ($var) = $_[0];

    if ( $var =~ /copy of (.*) / ) {
	return get_state($1);
    } else {
	return get_state($var);
    }
}

# this is mostly used from if statements
sub dereference_and_set_var_value{
    my ($var) = $_[0];
    my ($new_value) = $_[1];
    my ($conditional) = $_[2];

    if ( get_state($var) =~ /copy of (.*)/ ) {
	$var = $1;
    }

    # do not loose "exported" stuff on conditions
    if ( get_state($var) eq "exported" && ($new_value eq "non_null" || $new_value eq "null") ) {
	return;
    }

    if ( get_state($var) ne "free" ) {
	if ( $conditional ) {
	    if ( $conditional eq "true") {
		set_true_path($var, $new_value);
	    }
	    if ( $conditional eq "false") {
		set_false_path($var, $new_value);
	    }
	} else {
	    set_state($var, $new_value);
	}
    }
}

sub remove_one_var_copy {
	my ($var) = $_[0];
	my ($vars);

	# See if there is nothing to keep track of.
	if ( get_state($var) =~ /copy of (.*)/) {
	    my ($temp) = $var;
	    $var = $1;
	    set_state($temp,get_state($var));
	} else {
	    return;
	}

	# if this is free already, no need to make it exported/copied.
	if ( get_state($var) eq "free" ) {
	    return;
	}
	if ( get_state($var) ) {
	    set_state($var, "undefined");
	}
	# Ok, let's see if there any variables holding same data as this one left.
	foreach $vars (state_names()){
	    if ( get_state($vars) eq "copy of $var") {
		if ( $vars =~ /indirect_ref/ || is_var_global ($vars) ) {
		    set_state($var, "exported");
		    return;
		} else {
		    set_state($var, "copied");
		}
	    }
	}
	return;
}

sub unchain_variable {
	my ($var) = $_[0];
	my ($vstate) = get_state($var);
	my ($vars);
	my ($replace) = "";

	# See if there is nothing to keep track of.
	if ( $vstate ne "copied" && $vstate ne "exported") {
	    return;
	}
	# Ok, let's see if there any variables holding same data as this one left.
	foreach $vars (state_names()){
	    if ( get_state($vars) eq "copy of $var") {
		if ( $replace ) {
		    set_state($vars, "copy of $replace");
		    if ( $vars =~ /(?:array_ref|indirect_ref)/ || is_var_global($vars) ) {
			set_state($replace, "exported");
		    } else {
			if ( get_state($replace) ne "exported" ) {
			    set_state($replace, "copied");
			}
		    }
		} else {
		    set_state($vars, "undefined");
		    $replace = $vars;
		}
	    }
	}
	return;
}

# if argument looks like assignment, return it's left part, otherwise
# return whole expression back
sub get_lvalue_assignment($) {
my ($wholeexpr) = $_[0];

	if ( $wholeexpr =~ /modify_expr\((.*?)\= .*\)/ ) {
		return $1;
	}
	return $wholeexpr;
}

# Takes left and right parts of assignment
sub handle_assignment ($$){
	my($src) = $_[0];
	my ($dest) = $_[1];
	my ($sstate) = get_state($src);
	my ($dstate) = get_state($dest);
	my ($zero_dstatus) = 0; # Do we need to zero out dest's state?

	# a = b = c = ...
	if ($src =~ /modify_expr\((.*?)\= (.*)\)/) {
	    $src = $1;
	    # Yeah, it's recursion.
	    handle_assignment( $2, $src);
	    $sstate = get_state($src);
	}

	# Hm. Handle a = do_something(a); stuff. This shot down number of false positives
	if ( get_state( $dest) && !($src =~ /\Q$dest\E/) ) {
	    if ( $dstate eq "undefined" || $dstate eq "non_null" ) {
		error_msg("Probably leaking memory, $dest is $dstate", $dest);
	    }
	    unchain_variable($dest);
	    remove_one_var_copy($dest);
	    $zero_dstatus = 1;
	}

       if ( $src =~ /stmt_expr compound_stmt scope_stmt block (var_decl\(.*?\))/ ) {
           my ($name) = $1;
           if (get_state($name) =~ /^blockend_(.*)/) {
               my($val) = $1;
               my($var);
               set_state($dest, $val);
               for $var (@autos) {
                   if ( $var->{name} eq $name ) {
                       # Found it, now destroy it.
                       if ( $var->{depth} eq $blocks_depth) {
                           $var->{depth}=();
                           $var->{name}=();
                           set_state($name, 0);
                           last;
                       }
                   }
               }
               return;
           } else {
               if ( get_state($name) ) {
                   error_msg("Should never get here for $name", $name);
               }
           }
       }

	# function call
	if ($src =~ /^call_expr\(\(addr_expr function_decl\((\w+?)\)\)\(tree_list: (.*)/){
	    my $func = quotemeta($1);
	    my ($arglist) = $2;

	    if (exists($alloc_funcs{$func})) {
		set_state ($dest, "undefined");
#		set_state ("$dest #__function", $function);
		return;
	    }

	    if (exists($ptrback_funcs{$func})) {
		$arglist = get_str_close_bracket($arglist);
		my ($var) = extract_argument($arglist, $ptrback_funcs{$func});
		$sstate = get_state($var);
		$src = $var;
	    }
	}

	if ($sstate){
	    if ( $sstate eq "free") {
		error_msg("Assigning freed pointer $src to $dest", $src);
	    }
	    if ( $sstate ne "null" ) {
		if ( $sstate =~ /copy of (.*)/ ) {
		    $src = $1;
		    $sstate = get_state($src);
		}
		if ( $dest =~ /indirect_ref/ || $dest =~ /array_ref/ || is_var_global($dest) ) {
		    set_state($src, "exported");
		} else {
		    # If we copy already exported var to local var,
		    # it is still exported ;)
		    if ( $sstate ne "exported" ) {
			set_state($src, "copied");
		    }
		}
		if ( $src ne $dest ) { # This can happen no matter how stupid this sounds
		    set_state ($dest, "copy of $src");
		}
	    } else {
		set_state ($dest, $sstate);
	    }
	} elsif ( $src =~ /^integer_cst\((\w+)\)/ ) {
		my ($const) = $1;
		if ( $dstate ) {
		    if ( $const eq "0") {
			set_state ($dest, "null");
		    } else {
			set_state($dest, 0);
		    }
		}
	} else { # Otherwise we do not know what is the source, so we reset
		 # destination state.
	    if ( $zero_dstatus ) {
		set_state($dest, 0);
	    }
	}

}

while ($data = get_data()){
    my $tmp;

    # if we modify something then we just going to set the start to non_null
    # temporarilly.  Then maybe later set it to undefined.
#    if ($data =~ /expr_stmt modify_expr\((.*?)\= /){
#	$variable = $1;
#	if (get_state($variable)){
#	    set_state ($variable, "non_null");
#	}
#    }

    # This is a common thing for compound statements.
    if ($data =~ /^expr_stmt (var_decl\(.*\))$/ ) {
       my ($name) = $1;
       if ( get_state($name) ) {
       my ($var);
       for $var (@autos) {
           if ( $var->{name} eq $name ) {
               # Found it, make it to not disappear.
               if ( $var->{depth} eq $blocks_depth) {
                   $var->{depth}++;
                   set_state($name, "blockend_" . get_state($name));
                   last;
               }
           }
       }
       }
       next;
    }

    # Handle the freeing of a pointer before the alloc to handle
    # realloc like functions.
    if ($data =~ /call_expr\(\(addr_expr function_decl\((\w+?)\)\)\(tree_list: (.*)/){
	my ($func) = $1;
	my ($arglist) = $2;

	if (exists($free_funcs{$func})) {
	    $arglist = get_str_close_bracket($arglist);
	    if (defined($free_funcs{$func})) {
		my ($var) = extract_argument($arglist, $free_funcs{$func});
		mark_var_freed($var);
	    } else {
		mark_var_freed($arglist); # There can be only one argument.
	    }
	}
    }

    # We need to track when pointers are passed to other variables.
    # We need to see if these are externally visible or not and so on.
    if ($data =~ /expr_stmt modify_expr\((.*?)\= (.*)\)/){
	my($src) = $2;
	my ($dest) = $1;

	handle_assignment($src,$dest);
    }

    # Start of code block. used to track scopes of variables.
    if ( $data =~ /^cmpstmt_start/ ) {
	$blocks_depth++;
    }   


    # Var declarations, we now track var scopes.
    if ($data =~ /^var_decl (\w+)\s(?:\w+\s)*\w+_type var_decl\((.*?)\)/ ) {
	my $type=$1; # Static or empty
	my $varname="var_decl($2)"; # The name of newly created variable.

	# We must use this constructions instead of simple hash arrays since there
	# might be several variables with the same name visible in different scopes
	if ( $type eq "static" || get_cur_func() eq "" ) {
	    push @globals, {name=>"$varname", depth=>$blocks_depth};
	} else {
	    push @autos, {name=>"$varname", depth=>$blocks_depth};
	}
	if ( get_state( $varname ) ) { # Reset the state if there was any.
	    set_state($varname, 0);
	}
    }

    # Var declaration with value assignment
    if ($data =~ /^var_decl .*?_type var_decl\((.*?)\)= (.*)$/ ) {
	my($src) = $2;
	my ($dest) = "var_decl($1)";

	if ( $src ) {
	    handle_assignment($src,$dest);
	}
    }

    # func (&var) and func(&var->field); case
    if ( $REFERENCE_BY_ADDRESS_IS_EXPORTED && $data =~ /call_expr\(.*function_decl\((.*?)\).*\(tree_list: (.*)/ ) {
	my ($expr) = $2;
	my ($function) = $1;
	my ($vars);

	# Special case various atomic/spinlock and so on stuff that is often
	# used with variable pointers, but does not export stuff.
	foreach $vars (state_names()){
	    if ( !get_state($vars) ) { # XXX We should not see those!!!
		next;
	    }
	    # See if we pass some of tracked stuff there
	    if ( $expr =~ /addr_expr \Q$vars\E/ || $expr =~ /non_lvalue_expr \Q$vars\E/) {
		if ( get_state($vars) eq "free" ) {
		    error_msg("Possibly passing freed value to function $vars, $function","$vars");
		} else {
		    if ( !($function =~ /^(?:atomic_|spin_)/ ) ) {
			dereference_and_set_var_value( $vars,"exported","");
		    }
		}
	    } else {
		if ($vars =~ /component_ref\(\((.*?)\)\(/ ) {
		    my ($var) = $1;
		    if ( $expr =~ /addr_expr \Q$var\E/ || $expr =~ /non_lvalue_expr \Q$var\E/) {
			if ( get_state($vars) eq "free" ) {
			    error_msg("Possibly passing pointer freed value to function $vars","$vars");
			} else {
			    if ( !($function =~ /^(?:atomic_|spin_)/ ) ) {
				dereference_and_set_var_value( $vars,"exported","");
			    }
			}
		    }
		}
		if ($vars =~ /component_ref\(\(indirect_ref (.*?)\)\(/ ) {
		    my ($var) = $1;
		    if ( $expr =~ /addr_expr \Q$var\E/ || $expr =~ /non_lvalue_expr \Q$var\E/) {
			if ( get_state($vars) eq "free" ) {
			    error_msg("Possibly passing pointer to freed value (part of structure) to function $vars","$vars");
			} else {
			    if ( !($function =~ /^(?:atomic_|spin_)/ ) ) {
				dereference_and_set_var_value( $vars,"exported","");
			    }
			}
		    }
		}
	    }
	}

    }

    # list_add alikes
    if ( $ENABLE_LIST_FUNCS && $data =~ /call_expr\(.*function_decl\((.*?)\).*\(tree_list: (.*)\)/ ) {
	my ($func) = $1;
	my ($args) = $2;

	# See if this is call to one of matching functions
	if (exists($list_funcs{$func})) {
	    my ($vars);
	    foreach $vars (state_names()){
		if ( !get_state($vars) ) { # XXX We should not see those!!!
		    next;
		}
		# See if we pass some of tracked stuff there
		if ( $args =~ /\Q$vars\E/ ) {
		    if ( get_state($vars) eq "free" ) {
			error_msg("Possibly passing freed value of $vars to function $func","$vars");
		    } else {
			dereference_and_set_var_value( $vars,"exported","");
		    }
		} elsif ( !($vars =~ /(?:array_ref|indirect_ref)/) && $vars =~ /^component_ref\(.*(var_decl\(.*?\))/ ) {
		    # This is for passing structures
		    my ($parent) = $1;
		    if ( $args =~ /\Qaddr_expr $parent\E/ ) {
			dereference_and_set_var_value( $vars,"exported","");
		    }
		}
	    }
	}
    }

#    if ( $data =~ /function_decl\(list_add.*\)\)\(tree_list: (.*?),.*/ ) {
#	my ($var) = $1;
#	if ( get_state($var) ) {
#	    dereference_and_set_var_value( $var,"exported","");
#	}
#    }

    # if we see "foo = kmalloc ()" then we store foo
    # as "undefined"
    #modify_expr(var_decl(foo)= call_expr((addr_expr function_decl(.*alloc))()))
#    if ($data =~ /expr_stmt modify_expr\((.*?)\= call_expr\(\(addr_expr function_decl\((\w+?)\)/){
#	$variable = $1;
#	$function = quotemeta($2);
#	#if (`grep ^$function\$ list_null_funcs_uniq`){
#	if ($function =~/^.*alloc$/){
#	    #print get_filename(), " ", get_lineno(), " ", "$variable undefined";
#	    set_state ($variable, "undefined");
#	    set_state ("$variable __function", $function);
#	}
#    }

    # split_conds is from ifcond.pm.  It simplifies handling of compound conditions
    # for example:
    # if (!a || !b) { tells us that on the false path a is non_null
    # if (a && b) { tells us that on the true path a is non_null
    
    # it turns out that it is important to check for_statements as well.
    # a lot of code does stuff like for( ; foo = next_token(); ){

    if (($data =~ /^(?:if_cond|while_cond) (.*)/) || ($data =~ /^for_stmt.*?; (.*?);/)){
	my $wholecond = $1;
	my %conds = split_conds($wholecond);

	# handle assignments in if/while/for conditions
	if ( $wholecond =~ /modify_expr\((.*?)\= (.*)\)/) {
            handle_assignment( $2, $1);
        }

	for my $cond (@{$conds{truepath}}){
	    if ($cond =~ /^compound_cond/){
		next;
	    }

	    if ($cond =~ /eq_expr\(\((.*)\)\((.*)$/) {
		my $rest = $2;
		my $name = get_lvalue_assignment($1);
		if (get_state($name)) {
		    if ($rest =~ /^integer_cst\(0\)\)\)/) {
			dereference_and_set_var_value($name,"null", "true");
		    } elsif ($rest =~ /^addr_expr (.*)\)\)/) {
			# Check if the variable points to a buffer on the stack
			my $stackvar = $1;
			foreach my $var (@autos) {
			    if (($var->{'name'} eq $stackvar) && !get_state($stackvar)) {
				dereference_and_set_var_value($name,"free", "true");
				last;
			    }
			}
		    } elsif ($rest =~ /^(parm_decl\(.*\))\)\)/) {
			# Check if the variable is a function argument
			my $argvar = $1;
			if (!get_state($argvar)) {
			    dereference_and_set_var_value($name,"free", "true");
			    last;
			}
		    }
		}
	    }elsif(($cond =~ /ne_expr\(\((.*)\)\(integer_cst\(0\)\)\)/) ){
		my $name = get_lvalue_assignment($1);
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } elsif ( dereference_and_get_var_value ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
		    } else {
			dereference_and_set_var_value($name,"non_null","true");
		    }
		}
	    }
	    if ( ! ($cond =~ /(?:eq|ne)_expr/) ) {
		my $name = get_lvalue_assignment($cond);
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } elsif ( dereference_and_get_var_value ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
		    } else {
			dereference_and_set_var_value($name,"non_null","true");
		    }
		}
	    }
	}
	for my $cond (@{$conds{falsepath}}){

	    if ($cond =~ /^compound_cond/){
		next;
	    }

	    if ($cond =~ /eq_expr\(\((.*)\)\(integer_cst\(0\)\)\)/){
		my $name = get_lvalue_assignment($1);
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } elsif ( dereference_and_get_var_value ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
		    } else {
			dereference_and_set_var_value($name,"non_null","false");
		    }
		}
	    }elsif(($cond =~ /ne_expr\(\((.*)\)\((.*)$/) ){
		my $rest = $2;
		my $name = get_lvalue_assignment($1);
		if (get_state ($name)) {
		    if ($rest =~ /^integer_cst\(0\)\)\)/) {
			if ( dereference_and_get_var_value ($name) eq "free"){
			    error_msg("Comparing value of freed $name", $name);
			} elsif ( get_state ($name) eq "null" ) {
			    error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
			} else {
			    dereference_and_set_var_value($name,"null","false");
			}
		    } elsif ($rest =~ /^addr_expr (.*)\)\)/) {
			# Check if the variable points to a buffer on the stack
			my $stackvar = $1;
			foreach my $var (@autos) {
			    if (($var->{'name'} eq $stackvar) && !get_state($stackvar)) {

				# It's not an alloced mem block but one from the stack
				dereference_and_set_var_value($name,"free", "false");
				last;
			    }
			}
		    } elsif ($rest =~ /^(parm_decl\(.*\))\)\)/) {
			# Check if the variable is a function argument
			my $argvar = $1;
			if (!get_state($argvar)) {
			    dereference_and_set_var_value($name,"free", "false");
			    last;
			}
		    }
		}
	    }
	    if ( ! ($cond =~ /(?:eq|ne)_expr/) ) {
		my $name = get_lvalue_assignment($cond);
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } elsif ( get_state ($name) eq "null" ) {
			error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
		    } else {
			dereference_and_set_var_value($name,"null","false");
		    }
		}
	    }
	}
    }elsif ($data =~ /^do_cond (.*)/){            # check do while() for thouroughness
	$conds = split_conds($1);
	for my $cond (@{$conds{falsepath}}){
	    if ($cond =~ /^compound_cond/){
		next;
	    }

	    if ($cond =~ /eq_expr\(\((.*)\)\(integer_cst\(0\)\)\)/){
		my $name = get_lvalue_assignment($1);
		if (get_state ($name)) { 
		    if ( get_state ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } elsif ( get_state ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
		    } else {
			dereference_and_set_var_value($name,"non_null","");
		    }
		}
	    }elsif(($cond =~ /ne_expr\(\((.*)\)\(integer_cst\(0\)\)\)/) ){
		my $name = get_lvalue_assignment($1);
		if (get_state ($name)) { 
		    if ( get_state ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } elsif ( get_state ($name) eq "null" ) {
			error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
		    } else {
			dereference_and_set_var_value($name,"null", "");
		    }
		}
	    }
	}
	if ( ! ($cond =~ /(?:eq|ne)_expr/) ) {
		my $name = get_lvalue_assignment($cond);
		if (get_state ($name)) { 
		    if ( get_state ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } elsif ( get_state ($name) eq "null" ) {
			error_msg("Redundant always true comparison on $name", $name) unless $NO_REDUNDANT_COMP;
		    } else {
			dereference_and_set_var_value($name,"null","");
		    }
		}
	}
    }
    
    if ( $data =~ /^return_stmt(.*)/ ) {
	my ($retval) = $1;
	my ($var);

	# did we return anything?
	if ($retval =~ / modify_expr\(result_decl (.*)/) {
	    $retval = $1;
	}
	# cast return value to something case
	if ( $retval =~ /^.*_type = (.*)\)$/ ) {
	    $retval = $1;
	}

	foreach $var (state_names()){
	    my $state = get_state($var);
	    if ( $state =~ /^(?:non_null|undefined|copied)/ && !($var =~ /indirect_ref/) ) {
		# If we do not return this, then we leak it.
		if ( ! ($retval =~ /\Q$var\E/) && ! (get_state($retval) eq "copy of $var" ) && !is_var_global($var) && ! ( $var =~ /(?:indirect_ref|array_ref)/) ) {
		    my $msg = "Probably leaking memory: $var" . " unfreed " . $state;
		    error_msg($msg, $var);
		}
	    }
	    # See if we exporting anything freed outside
	    if ( $state =~ /copy of (.*)/ && $var =~ /indirect_ref/ ) {
		my ($ref) = $1;
		if ( get_state($ref) eq "free" ) {
		    error_msg("Freed pointer is visible from outside $var", $ref);
		}
	    }
		
	    if ( $retval =~ /\Q$var\E/ ) {
		if ($state eq "free" ){
		    error_msg("Returning with freed result $var",$var);
		}
	    }

	}
    }

    # if it returns a negative constant or a NULL then it is an error path which need some special threatment
if ( $EXPORTED_ON_EXIT_IS_BAD ) {
    if (($data =~ /^return_stmt modify_expr\(result_decl integer_type = integer_cst\(-\d+\)\)/)
	or ($data =~ /^return_stmt modify_expr\(result_decl pointer_type = integer_cst\(0\)\)/)){
	my $state;
	foreach $state (state_names()){
	    my $state_state = get_state($state);
	    if ($state_state =~ /^(?:non_null|undefined|exported|copied)/ && !is_var_global($state) ){
		my $msg = $state . " unfreed " . $state_state;
		error_msg($msg, $state);
	    }
	}
    }
}

    # End of code block, see if some variables left the scope.
    if ( $data =~ /^cmpstmt_end/ ) {
	my $var;
	# Ok, block end, some variables fell out of scope, let's check their contents.
	# First check globals, we simply destroy globals, as it's ok to have unfreed globals
	for $var (@globals) {
	    if ( $var->{depth} == $blocks_depth ) {
		$var->{depth}=();
		$var->{name}=();
	    }
	}
	# Now check locals. This case is more interesting, we can track variables that were destroyed,
	# but whose content was not freed.
	for $var (@autos) {
	    if ( $var->{depth} == $blocks_depth ) {
		my $name = $var->{name};
		my $state = get_state( $name );
		if ( $state =~ /^(?:non_null|undefined)/ ) {
		    # If we do not return this, then we leak it.
                    my $msg = "Probably leaking memory (leaving scope): $name" . " unfreed " . $state;
                    error_msg($msg, $name);
                }
		$var->{depth}=();
		$var->{name}=();
		unchain_variable($name);
		remove_one_var_copy($name);
		set_state($name, 0);
	    }
	}

	$blocks_depth--;
	if ( $blocks_depth < 0 ) {
	    print "Oh, no, we are failing completely out of scope in " . get_filename() . " at " . get_lineno() . "\n";
	    exit (-1);
	}
    }


}
