convert.c

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

			    {
			      tag_value = TREE_VALUE (tag_value);
			      break;
			    }
			}
		      if (!tag_value || TREE_CODE (tag_value) != INTEGER_CST)
			{
			  pedwarn ("non-constant value for tag field `%s'",
				   IDENTIFIER_POINTER (DECL_NAME (tag_decl)));
			  goto get_values;
			}

		      /* Check if the value of the tag (as given in a
			 previous field) matches the case label list. */
		      for (; tag_value_set;
			   tag_value_set = TREE_CHAIN (tag_value_set))
			{
			  if (tree_int_cst_equal (TREE_VALUE (tag_value_set),
						  tag_value))
			    {
			      found = 1;
			      break;
			    }
			}
		      if (!found)
			break;
		    }
		  if (!tag_fields)
		    {
		      selected_variant = variant;
		      break;
		    }
		}
	    }
	get_values:
	  for (variant = TYPE_FIELDS (TREE_TYPE (field));
	       variant; variant = TREE_CHAIN (variant))
	    {
	      tree vfield0 = TYPE_FIELDS (TREE_TYPE (variant)); 
	      tree vfield;
	      for (vfield = vfield0; vfield;  vfield = TREE_CHAIN (vfield))
		{
		  tree value = remove_tree_element (DECL_NAME (vfield),
						    &elements);

		  if (value)
		    labelled_elements++;
		  else if (variant == selected_variant
			   && elements && TREE_PURPOSE (elements) == NULL_TREE)
		    {
		      value = elements;
		      elements = TREE_CHAIN (elements);
		      unlabelled_elements++;
		    }

		  if (value)
		    {
		      if (selected_variant && selected_variant != variant)
			{
			  error ("field `%s' in wrong variant",
				 IDENTIFIER_POINTER (DECL_NAME (vfield)));
			  is_erroneous = 1;
			}
		      else
			{
			  if (!selected_variant && vfield != vfield0)
			    pedwarn ("missing variant fields (at least `%s')",
				     IDENTIFIER_POINTER (DECL_NAME (vfield0)));
			  selected_variant = variant;
			  if (CH_COMPATIBLE (TREE_VALUE (value),
					     TREE_TYPE (vfield)))
			    {
			      tree val = convert (TREE_TYPE (vfield),
						  TREE_VALUE (value));
			      TREE_PURPOSE (value) = vfield;
			      TREE_VALUE (value) = val;
			      TREE_CHAIN (value) = variant_values;
			      variant_values = value;
			      if (TREE_CODE (val) == ERROR_MARK)
				is_erroneous = 1;
			      else if (!TREE_CONSTANT (val))
				is_constant = 0;
			      else if (!initializer_constant_valid_p
				       (val, TREE_TYPE (val)))
				is_simple = 0;
			    }
			  else
			    {
			      is_erroneous = 1;
			      error ("bad initializer for field `%s'",
				     IDENTIFIER_POINTER (DECL_NAME (vfield)));
			    }
			}
		    }
		  else if (variant == selected_variant)
		    {
		      pedwarn ("no initializer value for variant field `%s'",
			       IDENTIFIER_POINTER (DECL_NAME (field)));
		    }
		}
	    }
	  if (selected_variant == NULL_TREE)
	    pedwarn ("no selected variant");
	  else
	    {
	      variant_values = build (CONSTRUCTOR,
				      TREE_TYPE (selected_variant),
				      NULL_TREE, nreverse (variant_values));
	      variant_values
		= build (CONSTRUCTOR, TREE_TYPE (field), NULL_TREE,
			 build_tree_list (selected_variant, variant_values));
	      values = tree_cons (field, variant_values, values);
	    }
	}
    }

  if (labelled_elements && unlabelled_elements)
    pedwarn ("mixture of labelled and unlabelled tuple elements");

  /* Check for unused initializer elements. */
  unlabelled_elements = 0;
  for ( ; elements != NULL_TREE; elements = TREE_CHAIN (elements))
    {
      if (TREE_PURPOSE (elements) == NULL_TREE)
	unlabelled_elements++;
      else
	{
	  if (IDENTIFIER_POINTER (TREE_PURPOSE (elements)) == 0)
	    error ("probably not a structure tuple");
	  else
	    error ("excess initializer for field `%s'",
		   IDENTIFIER_POINTER (TREE_PURPOSE (elements)));
	  is_erroneous = 1;
	}
    }
  if (unlabelled_elements)
    {
      error ("excess unnamed initializers");
      is_erroneous = 1;
    }

  CONSTRUCTOR_ELTS (inits) = nreverse (values);
  TREE_TYPE (inits) = type;
  if (is_erroneous)
    return error_mark_node;
  if (is_constant)
    TREE_CONSTANT (inits) = 1;
  if (is_constant && is_simple)
    TREE_STATIC (inits) = 1;
  return inits;
}

/* Return a Chill representation of the INTEGER_CST VAL.
   The result may be in a static buffer, */

char *
display_int_cst (val)
     tree val;
{
  static char buffer[50];
  HOST_WIDE_INT x;
  tree fields;
  if (TREE_CODE (val) != INTEGER_CST)
    return "<not a constant>";

  x = TREE_INT_CST_LOW (val);

  switch (TREE_CODE (TREE_TYPE (val)))
    {
    case BOOLEAN_TYPE:
      if (x == 0)
	return "FALSE";
      if (x == 1)
	return "TRUE";
      goto int_case;
    case CHAR_TYPE:
      if (x == '^')
	strcpy (buffer, "'^^'");
      else if (x == '\n')
	strcpy (buffer, "'^J'");
      else if (x < ' ' || x > '~')
	sprintf (buffer, "'^(%u)'", (unsigned int) x);
      else
	sprintf (buffer, "'%c'", (char) x);
      return buffer;
    case ENUMERAL_TYPE:
      for (fields = TYPE_VALUES (TREE_TYPE (val)); fields != NULL_TREE;
	   fields = TREE_CHAIN (fields))
	{
	  if (tree_int_cst_equal (TREE_VALUE (fields), val))
	    return IDENTIFIER_POINTER (TREE_PURPOSE (fields));
	}
      goto int_case;
    case POINTER_TYPE:
      if (x == 0)
	return "NULL";
      goto int_case;
    int_case:
    default:
      /* This code is derived from print-tree.c:print_code_brief. */
      if (TREE_INT_CST_HIGH (val) == 0)
	sprintf (buffer,
#if HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_INT
		 "%1u",
#else
		 "%1lu",
#endif
		 x);
      else if (TREE_INT_CST_HIGH (val) == -1 && TREE_INT_CST_LOW (val) != 0)
	sprintf (buffer,
#if HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_INT
		 "-%1u",
#else
		 "-%1lu",
#endif
		 -x);
      else
	sprintf (buffer,
#if HOST_BITS_PER_WIDE_INT == 64
#if HOST_BITS_PER_WIDE_INT != HOST_BITS_PER_INT
		 "H'%lx%016lx",
#else
		 "H'%x%016x",
#endif
#else
#if HOST_BITS_PER_WIDE_INT != HOST_BITS_PER_INT
		 "H'%lx%08lx",
#else
		 "H'%x%08x",
#endif
#endif
		 TREE_INT_CST_HIGH (val), TREE_INT_CST_LOW (val));
      return buffer;
    }
}

static tree
digest_array_tuple (type, init, allow_missing_elements)
     tree type;
     tree init;
     int allow_missing_elements;
{
  tree element = CONSTRUCTOR_ELTS (init);
  int is_constant = 1;
  int is_simple = 1;
  tree element_type = TREE_TYPE (type);
  tree default_value = NULL_TREE;
  tree element_list = NULL_TREE;
  tree domain_min;
  tree domain_max;
  tree *ptr = &element_list;
  int errors = 0;
  int labelled_elements = 0;
  int unlabelled_elements = 0;
  tree first, last = NULL_TREE;

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

  domain_min = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
  domain_max = TYPE_MAX_VALUE (TYPE_DOMAIN (type));

  if (domain_min == NULL || TREE_CODE (domain_min) != INTEGER_CST)
    {
      error ("non-constant start index for tuple");
      return error_mark_node;
    }
  if (TREE_CODE (domain_max) != INTEGER_CST)
    is_constant = 0;

  if (TREE_CODE (type) != ARRAY_TYPE)
    abort ();  

  for ( ; element != NULL_TREE; element = TREE_CHAIN (element))
    {
      tree purpose = TREE_PURPOSE (element);
      tree value   = TREE_VALUE (element);

      if (purpose == NULL_TREE)
	{
	  if (last == NULL_TREE)
	    first = domain_min;
	  else
	    {
	      HOST_WIDE_INT new_lo, new_hi;
	      add_double (TREE_INT_CST_LOW (last), TREE_INT_CST_HIGH (last),
			  1, 0,
			  &new_lo, &new_hi);
	      first = build_int_2 (new_lo, new_hi);
	      TREE_TYPE (first) = TYPE_DOMAIN (type);
	    }
	  last = first;
	  unlabelled_elements++;
	}
      else
	{
	  labelled_elements++;
	  if (TREE_CODE (purpose) == INTEGER_CST)
	    first = last = purpose;
	  else if (TREE_CODE (purpose) == TYPE_DECL
		   && discrete_type_p (TREE_TYPE (purpose)))
	    {
	      first = TYPE_MIN_VALUE (TREE_TYPE (purpose));
	      last = TYPE_MAX_VALUE (TREE_TYPE (purpose));
	    }
	  else if (TREE_CODE (purpose) != RANGE_EXPR)
	    {
	      error ("invalid array tuple label");
	      errors++;
	      continue;
	    }
	  else if (TREE_OPERAND (purpose, 0) == NULL_TREE)
	    first = last = NULL_TREE;  /* Default value. */
	  else
	    {
	      first = TREE_OPERAND (purpose, 0);
	      last = TREE_OPERAND (purpose, 1);
	    }
	  if ((first != NULL && TREE_CODE (first) != INTEGER_CST)
	      || (last != NULL && TREE_CODE (last) != INTEGER_CST))
	    {
	      error ("non-constant array tuple index range");
	      errors++;
	    }
	}

      if (! CH_COMPATIBLE (value, element_type))
	{
	  char *err_val_name = first ? display_int_cst (first) : "(default)";
	  error ("incompatible array tuple element %s", err_val_name);
	  value = error_mark_node;
	}
      else
	value = convert (element_type, value);
      if (TREE_CODE (value) == ERROR_MARK)
	errors++;
      else if (!TREE_CONSTANT (value))
	is_constant = 0;
      else if (!initializer_constant_valid_p (value, TREE_TYPE (value)))
	is_simple = 0;

      if (first == NULL_TREE)
	{
	  if (default_value != NULL)
	    {
	      error ("multiple (*) or (ELSE) array tuple labels");
	      errors++;
	    }
	  default_value = value;
	  continue;
	}

      if (first != last && tree_int_cst_lt (last, first))
	{
	  error ("empty range in array tuple");
	  errors++;
	  continue;
	}

      ptr = &element_list;

#define MAYBE_RANGE_OP(PURPOSE, OPNO) \
  (TREE_CODE (PURPOSE) == RANGE_EXPR ? TREE_OPERAND (PURPOSE, OPNO): PURPOSE)
#define CONSTRUCTOR_ELT_LO(ELT) MAYBE_RANGE_OP (TREE_PURPOSE (ELT), 0)
#define CONSTRUCTOR_ELT_HI(ELT) MAYBE_RANGE_OP (TREE_PURPOSE (ELT), 1)
      while (*ptr && tree_int_cst_lt (last,
				      CONSTRUCTOR_ELT_LO (*ptr)))
	ptr = &TREE_CHAIN (*ptr);
      if (*ptr && ! tree_int_cst_lt (CONSTRUCTOR_ELT_HI (*ptr), first))
	{
	  char *err_val_name = display_int_cst (first);
	  error ("array tuple has duplicate index %s", err_val_name);
	  errors++;
	  continue;
	}
      if ((ptr == &element_list && tree_int_cst_lt (domain_max, last))
	|| (*ptr == NULL_TREE && tree_int_cst_lt (first, domain_min)))
	{
	  if (purpose)
	    error ("array tuple index out of range");
	  else if (errors == 0)
	    error ("too many array tuple values");
	  errors++;
	  continue;
	}
      if (! tree_int_cst_lt (first, last))
	purpose = first;
      else if (purpose == NULL_TREE || TREE_CODE (purpose) != RANGE_EXPR)
	purpose = build_nt (RANGE_EXPR, first, last);
      *ptr = tree_cons (purpose, value, *ptr);
    }

  element_list = nreverse (element_list);

  /* For each missing element, set it to the default value,
     if there is one.  Otherwise, emit an error.  */

  if (errors == 0
      && (!allow_missing_elements || default_value != NULL_TREE))
    {
      /* Iterate over each *gap* between specified elements/ranges. */
      tree prev_elt;
      if (element_list &&
	  tree_int_cst_equal (CONSTRUCTOR_ELT_LO (element_list), domain_min))
	{
	  ptr = &TREE_CHAIN (element_list);
	  prev_elt = element_list;
	}
      else
	{
	  prev_elt = NULL_TREE;