typeck.c

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

/* Build expressions with type checking for CHILL compiler.
   Copyright (C) 1992, 93, 1994, 1998, 1999 Free Software Foundation, Inc.

This file is part of GNU CC.

GNU CC is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU CC is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU CC; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */


/* This file is part of the CHILL front end.
   It contains routines to build C expressions given their operands,
   including computing the modes of the result, C-specific error checks,
   and some optimization.

   There are also routines to build RETURN_STMT nodes and CASE_STMT nodes,
   and to process initializations in declarations (since they work
   like a strange sort of assignment).  */

#include "config.h"
#include "system.h"
#include "tree.h"
#include "ch-tree.h"
#include "flags.h"
#include "rtl.h"
#include "expr.h"
#include "lex.h"
#include "toplev.h"

extern tree intQI_type_node;
extern tree intHI_type_node;
extern tree intSI_type_node;
extern tree intDI_type_node;
#if HOST_BITS_PER_WIDE_INT >= 64
extern tree intTI_type_node;
#endif

extern tree unsigned_intQI_type_node;
extern tree unsigned_intHI_type_node;
extern tree unsigned_intSI_type_node;
extern tree unsigned_intDI_type_node;
#if HOST_BITS_PER_WIDE_INT >= 64
extern tree unsigned_intTI_type_node;
#endif

/* forward declarations */
static int chill_l_equivalent PROTO((tree, tree, struct mode_chain*));
static tree extract_constant_from_buffer PROTO((tree, unsigned char *, int));
static int expand_constant_to_buffer PROTO((tree, unsigned char *, int));

/*
 * This function checks an array access.
 * It calls error (ERROR_MESSAGE) if the condition (index <= domain max value
 *                                     index >= domain min value)
 *                   is not met at compile time,
 *         If a runtime test is required and permitted,
 *         check_expression is used to do so.
 * the global RANGE_CHECKING flags controls the
 * generation of runtime checking code.
 */
tree
valid_array_index_p (array, idx, error_message, is_varying_lhs)
     tree array, idx;
     char *error_message;
     int is_varying_lhs;
{
  tree cond, low_limit, high_cond, atype, domain;
  tree orig_index = idx;
  enum chill_tree_code condition;

  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK
      || idx == NULL_TREE || TREE_CODE (idx) == ERROR_MARK)
    return error_mark_node;
  
  if (TREE_CODE (idx) == TYPE_DECL
      || TREE_CODE_CLASS (TREE_CODE (idx)) == 't')
    {
      error ("array or string index is a mode (instead of a value)");
      return error_mark_node;
    }

  atype = TREE_TYPE (array);

  if (chill_varying_type_p (atype))
    {
      domain = TYPE_DOMAIN (CH_VARYING_ARRAY_TYPE (atype));
      high_cond = build_component_ref (array, var_length_id);
      if (chill_varying_string_type_p (atype))
	{
	  if (is_varying_lhs)
	    condition = GT_EXPR;
	  else
	    condition = GE_EXPR;
	}
      else
	condition = GT_EXPR;
    }
  else
    {
      domain = TYPE_DOMAIN (atype);
      high_cond = TYPE_MAX_VALUE (domain);
      condition = GT_EXPR;
    }

  if (CH_STRING_TYPE_P (atype))
    {
      if (! CH_SIMILAR (TREE_TYPE (orig_index), integer_type_node))
	{
	  error ("index is not an integer expression");
	  return error_mark_node;
	}
    }
  else
    {
      if (! CH_COMPATIBLE (orig_index, domain))
	{
	  error ("index not compatible with index mode");
	  return error_mark_node;
	}
    }

  /* Convert BOOLS(1) to BOOL and CHARS(1) to CHAR. */
  if (flag_old_strings)
    {
      idx = convert_to_discrete (idx);
      if (idx == NULL) /* should never happen */
	error ("index is not discrete");
    }

  /* we know we'll refer to this value twice */
  if (range_checking)
    idx = save_expr (idx);

  low_limit = TYPE_MIN_VALUE (domain);
  high_cond = build_compare_discrete_expr (condition, idx, high_cond);

  /* an invalid index expression meets this condition */
  cond = fold (build (TRUTH_ORIF_EXPR, boolean_type_node,
	   build_compare_discrete_expr (LT_EXPR, idx, low_limit),
	     high_cond));

  /* strip a redundant NOP_EXPR */
  if (TREE_CODE (cond) == NOP_EXPR
      && TREE_TYPE (cond) == boolean_type_node
      && TREE_CODE (TREE_OPERAND (cond, 0)) == INTEGER_CST)
    cond = TREE_OPERAND (cond, 0);
      
  idx = convert (CH_STRING_TYPE_P (atype) ? integer_type_node : domain,
		 idx);

  if (TREE_CODE (cond) == INTEGER_CST)
    {
      if (tree_int_cst_equal (cond, boolean_false_node))
	return idx;       /* condition met at compile time */
      error (error_message); /* condition failed at compile time */
      return error_mark_node;
    }
  else if (range_checking)
    {
      /* FIXME: often, several of these conditions will
	 be generated for the same source file and line number.
	 A great optimization would be to share the
	 cause_exception function call among them rather
	 than generating a cause_exception call for each. */
      return check_expression (idx, cond,
			       ridpointers[(int) RID_RANGEFAIL]);
    }
  else
    return idx;           /* don't know at compile time */
}

/*
 * Extract a slice from an array, which could look like a
 * SET_TYPE if it's a bitstring.  The array could also be VARYING
 * if the element type is CHAR.  The min_value and length values 
 * must have already been checked with valid_array_index_p.  No 
 * checking is done here.
 */
tree
build_chill_slice (array, min_value, length)
     tree array, min_value, length;
{
  tree result;
  tree array_type = TREE_TYPE (array);

  if (!CH_REFERABLE (array) && TREE_CODE (array) != SAVE_EXPR
      && (TREE_CODE (array) != COMPONENT_REF
	   || TREE_CODE (TREE_OPERAND (array, 0)) != SAVE_EXPR))
    {
      if (!TREE_CONSTANT (array))
	warning ("possible internal error - slice argument is neither referable nor constant");
      else
	{
	  /* Force to storage.
	     NOTE:  This could mean multiple identical copies of
	     the same constant.  FIXME. */
	  tree mydecl = decl_temp1 (get_unique_identifier("SLICEE"),
				    array_type, 1, array, 0, 0);
	  TREE_READONLY (mydecl) = 1;
	  /* mark_addressable (mydecl); FIXME: necessary? */
	  array = mydecl;
	}
    }

  /*
     The code-generation which uses a slice tree needs not only to
     know the dynamic upper and lower limits of that slice, but the
     original static allocation, to use to build temps where one or both
     of the dynamic limits must be calculated at runtime..  We pass the
     dynamic size by building a new array_type whose limits are the
     min_value and min_value + length values passed to us.  
     
     The static allocation info is passed by using the parent array's
     limits to compute a temp_size, which is passed in the lang_specific
     field of the slice_type.
   */
     
  if (TREE_CODE (array_type) == ARRAY_TYPE)
    {
      tree domain_type = TYPE_DOMAIN (array_type);
      tree domain_min = TYPE_MIN_VALUE (domain_type);
      tree domain_max = fold (build (PLUS_EXPR, domain_type,
				     domain_min,
				     size_binop (MINUS_EXPR,
						 length, integer_one_node)));
      tree index_type = build_chill_range_type (TYPE_DOMAIN (array_type),
						domain_min,
						domain_max);

      tree element_type = TREE_TYPE (array_type);
      tree slice_type = build_simple_array_type (element_type, index_type, NULL_TREE);
      tree slice_pointer_type;
      tree max_size;

      if (CH_CHARS_TYPE_P (array_type))
	MARK_AS_STRING_TYPE (slice_type);
      else
	TYPE_PACKED (slice_type) = TYPE_PACKED (array_type);

      SET_CH_NOVELTY (slice_type, CH_NOVELTY (array_type));

      if (TREE_CONSTANT (array) && TREE_CODE (min_value) == INTEGER_CST
	  && TREE_CODE (length) == INTEGER_CST)
	{
	  int type_size = int_size_in_bytes (array_type);
	  unsigned char *buffer = (unsigned char*) alloca (type_size);
	  int delta = int_size_in_bytes (element_type)
	    * (TREE_INT_CST_LOW (min_value) - TREE_INT_CST_LOW (domain_min));
	  bzero (buffer, type_size);
	  if (expand_constant_to_buffer (array, buffer, type_size))
	    {
	      result = extract_constant_from_buffer (slice_type,
						     buffer + delta,
						     type_size - delta);
	      if (result)
		return result;
	    }
	}

      /* Kludge used by case CONCAT_EXPR in chill_expand_expr.
	 Set TYPE_ARRAY_MAX_SIZE to a constant upper bound on the
	 bytes needed. */
      max_size = size_in_bytes (slice_type);
      if (TREE_CODE (max_size) != INTEGER_CST)
	{
	  max_size = TYPE_ARRAY_MAX_SIZE (array_type);
	  if (max_size == NULL_TREE)
	    max_size = size_in_bytes (array_type);
	}
      TYPE_ARRAY_MAX_SIZE (slice_type) = max_size;

      mark_addressable (array);
      /* Contruct a SLICE_EXPR to represent a slice of a packed array of bits. */
      if (TYPE_PACKED (array_type))
	{
	  if (pass == 2 && TREE_CODE (length) != INTEGER_CST)
	    {
	      sorry ("bit array slice with non-constant length");
	      return error_mark_node;
	    }
	  if (domain_min && ! integer_zerop (domain_min))
	    min_value = size_binop (MINUS_EXPR, min_value,
				    convert (sizetype, domain_min));
	  result = build (SLICE_EXPR, slice_type, array, min_value, length);
	  TREE_READONLY (result)
	    = TREE_READONLY (array) | TYPE_READONLY (TREE_TYPE (array_type));
	  return result;
	}

      slice_pointer_type = build_chill_pointer_type (slice_type);
      if (TREE_CODE (min_value) == INTEGER_CST
	  && domain_min && TREE_CODE (domain_min) == INTEGER_CST
	  && compare_int_csts (EQ_EXPR, min_value, domain_min))
	result = fold (build1 (ADDR_EXPR, slice_pointer_type, array));
      else
	{
	  min_value = convert (sizetype, min_value);
	  if (domain_min && ! integer_zerop (domain_min))
	    min_value = size_binop (MINUS_EXPR, min_value,
				    convert (sizetype, domain_min));
	  min_value = size_binop (MULT_EXPR, min_value,
				  size_in_bytes (element_type));
	  result = fold (build (PLUS_EXPR, slice_pointer_type,
				build1 (ADDR_EXPR, slice_pointer_type,
					array),
				convert (slice_pointer_type, min_value)));
	}
      /* Return the final array value. */
      result = fold (build1 (INDIRECT_REF, slice_type, result));
      TREE_READONLY (result)
	= TREE_READONLY (array) | TYPE_READONLY (element_type);
      return result;
    }
  else if (TREE_CODE (array_type) == SET_TYPE)  /* actually a bitstring */
    {
      if (pass == 2 && TREE_CODE (length) != INTEGER_CST)
	{
	  sorry ("bitstring slice with non-constant length");
	  return error_mark_node;
	}
      result = build (SLICE_EXPR, build_bitstring_type (length),
		      array, min_value, length);
      TREE_READONLY (result)
	= TREE_READONLY (array) | TYPE_READONLY (TREE_TYPE (array_type));
      return result;
    }
  else if (chill_varying_type_p (array_type))
      return build_chill_slice (varying_to_slice (array), min_value, length);
  else
    {
      error ("slice operation on non-array, non-bitstring value not supported");
      return error_mark_node;
    }
}

static tree
build_empty_string (type)
     tree type;
{
  int orig_pass = pass;
  tree range, result;

  range = build_chill_range_type (type, integer_zero_node,
				  integer_minus_one_node);
  result = build_chill_array_type (type,
	     tree_cons (NULL_TREE, range, NULL_TREE), 0, NULL_TREE);
  pass = 2;
  range = build_chill_range_type (type, integer_zero_node,
				  integer_minus_one_node);
  result = build_chill_array_type (type,
	     tree_cons (NULL_TREE, range, NULL_TREE), 0, NULL_TREE);
  pass = orig_pass;

  return decl_temp1 (get_unique_identifier ("EMPTY_STRING"),
		     result, 0, NULL_TREE, 0, 0);
}

/* We build the runtime range-checking as a separate list
 * rather than making a compound_expr with min_value
 * (for example), to control when that comparison gets 
 * generated.  We cannot allow it in a TYPE_MAX_VALUE or
 * TYPE_MIN_VALUE expression, for instance, because that code 
 * will get generated when the slice is laid out, which would 
 * put it outside the scope of an exception handler for the 
 * statement we're generating.  I.e. we would be generating
 * cause_exception calls which might execute before the
 * necessary ch_link_handler call.
 */
tree
build_chill_slice_with_range (array, min_value, max_value)
     tree array, min_value, max_value;
{
  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK
      || min_value == NULL_TREE || TREE_CODE(min_value) == ERROR_MARK
      || max_value == NULL_TREE || TREE_CODE(max_value) == ERROR_MARK)
    return error_mark_node;

  if (TREE_TYPE (array) == NULL_TREE
      || (TREE_CODE (TREE_TYPE (array)) != ARRAY_TYPE
	  && TREE_CODE (TREE_TYPE (array)) != SET_TYPE
	  && !chill_varying_type_p (TREE_TYPE (array))))
    {
      error ("can only take slice of array or string");
      return error_mark_node;
    }

  array = save_if_needed (array);

  /* FIXME: test here for max_value >= min_value, except
     for max_value == -1, min_value == 0 (empty string) */
  min_value = valid_array_index_p (array, min_value,
				   "slice lower limit out-of-range", 0);
  if (TREE_CODE (min_value) == ERROR_MARK)
    return min_value;

  /* FIXME: suppress this test if max_value is the LENGTH of a 
     varying array, which has presumably already been checked. */
  max_value = valid_array_index_p (array, max_value,
				   "slice upper limit out-of-range", 0);
  if (TREE_CODE (max_value) == ERROR_MARK)
    return error_mark_node;

  if (TREE_CODE (min_value) == INTEGER_CST
      && TREE_CODE (max_value) == INTEGER_CST
      && tree_int_cst_lt (max_value, min_value))
    return build_empty_string (TREE_TYPE (TREE_TYPE (array)));

  return build_chill_slice (array, min_value,
	     save_expr (size_binop (PLUS_EXPR,
	       size_binop (MINUS_EXPR, max_value, min_value),
				    integer_one_node)));
}


tree
build_chill_slice_with_length (array, min_value, length)
     tree array, min_value, length;
{
  tree max_index;
  tree cond, high_cond, atype;

  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK
      || min_value == NULL_TREE || TREE_CODE(min_value) == ERROR_MARK
      || length == NULL_TREE || TREE_CODE(length) == ERROR_MARK)
    return error_mark_node;

  if (TREE_TYPE (array) == NULL_TREE
      || (TREE_CODE (TREE_TYPE (array)) != ARRAY_TYPE
	  && TREE_CODE (TREE_TYPE (array)) != SET_TYPE
	  && !chill_varying_type_p (TREE_TYPE (array))))
    {
      error ("can only take slice of array or string");
      return error_mark_node;
    }

  if (TREE_CONSTANT (length)