typeck.c

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

	tree list = NULL_TREE;
	HOST_WIDE_INT min_index = 0, max_index, cur_index;
	if (element_size == 1 && CH_CHARS_TYPE_P (type))
	  {
	    value = build_string (size, buffer);
	    CH_DERIVED_FLAG (value) = 1;
	    TREE_TYPE (value) = type;
	    return value;
	  }
	if (TYPE_DOMAIN (type) == 0)
	  return 0;
	value = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
	if (value)
	  {
	    if (TREE_CODE (value) != INTEGER_CST)
	      return 0;
	    else
	      min_index = TREE_INT_CST_LOW (value);
	  }
	value = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
	if (value == NULL_TREE || TREE_CODE (value) != INTEGER_CST)
	  return 0;
	else
	  max_index = TREE_INT_CST_LOW (value);
	for (cur_index = max_index; cur_index >= min_index; cur_index--)
	  {
	    HOST_WIDE_INT offset = (cur_index - min_index) * element_size;
	    value = extract_constant_from_buffer (element_type,
						  buffer + offset,
						  buf_size - offset);
	    if (value == NULL_TREE)
	      return NULL_TREE;
	    list = tree_cons (build_int_2 (cur_index, 0), value, list);
	  }
	value = build (CONSTRUCTOR, type, NULL_TREE, list);
	TREE_CONSTANT (value) = 1;
	TREE_STATIC (value) = 1;
	return value;
      }
    case RECORD_TYPE:
      {
	tree list = NULL_TREE;
	tree field = TYPE_FIELDS (type);
	for (; field != NULL_TREE; field = TREE_CHAIN (field))
	  {
	    HOST_WIDE_INT offset
	      = TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field)) / BITS_PER_UNIT;
	    if (DECL_BIT_FIELD (field))
	      return 0;
	    value = extract_constant_from_buffer (TREE_TYPE (field),
						  buffer + offset,
						  buf_size - offset);
	    if (value == NULL_TREE)
	      return NULL_TREE;
	    list = tree_cons (field, value, list);
	  }
	value = build (CONSTRUCTOR, type, NULL_TREE, nreverse (list));
	TREE_CONSTANT (value) = 1;
	TREE_STATIC (value) = 1;
	return value;
      }

    case UNION_TYPE:
      {
	tree longest_variant = NULL_TREE;
	int longest_size = 0;
	tree field = TYPE_FIELDS (type);
	
	/* This is a kludge.  We assume that converting the data to te
	   longest variant will provide valid data for the "correct"
	   variant.  This is usually the case, but is not guaranteed.
	   For example, the longest variant may include holes.
	   Also incorrect interpreting the given value as the longest
	   variant may confuse the compiler if that should happen
	   to yield invalid values.  ??? */

	for (; field != NULL_TREE; field = TREE_CHAIN (field))
	  {
	    int size = TREE_INT_CST_LOW (size_in_bytes (TREE_TYPE (field)));
	    
	    if (size > longest_size)
	      {
		longest_size = size;
		longest_variant = field;
	      }
	  }
	if (longest_variant == NULL_TREE)
	  return NULL_TREE;
	return extract_constant_from_buffer (TREE_TYPE (longest_variant), buffer, buf_size);
      }

    case SET_TYPE:
      {
	tree list = NULL_TREE;
	int i;
	HOST_WIDE_INT min_index, max_index;
	if (TYPE_DOMAIN (type) == 0)
	  return 0;
	value = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
	if (value == NULL_TREE)
	  min_index = 0;
	else if (TREE_CODE (value) != INTEGER_CST)
	  return 0;
	else
	  min_index = TREE_INT_CST_LOW (value);
	value = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
	if (value == NULL_TREE)
	  max_index = 0;
	else if (TREE_CODE (value) != INTEGER_CST)
	  return 0;
	else
	  max_index = TREE_INT_CST_LOW (value);
	for (i = max_index + 1 - min_index; --i >= 0; )
	  {
	    unsigned char byte = (unsigned char)buffer[i / BITS_PER_UNIT];
	    unsigned bit_pos = (unsigned)i % (unsigned)BITS_PER_UNIT;
	    if (BYTES_BIG_ENDIAN
		? (byte & (1 << (BITS_PER_UNIT - 1 - bit_pos)))
		: (byte & (1 << bit_pos)))
	      list = tree_cons (NULL_TREE,
				build_int_2 (i + min_index, 0), list);
	  }
	value = build (CONSTRUCTOR, type, NULL_TREE, list);
	TREE_CONSTANT (value) = 1;
	TREE_STATIC (value) = 1;
	return value;
      }

    default:
      return NULL_TREE;
    }
}

tree
build_chill_cast (type, expr)
     tree type, expr;
{
  tree expr_type;
  int  expr_type_size;
  int  type_size;
  int  type_is_discrete;
  int  expr_type_is_discrete;

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

  /* if expression was untyped because of its context (an
     if_expr or case_expr in a tuple, perhaps) just apply
     the type */
  expr_type = TREE_TYPE (expr);
  if (expr_type == NULL_TREE
      || TREE_CODE (expr_type) == ERROR_MARK)
    return convert (type, expr);

  if (expr_type == type)
    return expr;

  expr_type_size = int_size_in_bytes (expr_type);
  type_size      = int_size_in_bytes (type);

  if (expr_type_size == -1)
    {
      error ("conversions from variable_size value");
      return error_mark_node;
    }
  if (type_size == -1)
    {
      error ("conversions to variable_size mode");
      return error_mark_node;
    }

  /* FIXME: process REAL ==> INT && INT ==> REAL && REAL ==> REAL. I hope this is correct. */
  if ((TREE_CODE (expr_type) == INTEGER_TYPE && TREE_CODE (type) == REAL_TYPE) ||
      (TREE_CODE (expr_type) == REAL_TYPE && TREE_CODE (type) == INTEGER_TYPE) ||
      (TREE_CODE (expr_type) == REAL_TYPE && TREE_CODE (type) == REAL_TYPE))
    return convert (type, expr);

  /* FIXME: Don't know if this is correct */
  /* Don't allow conversions to or from REAL with others then integer */
  if (TREE_CODE (type) == REAL_TYPE)
    {
      error ("cannot convert to float");
      return error_mark_node;
    }
  else if (TREE_CODE (expr_type) == REAL_TYPE)
    {
      error ("cannot convert float to this mode");
      return error_mark_node;
    }

  if (expr_type_size == type_size && CH_REFERABLE (expr))
    goto do_location_conversion;

  type_is_discrete
    = discrete_type_p (type) || TREE_CODE (type) == POINTER_TYPE;
  expr_type_is_discrete
    = discrete_type_p (expr_type) || TREE_CODE (expr_type) == POINTER_TYPE;
  if (expr_type_is_discrete && type_is_discrete)
    {
      /* do an overflow check
	 FIXME: is this always neccessary ??? */
      /* FIXME: don't do range chacking when target type is PTR.
	 PTR doesn't have MIN and MAXVALUE. result is sigsegv. */
      if (range_checking && type != ptr_type_node)
	{
	  tree tmp = expr;

	  STRIP_NOPS (tmp);
	  if (TREE_CONSTANT (tmp) && TREE_CODE (tmp) != ADDR_EXPR)
	    {
	      if (compare_int_csts (LT_EXPR, tmp, TYPE_MIN_VALUE (type)) ||
		  compare_int_csts (GT_EXPR, tmp, TYPE_MAX_VALUE (type)))
		{
		  error ("OVERFLOW in expression conversion");
		  return error_mark_node;
		}
	    }
	  else
	    {
	      int cond1 = tree_int_cst_lt (TYPE_SIZE (type),
					   TYPE_SIZE (expr_type));
	      int cond2 = TREE_UNSIGNED (type) && (! TREE_UNSIGNED (expr_type));
	      int cond3 = (! TREE_UNSIGNED (type))
		&& TREE_UNSIGNED (expr_type)
		&& tree_int_cst_equal (TYPE_SIZE (type),
				       TYPE_SIZE (expr_type));
	      int cond4 = TREE_TYPE (type) && type_is_discrete;

	      if (cond1 || cond2 || cond3 || cond4)
		{
		  tree type_min = TYPE_MIN_VALUE (type);
		  tree type_max = TYPE_MAX_VALUE (type);
  
		  expr = save_if_needed (expr);
		  if (expr && type_min && type_max)
		    {
		      tree check = test_range (expr, type_min, type_max);
		      if (!integer_zerop (check))
			{
			  if (current_function_decl == NULL_TREE)
			    {
			      if (TREE_CODE (check) == INTEGER_CST)
				error ("overflow (not inside function)");
			      else
				warning ("possible overflow (not inside function)");
			    }
			  else
			    {
			      if (TREE_CODE (check) == INTEGER_CST)
				warning ("expression will always cause OVERFLOW");
			      expr = check_expression (expr, check,
						       ridpointers[(int) RID_OVERFLOW]);
			    }
			}
		    }
		}
	    }
	}
      return convert (type, expr);
    }

  if (TREE_CODE (expr) == INTEGER_CST && expr_type_size != type_size)
    {
      /* There should probably be a pedwarn here ... */
      tree itype = type_for_size (type_size * BITS_PER_UNIT, 1);
      if (itype)
	{
	  expr = convert (itype, expr);
	  expr_type = TREE_TYPE (expr);
	  expr_type_size= type_size;
	}
    }

  /* If expr is a constant of the right size, use it to to
     initialize a static variable. */
  if (expr_type_size == type_size && TREE_CONSTANT (expr) && !pedantic)
    {
      unsigned char *buffer = (unsigned char*) alloca (type_size);
      tree value;
      bzero (buffer, type_size);
      if (!expand_constant_to_buffer (expr, buffer, type_size))
	{
	  error ("not implemented: constant conversion from that kind of expression");
	  return error_mark_node;
	}
      value = extract_constant_from_buffer (type, buffer, type_size);
      if (value == NULL_TREE)
	{
	  error ("not implemented: constant conversion to that kind of mode");
	  return error_mark_node;
	}
      return value;
    }

  if (!CH_REFERABLE (expr) && expr_type_size == type_size)
    {
      tree temp = decl_temp1 (get_unique_identifier ("CAST"),
			      TREE_TYPE (expr), 0, 0, 0, 0);
      tree convert1 = build_chill_modify_expr (temp, expr);
      pedwarn ("non-standard, non-portable value conversion");
      return build (COMPOUND_EXPR, type, convert1,
		    build_chill_cast (type, temp));
    }

  if (CH_REFERABLE (expr) && expr_type_size != type_size)
    error ("location conversion between differently-sized modes");
  else
    error ("unsupported value conversion");
  return error_mark_node;

 do_location_conversion:
  /* To avoid confusing other parts of gcc,
     represent this as the C expression: *(TYPE*)EXPR. */
  mark_addressable (expr);
  expr = build1 (INDIRECT_REF, type,
		 build1 (NOP_EXPR, build_pointer_type (type),
			 build1 (ADDR_EXPR, build_pointer_type (expr_type),
				 expr)));
  TREE_READONLY (expr) = TYPE_READONLY (type);
  return expr;
}

/*
 * given a set_type, build an integer array from it that C will grok.
 */
tree
build_array_from_set (type)
     tree type;
{
  tree bytespint, bit_array_size, int_array_count;
 
  if (type == NULL_TREE || type == error_mark_node || TREE_CODE (type) != SET_TYPE)
    return error_mark_node;

  bytespint = build_int_2 (HOST_BITS_PER_INT / HOST_BITS_PER_CHAR, 0);
  bit_array_size = size_in_bytes (type);
  int_array_count = fold (size_binop (TRUNC_DIV_EXPR, bit_array_size,
						 bytespint));
  if (integer_zerop (int_array_count))
    int_array_count = size_one_node;
  type = build_array_type (integer_type_node, 
			   build_index_type (int_array_count));
  return type;
}


tree
build_chill_bin_type (size)
     tree size;
{
#if 0
  int isize;

  if (TREE_CODE (size) != INTEGER_CST
      || (isize = TREE_INT_CST_LOW (size), isize <= 0))
    {
      error ("operand to bin must be a non-negative integer literal");
      return error_mark_node;
    }
  if (isize <= TYPE_PRECISION (unsigned_char_type_node))
    return unsigned_char_type_node;
  if (isize <= TYPE_PRECISION (short_unsigned_type_node))
    return short_unsigned_type_node;
  if (isize <= TYPE_PRECISION (unsigned_type_node))
    return unsigned_type_node;
  if (isize <= TYPE_PRECISION (long_unsigned_type_node))
    return long_unsigned_type_node;
  if (isize <= TYPE_PRECISION (long_long_unsigned_type_node))
    return long_long_unsigned_type_node;
  error ("size %d of BIN too big - no such integer mode", isize);
  return error_mark_node;
#endif
  tree bintype;
 
  if (pass == 1)
    {
      bintype = make_node (INTEGER_TYPE);
      TREE_TYPE (bintype) = ridpointers[(int) RID_BIN];
      TYPE_MIN_VALUE (bintype) = size;
      TYPE_MAX_VALUE (bintype) = size;
    }
  else
    {
      error ("BIN in pass 2");
      return error_mark_node;
    }
  return bintype;
}

tree
chill_expand_tuple (type, constructor)
     tree type, constructor;
{
  char *name;
  tree nonreft = type;

  if (TYPE_NAME (type) != NULL_TREE)
    {
      if (TREE_CODE (TYPE_NAME (type)) == IDENTIFIER_NODE)
	name = IDENTIFIER_POINTER (TYPE_NAME (type));
      else
	name = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (type)));
    }
  else
    name = "";

  /* get to actual underlying type for digest_init */
  while (nonreft && TREE_CODE (nonreft) == REFERENCE_TYPE)
    nonreft = TREE_TYPE (nonreft);

  if (TREE_CODE (nonreft) == ARRAY_TYPE
      || TREE_CODE (nonreft) == RECORD_TYPE
      || TREE_CODE (nonreft) == SET_TYPE)
    return convert (nonreft, constructor);
  else
    {
      error ("mode of tuple is neither ARRAY, STRUCT, nor POWERSET");
      return error_mark_node;
    }
}

/* This function classifies an expr into the Null class,
   the All class, the M-Value, the M-derived, or the M-reference class.
   It probably has some inaccuracies. */

struct ch_class
chill_expr_class (expr)
     tree expr;
{
  struct ch_class class;
  /* The Null class contains the NULL pointer constant (only). */
  if (expr == null_pointer_node)
    {
      class.kind = CH_NULL_CLASS;
      class.mode = NULL_TREE;
      return class;
    }

  /* The All class contains the <undefined value> "*". */
  if (TREE_CODE (expr) == UNDEFINED_EXPR)
    {
      class.kind = CH_ALL_CLASS;
      class.mode = NULL_TREE;
      return class;
    }