typeck.c

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

    return 0;
#if 0
  ... other conditions ...;
#endif
  return 1;
}

/* See Z200 12.1.2.12 */

int
chill_read_compatible (modeM, modeN)
     tree modeM, modeN;
{
  while (TREE_CODE (modeM) == REFERENCE_TYPE)
    modeM = TREE_TYPE (modeM);
  while (TREE_CODE (modeN) == REFERENCE_TYPE)
    modeN = TREE_TYPE (modeN);

  if (!CH_EQUIVALENT (modeM, modeN))
    return 0;
  if (TYPE_READONLY (modeN))
    {
      if (!TYPE_READONLY (modeM))
	return 0;
      if (CH_IS_BOUND_REFERENCE_MODE (modeM)
	  && CH_IS_BOUND_REFERENCE_MODE (modeN))
	{
	  return chill_l_equivalent (TREE_TYPE (modeM), TREE_TYPE (modeN), 0);
	}
#if 0
      ...;
#endif
    }
  return 1;
}

/* Tests if MODE is compatible with the class of EXPR.
   Cfr. Chill Blue Book 12.1.2.15. */

int
chill_compatible (expr, mode)
     tree expr, mode;
{
  struct ch_class class;

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

  while (TREE_CODE (mode) == REFERENCE_TYPE)
    mode = TREE_TYPE (mode);

  if (TREE_TYPE (expr) == NULL_TREE)
    {
      if (TREE_CODE (expr) == CONSTRUCTOR)
	return TREE_CODE (mode) == RECORD_TYPE
	  || ((TREE_CODE (mode) == SET_TYPE || TREE_CODE (mode) == ARRAY_TYPE)
	      && ! TYPE_STRING_FLAG (mode));
      else
	return TREE_CODE (expr) == CASE_EXPR || TREE_CODE (expr) == COND_EXPR;
    }

  class = chill_expr_class (expr);
  switch (class.kind)
    {
    case CH_ALL_CLASS:
      return 1;
    case CH_NULL_CLASS:
      return CH_IS_REFERENCE_MODE (mode) || CH_IS_PROCEDURE_MODE (mode)
	|| CH_IS_INSTANCE_MODE (mode);
    case CH_VALUE_CLASS:
      if (CH_HAS_REFERENCING_PROPERTY (mode))
	return CH_RESTRICTABLE_TO(mode, class.mode);
      else
	return CH_V_EQUIVALENT(mode, class.mode);
    case CH_DERIVED_CLASS:
      return CH_SIMILAR (class.mode, mode);
    case CH_REFERENCE_CLASS:
      if (!CH_IS_REFERENCE_MODE (mode))
	return 0;
#if 0
      /* FIXME! */
      if (class.mode is a row mode)
	...;
      else if (class.mode is not a static mode)
	return 0; /* is this possible? FIXME */
#endif
      return !CH_IS_BOUND_REFERENCE_MODE(mode)
	|| CH_READ_COMPATIBLE (TREE_TYPE (mode), class.mode);
    }
  return 0; /* ERROR! */
}

/* Tests if the class of of EXPR1 and EXPR2 are compatible.
   Cfr. Chill Blue Book 12.1.2.16. */

int
chill_compatible_classes (expr1, expr2)
     tree expr1, expr2;
{
  struct ch_class temp;
  struct ch_class class1, class2;
  class1 = chill_expr_class (expr1);
  class2 = chill_expr_class (expr2);

  switch (class1.kind)
    {
    case CH_ALL_CLASS:
      return 1;
    case CH_NULL_CLASS:
      switch (class2.kind)
	{
	case CH_ALL_CLASS:
	case CH_NULL_CLASS:
	case CH_REFERENCE_CLASS:
	  return 1;
	case CH_VALUE_CLASS:
	case CH_DERIVED_CLASS:
	  goto rule4;
	}
    case CH_REFERENCE_CLASS:
      switch (class2.kind)
	{
	case CH_ALL_CLASS:
	case CH_NULL_CLASS:
	  return 1;
	case CH_REFERENCE_CLASS:
	  return CH_EQUIVALENT (class1.mode, class2.mode);
	case CH_VALUE_CLASS:
	  goto rule6;
	case CH_DERIVED_CLASS:
	  return 0;
	}
    case CH_DERIVED_CLASS:
      switch (class2.kind)
	{
	case CH_ALL_CLASS:
	  return 1;
	case CH_VALUE_CLASS:
	case CH_DERIVED_CLASS:
	  return CH_SIMILAR (class1.mode, class2.mode);
	case CH_NULL_CLASS:
	  class2 = class1;
	  goto rule4;
	case CH_REFERENCE_CLASS:
	  return 0;
	}
    case CH_VALUE_CLASS:
      switch (class2.kind)
	{
	case CH_ALL_CLASS:
	  return 1;
	case CH_DERIVED_CLASS:
	  return CH_SIMILAR (class1.mode, class2.mode);
	case CH_VALUE_CLASS:
	  return CH_V_EQUIVALENT (class1.mode, class2.mode);
	case CH_NULL_CLASS:
	  class2 = class1;
	  goto rule4;
	case CH_REFERENCE_CLASS:
	  temp = class1;  class1 = class2;  class2 = temp;
	  goto rule6;
	}
    }
 rule4:
  /* The Null class is Compatible with the M-derived class or M-value class
     if and only if M is a reference mdoe, procedure mode or instance mode.*/
  return CH_IS_REFERENCE_MODE (class2.mode)
    || CH_IS_PROCEDURE_MODE (class2.mode)
    || CH_IS_INSTANCE_MODE (class2.mode);

 rule6:
  /* The M-reference class is compatible with the N-value class if and
     only if N is a reference mode and ... */
  if (!CH_IS_REFERENCE_MODE (class2.mode))
    return 0;
  if (1) /* If M is a static mode - FIXME */
    {
      if (!CH_IS_BOUND_REFERENCE_MODE (class2.mode))
	return 1;
      if (CH_EQUIVALENT (TREE_TYPE (class2.mode), class1.mode))
	return 1;
    }
  /* If N is a row mode whose .... FIXME */
  return 0;
}

/* Cfr.  Blue Book 12.1.1.6, with some "extensions." */

tree
chill_root_mode (mode)
     tree mode;
{
  /* Reference types are not user-visible types.
     This seems like a good place to get rid of them. */
  if (TREE_CODE (mode) == REFERENCE_TYPE)
    mode = TREE_TYPE (mode);

  while (TREE_CODE (mode) == INTEGER_TYPE && TREE_TYPE (mode) != NULL_TREE)
    mode = TREE_TYPE (mode);  /* a sub-range */

  /* This extension in not in the Blue Book - which only has a
     single Integer type.
     We should probably use chill_integer_type_node rather
     than integer_type_node, but that is likely to bomb.
     At some point, these will become the same, I hope. FIXME */
  if (TREE_CODE (mode) == INTEGER_TYPE
      && TYPE_PRECISION (mode) < TYPE_PRECISION (integer_type_node)
      && CH_NOVELTY (mode) == NULL_TREE)
    mode = integer_type_node;
 
  if (TREE_CODE (mode) == FUNCTION_TYPE)
    return build_pointer_type (mode);

  return mode;
}

/* Cfr.  Blue Book 12.1.1.7. */

tree
chill_resulting_mode (mode1, mode2)
     tree mode1, mode2;
{
  mode1 = CH_ROOT_MODE (mode1);
  mode2 = CH_ROOT_MODE (mode2);
  if (chill_varying_type_p (mode1))
    return mode1;
  if (chill_varying_type_p (mode2))
    return mode2;
  return mode1;
}

/* Cfr.  Blue Book (z200, 1988) 12.1.1.7 Resulting class. */

struct ch_class
chill_resulting_class (class1, class2)
     struct ch_class class1, class2;
{
  struct ch_class class;
  switch (class1.kind)
    {
    case CH_VALUE_CLASS:
      switch (class2.kind)
	{
	case CH_DERIVED_CLASS:
	case CH_ALL_CLASS:
	  class.kind = CH_VALUE_CLASS;
	  class.mode = CH_ROOT_MODE (class1.mode);
	  return class;
	case CH_VALUE_CLASS:
	  class.kind = CH_VALUE_CLASS;
	  class.mode
	    = CH_ROOT_MODE (CH_RESULTING_MODE (class1.mode, class2.mode));
	  return class;
	default:
	  break;
	}
      break;
    case CH_DERIVED_CLASS:
      switch (class2.kind)
	{
	case CH_VALUE_CLASS:
	  class.kind = CH_VALUE_CLASS;
	  class.mode = CH_ROOT_MODE (class2.mode);
	  return class;
	case CH_DERIVED_CLASS:
	  class.kind = CH_DERIVED_CLASS;
	  class.mode = CH_RESULTING_MODE (class1.mode, class2.mode);
	  return class;
	case CH_ALL_CLASS:
	  class.kind = CH_DERIVED_CLASS;
	  class.mode = CH_ROOT_MODE (class1.mode);
	  return class;
	default:
	  break;
	}
      break;
    case CH_ALL_CLASS:
      switch (class2.kind)
	{
	case CH_VALUE_CLASS:
	  class.kind = CH_VALUE_CLASS;
	  class.mode = CH_ROOT_MODE (class2.mode);
	  return class;
	case CH_ALL_CLASS:
	  class.kind = CH_ALL_CLASS;
	  class.mode = NULL_TREE;
	  return class;
	case CH_DERIVED_CLASS:
	  class.kind = CH_DERIVED_CLASS;
	  class.mode = CH_ROOT_MODE (class2.mode);
	  return class;
	default:
	  break;
	}
      break;
    default:
      break;
    }
  error ("internal error in chill_root_resulting_mode");
  class.kind = CH_VALUE_CLASS;
  class.mode = CH_ROOT_MODE (class1.mode);
  return class;
}


/*
 * See Z.200, section 6.3, static conditions. This function
 * returns bool_false_node if the condition is not met at compile time,
 *         bool_true_node if the condition is detectably met at compile time
 *         an expression if a runtime check would be required or was generated.
 * It should only be called with string modes and values.
 */
tree
string_assignment_condition (lhs_mode, rhs_value)
     tree lhs_mode, rhs_value;
{
  tree lhs_size, rhs_size, cond;
  tree rhs_mode = TREE_TYPE (rhs_value);
  int lhs_varying = chill_varying_type_p (lhs_mode);

  if (lhs_varying)
    lhs_size = size_in_bytes (CH_VARYING_ARRAY_TYPE (lhs_mode));
  else if (CH_BOOLS_TYPE_P (lhs_mode))
    lhs_size = TYPE_MAX_VALUE (TYPE_DOMAIN (lhs_mode));
  else
    lhs_size = size_in_bytes (lhs_mode);
  lhs_size = convert (chill_unsigned_type_node, lhs_size);

  if (rhs_mode && TREE_CODE (rhs_mode) == REFERENCE_TYPE)
    rhs_mode = TREE_TYPE (rhs_mode);
  if (rhs_mode == NULL_TREE)
    {
      /* actually, count constructor's length */
      abort ();
    }
  else if (chill_varying_type_p (rhs_mode))
    rhs_size = build_component_ref (rhs_value, var_length_id);
  else if (CH_BOOLS_TYPE_P (rhs_mode))
    rhs_size = TYPE_MAX_VALUE (TYPE_DOMAIN (rhs_mode));
  else
    rhs_size = size_in_bytes (rhs_mode);
  rhs_size = convert (chill_unsigned_type_node, rhs_size);

  /* validity condition */
  cond = fold (build (lhs_varying ? GE_EXPR : EQ_EXPR, 
	   boolean_type_node, lhs_size, rhs_size));
  return cond;
}

/*
 * take a basic CHILL type and wrap it in a VARYING structure.
 * Be sure the length field is initialized.  Return the wrapper.
 */
tree
build_varying_struct (type)
     tree type;
{  
  tree decl1, decl2, result;

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

  decl1 = build_decl (FIELD_DECL, var_length_id, chill_integer_type_node);
  decl2 = build_decl (FIELD_DECL, var_data_id, type);
  TREE_CHAIN (decl1) = decl2;      
  TREE_CHAIN (decl2) = NULL_TREE;
  result = build_chill_struct_type (decl1);

  /* mark this so we don't complain about missing initializers.
     It's fine for a VARYING array to be partially initialized.. */
  C_TYPE_VARIABLE_SIZE(type) = 1;
  return result;
}


/*
 * This is the struct type that forms the runtime initializer
 * list.  There's at least one of these generated per module.
 * It's attached to the global initializer list by the module's
 * 'constructor' code.  Should only be called in pass 2.
 */
tree
build_init_struct ()
{
  tree decl1, decl2, result;
  /* We temporarily reset the maximum_field_alignment to zero so the
     compiler's init data structures can be compatible with the
     run-time system, even when we're compiling with -fpack. */
  extern int maximum_field_alignment;
  int save_maximum_field_alignment = maximum_field_alignment;
  maximum_field_alignment = 0;

  decl1 = build_decl (FIELD_DECL, get_identifier ("__INIT_ENTRY"),
	    build_chill_pointer_type (
              build_function_type (void_type_node, NULL_TREE)));

  decl2 = build_decl (FIELD_DECL, get_identifier ("__INIT_NEXT"),
		      build_chill_pointer_type (void_type_node));

  TREE_CHAIN (decl1) = decl2;      
  TREE_CHAIN (decl2) = NULL_TREE;
  result = build_chill_struct_type (decl1);
  maximum_field_alignment = save_maximum_field_alignment;
  return result;
}


/*
 * Return 1 if the given type is a single-bit boolean set,
 *          in which the domain's min and max values 
 *          are both zero,
 *        0 if not.  This can become a macro later..
 */
int
ch_singleton_set (type)
     tree type;
{
  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
    return 0;
  if (TREE_CODE (type) != SET_TYPE)
    return 0;
  if (TREE_TYPE (type) == NULL_TREE 
      || TREE_CODE (TREE_TYPE (type)) != BOOLEAN_TYPE)
    return 0;
  if (TYPE_DOMAIN (type) == NULL_TREE)
    return 0;
  if (! tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)),
			    integer_zero_node))
    return 0;
  if (! tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)),
			    integer_zero_node))
    return 0;
  return 1;
}

/* return non-zero if TYPE is a compiler-generated VARYING
   array of some base type */
int
chill_varying_type_p (type)
     tree type;
{
  if (type == NULL_TREE)
    return 0;
  if (TREE_CODE (type) != RECORD_TYPE)
    ret