actions.c

gcc-2.95.3 Linux下最常用的C编译器

/*
 * There are four conditions to generate a runtime check:
 *    1) assigning a longer INT to a shorter (signs irrelevant)
 *    2) assigning a signed to an unsigned
 *    3) assigning an unsigned to a signed of the same size.
 *    4) TYPE is a discrete subrange
 */
tree
chill_convert_for_assignment (type, expr, place)
     tree type, expr;
     char *place; /* location description for error messages */
{
  tree ttype = type;
  tree etype = TREE_TYPE (expr);
  tree result;

  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
    return error_mark_node;
  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
    return expr;
  if (TREE_CODE (expr) == TYPE_DECL)
    {
      error ("right hand side of assignment is a mode");
      return error_mark_node;
    }

  if (! CH_COMPATIBLE (expr, type))
    {
      error ("incompatible modes in %s", place);
      return error_mark_node;
    }

  if (TREE_CODE (type) == REFERENCE_TYPE)
    ttype = TREE_TYPE (ttype);
  if (etype && TREE_CODE (etype) == REFERENCE_TYPE)
    etype = TREE_TYPE (etype);

  if (etype
      && (CH_STRING_TYPE_P (ttype)
	  || (chill_varying_type_p (ttype)
	      && CH_STRING_TYPE_P (CH_VARYING_ARRAY_TYPE (ttype))))
      && (CH_STRING_TYPE_P (etype)
	  || (chill_varying_type_p (etype)
	      && CH_STRING_TYPE_P (CH_VARYING_ARRAY_TYPE (etype)))))
    {
      tree cond;
      if (range_checking)
	expr = save_if_needed (expr);
      cond = string_assignment_condition (ttype, expr);
      if (TREE_CODE (cond) == INTEGER_CST)
	{
	  if (integer_zerop (cond))
	    {
	      error ("bad string length in %s", place);
	      return error_mark_node;
	    }
	  /* Otherwise, the condition is always true, so no runtime test. */
	}
      else if (range_checking)
	expr = check_expression (expr,
				 invert_truthvalue (cond),
				 ridpointers[(int) RID_RANGEFAIL]);
    }

  if (range_checking 
      && discrete_type_p (ttype) 
      && etype != NULL_TREE
      && discrete_type_p (etype))
    {
      int cond1 = tree_int_cst_lt (TYPE_SIZE (ttype),
				   TYPE_SIZE (etype));
      int cond2 = TREE_UNSIGNED (ttype) 
	          && (! TREE_UNSIGNED (etype));
      int cond3 = (! TREE_UNSIGNED (type))
	          && TREE_UNSIGNED (etype) 
		  && tree_int_cst_equal (TYPE_SIZE (ttype),
					 TYPE_SIZE (etype));
      int cond4 = TREE_TYPE (ttype) 
	          && discrete_type_p (TREE_TYPE (ttype));

      if (cond1 || cond2 || cond3 || cond4)
	{
	  tree type_min = TYPE_MIN_VALUE (ttype);
	  tree type_max = TYPE_MAX_VALUE (ttype);

	  expr = save_if_needed (expr);
	  if (expr && type_min && type_max)
	    expr = check_range (expr, expr, type_min, type_max);
	}
    }
  result = convert (type, expr);

  /* If the type is a array of PACK bits and the expression is an array constructor,
     then build a CONSTRUCTOR for a bitstring.  Bitstrings are zero based, so
     decrement the value of each CONSTRUCTOR element by the amount of the lower
     bound of the array.  */
  if (TREE_CODE (type) == ARRAY_TYPE && TYPE_PACKED (type)
      && TREE_CODE (result) == CONSTRUCTOR)
    {
      tree domain_min = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
      tree new_list = NULL_TREE;
      long index;
      tree element;
      for (element = TREE_OPERAND (result, 1);
	   element != NULL_TREE;
	   element = TREE_CHAIN (element))
	{
	  if (!tree_int_cst_equal (TREE_VALUE (element), integer_zero_node))
	    {
	      tree purpose = TREE_PURPOSE (element);
	      switch (TREE_CODE (purpose))
		{
		case INTEGER_CST:
		  new_list = tree_cons (NULL_TREE,
					size_binop (MINUS_EXPR, purpose, domain_min),
					new_list);
		  break;
		case RANGE_EXPR:
		  for (index  = TREE_INT_CST_LOW (TREE_OPERAND (purpose, 0));
		       index <= TREE_INT_CST_LOW (TREE_OPERAND (purpose, 1));
		       index++)
		    new_list = tree_cons (NULL_TREE,
					  size_binop (MINUS_EXPR,
						      build_int_2 (index, 0),
						      domain_min),
					  new_list);
		  break;
		default:
		  abort ();
		}
	    }
	}
      result = copy_node (result);
      TREE_OPERAND (result, 1) = nreverse (new_list);
      TREE_TYPE (result) = build_bitstring_type (TYPE_SIZE (type));
    }

  return result;
}

/* Check that EXPR has valid type for a RETURN or RESULT expression,
   converting to the right type.  ACTION is "RESULT" or "RETURN". */

static tree
adjust_return_value (expr, action)
     tree expr;
     char *action;
{
  tree type = TREE_TYPE (TREE_TYPE (current_function_decl));

  if (TREE_CODE (type) == REFERENCE_TYPE)
    {
      if (CH_LOCATION_P (expr))
	{
	  if (! CH_READ_COMPATIBLE (TREE_TYPE (type), 
				    TREE_TYPE (expr)))
	    {
	      error ("mode mismatch in %s expression", action);
	      return error_mark_node;
	    }
	  return convert (type, expr);
	}
      else
	{
	  error ("%s expression must be referable", action);
	  return error_mark_node;
	}
    }
  else if (! CH_COMPATIBLE (expr, type))
    {
      error ("mode mismatch in %s expression", action);
      return error_mark_node;
    }
  return convert (type, expr);
}

void
chill_expand_result (expr, result_or_return)
     tree expr;
     int result_or_return;
{
  tree type;
  char *action_name = result_or_return ? "RESULT" : "RETURN";
  
  if (pass == 1)
    return;

  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
    return;

  CH_FUNCTION_SETS_RESULT (current_function_decl) = 1;

  if (chill_at_module_level || global_bindings_p ())
    error ("%s not allowed outside a PROC", action_name);

  result_never_set = 0;

  if (chill_result_decl == NULL_TREE)
    {
      error ("%s action in PROC with no declared RESULTS", action_name);
      return;
    }
  type = TREE_TYPE (chill_result_decl);

  if (TREE_CODE (type) == ERROR_MARK)
    return;

  expr = adjust_return_value (expr, action_name);

  expand_expr_stmt (build_chill_modify_expr (chill_result_decl, expr));
}

/*
 * error if EXPR not NULL and procedure doesn't
 * have a return type; 
 * warning if EXPR NULL,
 * procedure *has* a return type, and a previous
 * RESULT actions hasn't saved a return value.
 */
void
chill_expand_return (expr, implicit)
     tree expr;
     int implicit; /* 1 if an implicit return at end of function. */
{
  tree valtype;

  if (expr != NULL_TREE && TREE_CODE (expr) == ERROR_MARK)
    return;
  if (chill_at_module_level || global_bindings_p ())
    {
      error ("RETURN not allowed outside PROC");
      return;
    }

  if (pass == 1)
    return;

  result_never_set = 0;

  valtype = TREE_TYPE (TREE_TYPE (current_function_decl));
  if (TREE_CODE (valtype) == VOID_TYPE)
    {
      if (expr != NULL_TREE)
	error ("RETURN with a value, in PROC returning void");
      expand_null_return ();
    }
  else if (TREE_CODE (valtype) != ERROR_MARK)
    {
      if (expr == NULL_TREE)
	{
	  if (!CH_FUNCTION_SETS_RESULT (current_function_decl)
	      && !implicit)
	    warning ("RETURN with no value and no RESULT action in procedure");
	  expr = chill_result_decl;
	}
      else
	expr = adjust_return_value (expr, "RETURN");
      expr = build (MODIFY_EXPR, valtype,
		    DECL_RESULT (current_function_decl),
		    expr);
      TREE_SIDE_EFFECTS (expr) = 1;
      expand_return (expr);
    }
}

void
lookup_and_expand_goto (name)
     tree name;
{
  if (name == NULL_TREE ||  TREE_CODE (name) == ERROR_MARK)
    return;
  if (!ignoring)
    {
      tree decl = lookup_name (name);
      if (decl == NULL || TREE_CODE (decl) != LABEL_DECL)
	error ("no label named `%s'", IDENTIFIER_POINTER (name));
      else if (DECL_CONTEXT (decl) != current_function_decl)
	error ("cannot GOTO label `%s' outside current function",
	       IDENTIFIER_POINTER (name));
      else
	{
	  TREE_USED (decl) = 1;
	  expand_goto_except_cleanup (DECL_ACTION_NESTING_LEVEL (decl));
	  expand_goto (decl);
	}
    }
}

void
lookup_and_handle_exit (name)
     tree name;
{
  if (name == NULL_TREE ||  TREE_CODE (name) == ERROR_MARK)
    return;
  if (!ignoring)
    {
      tree label = munge_exit_label (name);
      tree decl = lookup_name (label);
      if (decl == NULL || TREE_CODE (decl) != LABEL_DECL)
	error ("no EXITable label named `%s'", IDENTIFIER_POINTER (name));
      else if (DECL_CONTEXT (decl) != current_function_decl)
	error ("cannot EXIT label `%s' outside current function",
	       IDENTIFIER_POINTER (name));
      else
	{
	  TREE_USED (decl) = 1;
	  expand_goto_except_cleanup (DECL_ACTION_NESTING_LEVEL (decl));
	  expand_goto (decl);
	}
    }
}

/* ELSE-range handling: The else-range is a chain of trees which collectively
   represent the ranges to be tested for the (ELSE) case label. Each element in
   the chain represents a range to be tested. The boundaries of the range are
   represented by INTEGER_CST trees in the PURPOSE and VALUE fields. */

/* This function updates the else-range by removing the given integer constant. */
static tree
update_else_range_for_int_const (else_range, label)
     tree else_range, label;
{
  int  lowval, highval;
  int  label_value = TREE_INT_CST_LOW (label);
  tree this_range, prev_range, new_range;

  /* First, find the range element containing the integer, if it exists. */
  prev_range = NULL_TREE;
  for (this_range = else_range ;
       this_range != NULL_TREE;
       this_range = TREE_CHAIN (this_range))
    {
      lowval  = TREE_INT_CST_LOW (TREE_PURPOSE (this_range));
      highval = TREE_INT_CST_LOW (TREE_VALUE (this_range));
      if (label_value >= lowval && label_value <= highval)
	break;
      prev_range = this_range;
    }

  /* If a range element containing the integer was found, then update the range. */
  if (this_range != NULL_TREE)
    {
      tree next = TREE_CHAIN (this_range);
      if (label_value == lowval)
	{
	  /* The integer is the lower bound of the range element. If it is also the
	     upper bound, then remove this range element, otherwise update it. */
	  if (label_value == highval)
	    {
	      if (prev_range == NULL_TREE)
		else_range = next;
	      else
		TREE_CHAIN (prev_range) = next;
	    }
	  else
	    TREE_PURPOSE (this_range) = build_int_2 (label_value + 1, 0);
	}
      else if (label_value == highval)
	{
	  /* The integer is the upper bound of the range element, so ajust it. */
	  TREE_VALUE (this_range) = build_int_2 (label_value - 1, 0);
	}
      else
	{
	  /* The integer is in the middle of the range element, so split it. */
	  new_range = tree_cons (
            build_int_2 (label_value + 1, 0), TREE_VALUE (this_range), next);
	  TREE_VALUE (this_range) = build_int_2 (label_value - 1, 0);
	  TREE_CHAIN (this_range) = new_range;
	}
    }
  return else_range;
}

/* Update the else-range to remove a range of values/ */
static tree
update_else_range_for_range (else_range, low_target, high_target)
     tree else_range, low_target, high_target;
{
  tree this_range, prev_range, new_range, next_range;
  int  low_range_val, high_range_val;
  int  low_target_val  = TREE_INT_CST_LOW (low_target);
  int  high_target_val = TREE_INT_CST_LOW (high_target);

  /* find the first else-range element which overlaps the target range. */
  prev_range = NULL_TREE;
  for (this_range = else_range ;
       this_range != NULL_TREE;
       this_range = TREE_CHAIN (this_range))
    {
      low_range_val  = TREE_INT_CST_LOW (TREE_PURPOSE (this_range));
      high_range_val = TREE_INT_CST_LOW (TREE_VALUE (this_range));
      if ((low_target_val >= low_range_val && low_target_val <= high_range_val)
	  || (high_target_val >= low_range_val && high_target_val <= high_range_val))
	break;
      prev_range = this_range;
    }
  if (this_range == NULL_TREE)
    return else_range;

  /* This first else-range element might be truncated at the top or completely
     contain the target range. */
  if (low_range_val < low_target_val)
    {
      next_range = TREE_CHAIN (this_range);
      if (high_range_val > high_target_val)
	{
	  new_range = tree_cons (
            build_int_2 (high_target_val + 1, 0), TREE_VALUE (this_range), next_range);
	  TREE_VALUE (this_range) = build_int_2 (low_target_val - 1, 0);
	  TREE_CHAIN (this_range) = new_range;
	  return else_range;
	}

      TREE_VALUE (this_range) = build_int_2 (low_target_val - 1, 0);
      if (next_range == NULL_TREE)
	return else_range;

      prev_range = this_range;
      this_range = next_range;
      high_range_val = TREE_INT_CST_LOW (TREE_VALUE (this_range));
    }

  /* There may then follow zero or more else-range elements which are completely
     contained in the target range. */
  while (high_range_val <= high_target_val)
    {
      this_range = TREE_CHAIN (this_range);
      if (prev_range == NULL_TREE)
	else_range = this_range;
      else
	TREE_CHAIN (prev_range) = this_range;

      if (this_range == NULL_TREE)
	return else_range;
      high_range_val = TREE_INT_CST_LOW (TREE_VALUE (this_range));
    }

  /* Finally, there may be a else-range element which is truncated at the bottom. */
  low_range_val = TREE_INT_CST_LOW (TREE_PURPOSE (this_range));
  if (low_range_val <= high_target_val)
    TREE_PURPOSE (this_range) = build_int_2 (high_target_val + 1, 0);

  return else_range;
}

static tree
update_else_range_for_range_expr (else_range, label)
     tree else_range, label;
{
  if (TREE_OPERAND (label, 0) == NULL_TREE)
    {