typeck.c

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

      && tree_int_cst_lt (length, integer_zero_node))
    return build_empty_string (TREE_TYPE (TREE_TYPE (array)));

  array = save_if_needed (array);
  min_value = save_expr (min_value);
  length = save_expr (length);

  if (! CH_SIMILAR (TREE_TYPE (length), integer_type_node))
    {
      error ("slice length is not an integer");
      length = integer_one_node;
    }

  max_index = size_binop (MINUS_EXPR, 
	        size_binop (PLUS_EXPR, length, min_value),
			  integer_one_node);
  max_index = convert_to_class (chill_expr_class (min_value), max_index);

  min_value = valid_array_index_p (array, min_value,
				   "slice start index out-of-range", 0);
  if (TREE_CODE (min_value) == ERROR_MARK)
    return error_mark_node;

  atype = TREE_TYPE (array);

  if (chill_varying_type_p (atype))
    high_cond = build_component_ref (array, var_length_id);
  else
    high_cond = TYPE_MAX_VALUE (TYPE_DOMAIN (atype));

  /* an invalid index expression meets this condition */
  cond = fold (build (TRUTH_ORIF_EXPR, boolean_type_node,
		      build_compare_discrete_expr (LT_EXPR,
						   length, integer_zero_node),
		      build_compare_discrete_expr (GT_EXPR,
						   max_index, high_cond)));

  if (TREE_CODE (cond) == INTEGER_CST)
    {
      if (! tree_int_cst_equal (cond, boolean_false_node))
	{
	  error ("slice length out-of-range");
	  return error_mark_node;
	}
	  
    }
  else if (range_checking)
    {
      min_value = check_expression (min_value, cond,
				    ridpointers[(int) RID_RANGEFAIL]);
    }

  return build_chill_slice (array, min_value, length);
}

tree
build_chill_array_ref (array, indexlist)
     tree array, indexlist;
{
  tree idx;

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

  idx = TREE_VALUE (indexlist);   /* handle first index */

  idx = valid_array_index_p (array, idx,
			     "array index out-of-range", 0);
  if (TREE_CODE (idx) == ERROR_MARK)
    return error_mark_node;

  array = build_chill_array_ref_1 (array, idx);

  if (array && TREE_CODE (array) != ERROR_MARK 
      && TREE_CHAIN (indexlist))
    {
      /* Z.200 (1988) section 4.2.8 says that:
	 <array> '(' <expression {',' <expression> }* ')'
	 is derived syntax (i.e. syntactic sugar) for:
	 <array> '(' <expression ')' { '(' <expression> ')' }*
	 The intent is clear if <array> has mode: ARRAY (...) ARRAY (...) XXX.
	 But what if <array> has mode: ARRAY (...) CHARS (N)
	 or: ARRAY (...) BOOLS (N).
	 Z.200 doesn't explicitly prohibit it, but the intent is unclear.
	 We'll allow it, since it seems reasonable and useful.
	 However, we won't allow it if <array> is:
	 ARRAY (...) PROC (...).
	 (The latter would make sense if we allowed general
	 Currying, which Chill doesn't.)  */
      if (TREE_CODE (TREE_TYPE (array)) == ARRAY_TYPE
	  || chill_varying_type_p (TREE_TYPE (array))
	  || CH_BOOLS_TYPE_P (TREE_TYPE (array)))
	array = build_generalized_call (array, TREE_CHAIN (indexlist));
      else
	error ("too many index expressions");
    }
  return array;
}

/*
 * Don't error check the index in here.  It's supposed to be 
 * checked by the caller.
 */
tree
build_chill_array_ref_1 (array, idx)
     tree array, idx;
{
  tree type;
  tree domain;
  tree rval;

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

  if (chill_varying_type_p (TREE_TYPE (array)))
    array = varying_to_slice (array);

  domain = TYPE_DOMAIN (TREE_TYPE (array));

#if 0
  if (! integer_zerop (TYPE_MIN_VALUE (domain)))
    {
      /* The C part of the compiler doesn't understand how to do
	 arithmetic with dissimilar enum types.  So we check compatability
	 here, and perform the math in INTEGER_TYPE.  */
      if (TREE_CODE (TREE_TYPE (idx)) == ENUMERAL_TYPE
	  && chill_comptypes (TREE_TYPE (idx), domain, 0))
	idx = convert (TREE_TYPE (TYPE_MIN_VALUE (domain)), idx);
      idx = build_binary_op (MINUS_EXPR, idx, TYPE_MIN_VALUE (domain), 0);
    }
#endif

  if (CH_STRING_TYPE_P (TREE_TYPE (array)))
    {
      /* Could be bitstring or char string.  */
      if (TREE_TYPE (TREE_TYPE (array)) == boolean_type_node)
	{
	  rval = build (SET_IN_EXPR, boolean_type_node, idx, array);
	  TREE_READONLY (rval) = TREE_READONLY (array);
	  return rval;
	}
    }

  if (!discrete_type_p (TREE_TYPE (idx)))
    {
      error ("array index is not discrete");
      return error_mark_node;
    }

  /* An array that is indexed by a non-constant
     cannot be stored in a register; we must be able to do
     address arithmetic on its address.
     Likewise an array of elements of variable size.  */
  if (TREE_CODE (idx) != INTEGER_CST
      || (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))) != 0
	  && TREE_CODE (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array)))) != INTEGER_CST))
    {
      if (mark_addressable (array) == 0)
	return error_mark_node;
    }

  type = TREE_TYPE (TREE_TYPE (array));

  /* Do constant folding */
  if (TREE_CODE (idx) == INTEGER_CST && TREE_CONSTANT (array))
    {
      struct ch_class class;
      class.kind = CH_VALUE_CLASS;
      class.mode = type;

      if (TREE_CODE (array) == CONSTRUCTOR)
	{
	  tree list = CONSTRUCTOR_ELTS (array);
	  for ( ; list != NULL_TREE; list = TREE_CHAIN (list))
	    {
	      if (tree_int_cst_equal (TREE_PURPOSE (list), idx))
		return convert_to_class (class, TREE_VALUE (list));
	    }
	}
      else if (TREE_CODE (array) == STRING_CST
	       && CH_CHARS_TYPE_P (TREE_TYPE (array)))
	{
	  HOST_WIDE_INT i = TREE_INT_CST_LOW (idx);
	  if (i >= 0 && i < TREE_STRING_LENGTH (array))
	    {
	      char ch = TREE_STRING_POINTER (array) [i];
	      return convert_to_class (class,
				       build_int_2 ((unsigned char)ch, 0));
	    }
	}
    }

  if (TYPE_PACKED (TREE_TYPE (array)))
    rval = build (PACKED_ARRAY_REF, type, array, idx);
  else
    rval = build (ARRAY_REF, type, array, idx);

  /* Array ref is const/volatile if the array elements are
     or if the array is.  */
  TREE_READONLY (rval) = TREE_READONLY (array) | TYPE_READONLY (type);
  TREE_SIDE_EFFECTS (rval)
    |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array)))
	| TREE_SIDE_EFFECTS (array));
  TREE_THIS_VOLATILE (rval)
    |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array)))
	/* This was added by rms on 16 Nov 91.
	   It fixes  vol struct foo *a;  a->elts[1] 
	   in an inline function.
	   Hope it doesn't break something else.  */
	| TREE_THIS_VOLATILE (array));
  return fold (rval);
}

tree
build_chill_bitref (bitstring, indexlist)
     tree bitstring, indexlist;
{
  if (TREE_CODE (bitstring) == ERROR_MARK)
    return bitstring;
  if (TREE_CODE (indexlist) == ERROR_MARK)
    return indexlist;

  if (TREE_CHAIN (indexlist) != NULL_TREE)
    {
      error ("invalid compound index for bitstring mode");
      return error_mark_node;
    }

  if (TREE_CODE (indexlist) == TREE_LIST)
    {
      tree result = build (SET_IN_EXPR, boolean_type_node,
			   TREE_VALUE (indexlist), bitstring);
      TREE_READONLY (result) = TREE_READONLY (bitstring);
      return result;
    }
  else abort ();
}


int
discrete_type_p (type)
     tree type;
{
  return INTEGRAL_TYPE_P (type);
}

/* Checks that EXP has discrete type, or can be converted to discrete.
   Otherwise, returns NULL_TREE.
   Normally returns the (possibly-converted) EXP. */

tree
convert_to_discrete (exp)
     tree exp;
{
  if (! discrete_type_p (TREE_TYPE (exp)))
    {
      if (flag_old_strings)
	{
	  if (CH_CHARS_ONE_P (TREE_TYPE (exp)))
	    return convert (char_type_node, exp);
	  if (CH_BOOLS_ONE_P (TREE_TYPE (exp)))
	    return convert (boolean_type_node, exp);
	}
      return NULL_TREE;
    }
  return exp;
}

/* Write into BUFFER the target-machine representation of VALUE.
   Returns 1 on success, or 0 on failure. (Either the VALUE was
   not constant, or we don't know how to do the conversion.) */

static int
expand_constant_to_buffer (value, buffer, buf_size)
     tree value;
     unsigned char *buffer; 
     int buf_size;
{
  tree type = TREE_TYPE (value);
  int size = int_size_in_bytes (type);
  int i;
  if (size < 0 || size > buf_size)
    return 0;
  switch (TREE_CODE (value))
    {
    case INTEGER_CST:
      {
	HOST_WIDE_INT lo = TREE_INT_CST_LOW (value);
	HOST_WIDE_INT hi = TREE_INT_CST_HIGH (value);
	for (i = 0; i < size; i++)
	  {
	    /* Doesn't work if host and target BITS_PER_UNIT differ. */
	    unsigned char byte = lo & ((1 << BITS_PER_UNIT) - 1);
	    if (BYTES_BIG_ENDIAN)
	      buffer[size - i - 1] = byte;
	    else
	      buffer[i] = byte;
	    rshift_double (lo, hi, BITS_PER_UNIT, BITS_PER_UNIT * size,
			   &lo, &hi, 0);
	  }
      }
      break;
    case STRING_CST:
      {
	size = TREE_STRING_LENGTH (value);
	if (size > buf_size)
	  return 0;
	bcopy (TREE_STRING_POINTER (value), buffer, size);
	break;
      }
    case CONSTRUCTOR:
      if (TREE_CODE (type) == ARRAY_TYPE)
	{
	  tree element_type = TREE_TYPE (type);
	  int element_size = int_size_in_bytes (element_type);
	  tree list = CONSTRUCTOR_ELTS (value);
	  HOST_WIDE_INT next_index;
	  HOST_WIDE_INT min_index = 0;
	  if (element_size < 0)
	    return 0;

	  if (TYPE_DOMAIN (type) != 0)
	    {
	      tree min_val = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
	      if (min_val)
		{
		  if (TREE_CODE (min_val) != INTEGER_CST)
		    return 0;
		  else
		    min_index = TREE_INT_CST_LOW (min_val);
		}
	    }

	  next_index = min_index;

	  for (; list != NULL_TREE; list = TREE_CHAIN (list))
	    {
	      HOST_WIDE_INT offset;
	      HOST_WIDE_INT last_index;
	      tree purpose = TREE_PURPOSE (list);
	      if (purpose)
		{
		  if (TREE_CODE (purpose) == INTEGER_CST)
		    last_index = next_index = TREE_INT_CST_LOW (purpose);
		  else if (TREE_CODE (purpose) == RANGE_EXPR)
		    {
		      next_index = TREE_INT_CST_LOW (TREE_OPERAND(purpose, 0));
		      last_index = TREE_INT_CST_LOW (TREE_OPERAND(purpose, 1));
		    }
		  else
		    return 0;
		}
	      else
		last_index = next_index;
	      for ( ; next_index <= last_index; next_index++)
		{
		  offset = (next_index - min_index) * element_size;
		  if (!expand_constant_to_buffer (TREE_VALUE (list),
						  buffer + offset,
						  buf_size - offset))
		    return 0;
		}
	    }
	  break;
	}
      else if (TREE_CODE (type) == RECORD_TYPE)
	{
	  tree list = CONSTRUCTOR_ELTS (value);
	  for (; list != NULL_TREE; list = TREE_CHAIN (list))
	    {
	      tree field = TREE_PURPOSE (list);
	      HOST_WIDE_INT offset;
	      if (field == NULL_TREE || TREE_CODE (field) != FIELD_DECL)
		return 0;
	      if (DECL_BIT_FIELD (field))
		return 0;
	      offset = TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field))
		/ BITS_PER_UNIT;
	      if (!expand_constant_to_buffer (TREE_VALUE (list),
					      buffer + offset,
					      buf_size - offset))
		return 0;
	    }
	  break;
	}
      else if (TREE_CODE (type) == SET_TYPE)
	{
	  if (get_set_constructor_bytes (value, buffer, buf_size)
	      != NULL_TREE)
	    return 0;
	}
      break;
    default:
      return 0;
    }
  return 1;
}

/* Given that BUFFER contains a target-machine representation of
   a value of type TYPE, return that value as a tree.
   Returns NULL_TREE on failure. (E.g. the TYPE might be variable size,
   or perhaps we don't know how to do the conversion.) */

static tree
extract_constant_from_buffer (type, buffer, buf_size)
     tree type;
     unsigned char *buffer;
     int buf_size;
{
  tree value;
  int size = int_size_in_bytes (type);
  int i;
  if (size < 0 || size > buf_size)
    return 0;
  switch (TREE_CODE (type))
    {
    case INTEGER_TYPE:
    case CHAR_TYPE:
    case BOOLEAN_TYPE:
    case ENUMERAL_TYPE:
    case POINTER_TYPE:
      {
	HOST_WIDE_INT lo = 0, hi = 0;
	/* Accumulate (into (lo,hi) the bytes (from buffer). */
	for (i = size; --i >= 0; )
	  {
	    unsigned char byte;
	    /* Get next byte (in big-endian order). */
	    if (BYTES_BIG_ENDIAN)
	      byte = buffer[size - i - 1];
	    else
	      byte = buffer[i];
	    lshift_double (lo, hi, BITS_PER_UNIT, TYPE_PRECISION (type),
			   &lo, &hi, 0);
	    add_double (lo, hi, byte, 0, &lo, &hi);
	  }
	value = build_int_2 (lo, hi);
	TREE_TYPE (value) = type;
	return value;
      }
    case ARRAY_TYPE:
      {
	tree element_type = TREE_TYPE (type);
	int element_size = int_size_in_bytes (element_type);