expr.c

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

	  class.mode = type;
	  return convert_to_class (class, val);
	}
      else if (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == SET_TYPE)
	{
	  if (TYPE_STRING_FLAG (type))
	    {
	      class.kind = CH_DERIVED_CLASS;
	      class.mode = integer_type_node;
	    }
	  else
	    {
	      class.kind = CH_VALUE_CLASS;
	      class.mode = TYPE_DOMAIN (type);
	    }
	  type = TYPE_DOMAIN (type);
	  return convert_to_class (class,
				   is_upper
				   ? TYPE_MAX_VALUE (type)
				   : TYPE_MIN_VALUE (type));
	}
      if (is_upper)
	error("UPPER argument must be string, array, mode or integer");
      else
	error("LOWER argument must be string, array, mode or integer");
      return error_mark_node;
    }
  return NULL_TREE;
}

tree
build_chill_lower (what)
     tree what;
{
  return build_chill_lower_or_upper (what, 0);
}

static tree
build_max_min (expr, max_min)
     tree expr;
     int max_min; /* 0: calculate MIN; 1: calculate MAX */
{
  if (pass == 2)
    {
      tree type, temp, setminval;
      tree set_base_type;
      int size_in_bytes;
      
      if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
	return error_mark_node;
      
      if (TREE_CODE (expr) == IDENTIFIER_NODE)
	expr = lookup_name (expr);

      type = TREE_TYPE (expr);
      set_base_type = TYPE_DOMAIN (type);
      setminval = TYPE_MIN_VALUE (set_base_type);
      
      if (TREE_CODE (type) != SET_TYPE)
	{
	  error("%s argument must be POWERSET mode",
		max_min ? "MAX" : "MIN");
	  return error_mark_node;
	}

      /* find max/min of constant powerset at compile time */
      if (TREE_CODE (expr) == CONSTRUCTOR && TREE_CONSTANT (expr)
	  && (size_in_bytes = int_size_in_bytes (type)) >= 0)
	{
	  HOST_WIDE_INT min_val = -1, max_val = -1;
	  HOST_WIDE_INT i, i_hi = 0;
	  HOST_WIDE_INT size_in_bits = size_in_bytes * BITS_PER_UNIT;
	  char *buffer = (char*) alloca (size_in_bits);
	  if (buffer == NULL
	      || get_set_constructor_bits (expr, buffer, size_in_bits))
	    abort ();
	  for (i = 0; i < size_in_bits; i++)
	    {
	      if (buffer[i])
		{
		  if (min_val < 0)
		    min_val = i;
		  max_val = i;
		}
	    }
	  if (min_val < 0)
	    error ("%s called for empty POWERSET", max_min ? "MAX" : "MIN");
	  i = max_min ? max_val : min_val;
	  temp = TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (expr)));
	  add_double (i, i_hi,
		      TREE_INT_CST_LOW (temp), TREE_INT_CST_HIGH (temp),
		      &i, &i_hi);
	  temp = build_int_2 (i, i_hi);
	  TREE_TYPE (temp) = set_base_type;
	  return temp;
	}
      else
	{
	  tree parmlist, filename, lineno;
	  char *funcname;
	  
	  /* set up to call appropriate runtime function */
	  if (max_min)
	    funcname = "__flsetpowerset";
	  else
	    funcname = "__ffsetpowerset";
	  
	  setminval = convert (long_integer_type_node, setminval);
	  filename = force_addr_of (get_chill_filename());
	  lineno = get_chill_linenumber();
	  parmlist = tree_cons (NULL_TREE, force_addr_of (expr),
		       tree_cons (NULL_TREE, powersetlen (expr),
			 tree_cons (NULL_TREE, setminval,
			   tree_cons (NULL_TREE, filename,
			     build_tree_list (NULL_TREE, lineno)))));
	  temp = lookup_name (get_identifier (funcname));
	  temp = build_chill_function_call (temp, parmlist);
	  TREE_TYPE (temp) = set_base_type;
	  return temp;
	}
    }
  return NULL_TREE;
}


/* Compute the current runtime maximum value of the powerset
 */
tree
build_chill_max (expr)
     tree expr;
{
  return build_max_min (expr, 1);
}


/* Compute the current runtime minimum value of the powerset
 */
tree
build_chill_min (expr)
     tree expr;
{
  return build_max_min (expr, 0);
}


/* Build a conversion from the given expression to an INT,
 * but only when the expression's type is the same size as
 * an INT.
 */
tree
build_chill_num (expr)
     tree expr;
{
  if (pass == 2)
    {
      tree temp;
      int need_unsigned;

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

      expr = convert_to_discrete (expr);
      if (expr == NULL_TREE)
	{
	  error ("argument to NUM is not discrete");
	  return error_mark_node;
	}

      /* enumeral types and string slices of length 1 must be kept unsigned */
      need_unsigned = (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE)
	|| TREE_UNSIGNED (TREE_TYPE (expr));

      temp = type_for_size (TYPE_PRECISION (TREE_TYPE (expr)), 
			    need_unsigned);
      if (temp == NULL_TREE)
	{
	  error ("No integer mode which matches expression's mode");
	  return integer_zero_node;
	}
      temp = convert (temp, expr);

      if (TREE_CONSTANT (temp))
	{
	  if (tree_int_cst_lt (temp, 
			       TYPE_MIN_VALUE (TREE_TYPE (temp))))
	    error ("NUM's parameter is below its mode range");
	  if (tree_int_cst_lt (TYPE_MAX_VALUE (TREE_TYPE (temp)),
	                       temp))
	    error ("NUM's parameter is above its mode range");
	}
#if 0
      else
	{
	  if (range_checking)
	    cond_overflow_exception (temp, 
	      TYPE_MIN_VALUE (TREE_TYPE (temp)),
	      TYPE_MAX_VALUE (TREE_TYPE (temp)));
	}
#endif

      /* NUM delivers the INT derived class */
      CH_DERIVED_FLAG (temp) = 1;
      
      return temp;
    }
  return NULL_TREE;
}


static tree
build_chill_pred_or_succ (expr, op)
     tree expr;
     enum tree_code op; /* PLUS_EXPR for SUCC; MINUS_EXPR for PRED. */
{
  struct ch_class class;
  tree etype, cond;

  if (pass == 1)
    return NULL_TREE;

  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
    return error_mark_node;
  
  /* disallow numbered SETs */
  if (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE
      && CH_ENUM_IS_NUMBERED (TREE_TYPE (expr)))
    {
      error ("Cannot take SUCC or PRED of a numbered SET");
      return error_mark_node;
    }
  
  if (TREE_CODE (TREE_TYPE (expr)) == POINTER_TYPE)
    {
      if (TREE_TYPE (TREE_TYPE (expr)) == void_type_node)
	{
	  error ("SUCC or PRED must not be done on a PTR.");
	  return error_mark_node;
	}
      pedwarn ("SUCC or PRED for a reference type is not standard.");
      return fold (build (op, TREE_TYPE (expr),
			  expr,
			  size_in_bytes (TREE_TYPE (TREE_TYPE (expr)))));
    }

  expr = convert_to_discrete (expr);

  if (expr == NULL_TREE)
    {
      error ("SUCC or PRED argument must be a discrete mode");
      return error_mark_node;
    }

  class = chill_expr_class (expr);
  if (class.mode)
    class.mode = CH_ROOT_MODE (class.mode);
  etype = class.mode;
  expr = convert (etype, expr);

  /* Exception if expression is already at the
     min (PRED)/max(SUCC) valid value for its type. */
  cond = fold (build (op == PLUS_EXPR ? GE_EXPR : LE_EXPR,
		      boolean_type_node,
		      expr,
		      convert (etype,
			       op == PLUS_EXPR ? TYPE_MAX_VALUE (etype)
			       : TYPE_MIN_VALUE (etype))));
  if (TREE_CODE (cond) == INTEGER_CST
      && tree_int_cst_equal (cond, integer_one_node))
    {
      error ("Taking the %s of a value already at its %s value",
	     op == PLUS_EXPR ? "SUCC" : "PRED",
	     op == PLUS_EXPR ? "maximum" : "minimum");
      return error_mark_node;
    }

  if (range_checking)
    expr = check_expression (expr, cond,
			     ridpointers[(int) RID_OVERFLOW]);

  expr = fold (build (op, etype, expr, 
	   convert (etype, integer_one_node)));
  return convert_to_class (class, expr);
}

/* Compute the value of the CHILL `size' operator just
 * like the C 'sizeof' operator (code stolen from c-typeck.c)
 * TYPE may be a location or mode tree.  In pass 1, we build
 * a function-call syntax tree;  in pass 2, we evaluate it.
 */
tree
build_chill_sizeof (type)
     tree type;
{
  if (pass == 2)
    {
      tree temp;
      struct ch_class class;
      enum tree_code code;
      tree signame = NULL_TREE;

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

      if (TREE_CODE (type) == IDENTIFIER_NODE)
	type = lookup_name (type);

      code = TREE_CODE (type);
      if (code == ERROR_MARK)
	return error_mark_node;
      
      if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
	{
	  if (TREE_CODE (type) == TYPE_DECL && CH_DECL_SIGNAL (type))
	    signame = DECL_NAME (type);
	type = TREE_TYPE (type);
	}

      if (code == FUNCTION_TYPE)
	{
	  if (pedantic || warn_pointer_arith)
	    pedwarn ("size applied to a function mode");
	  return error_mark_node;
	}
      if (code == VOID_TYPE)
	{
	  if (pedantic || warn_pointer_arith)
	    pedwarn ("sizeof applied to a void mode");
	  return error_mark_node;
	}
      if (TYPE_SIZE (type) == 0)
	{
	  error ("sizeof applied to an incomplete mode");
	  return error_mark_node;
	}
      
      temp = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
			 size_int (TYPE_PRECISION (char_type_node)));
      if (signame != NULL_TREE)
        {
          /* we have a signal definition. This signal may have no
             data items specified. The definition however says that
             there are data, cause we cannot build a structure without
             fields. In this case return 0. */
          if (IDENTIFIER_SIGNAL_DATA (signame) == 0)
            temp = integer_zero_node;
        }
      
      /* FIXME: should call
       * cond_type_range_exception (temp);
       */
      class.kind = CH_DERIVED_CLASS;
      class.mode = integer_type_node;
      return convert_to_class (class, temp);
    }
  return NULL_TREE;
}

/* Compute the declared maximum value of the variable,
 * expression or declared type
 */
tree
build_chill_upper (what)
     tree what;
{
  return build_chill_lower_or_upper (what, 1);
}

/*
 * Here at the site of a function/procedure call..  We need to build
 * temps for the INOUT and OUT parameters, and copy the actual parameters
 * into the temps.  After the call, we 'copy back' the values from the
 * temps to the actual parameter variables.  This somewhat verbose pol-
 * icy meets the requirement that the actual parameters are undisturbed
 * if the function/procedure causes an exception.  They are updated only
 * upon a normal return from the function.
 *
 * Note: the expr_list, which collects all of the above assignments, etc,
 * is built in REVERSE execution order.  The list is corrected by nreverse
 * inside the build_chill_compound_expr call.
 */
tree
build_chill_function_call (function, expr)
     tree function, expr;
{
  register tree typetail, valtail, typelist;
  register tree temp, actual_args = NULL_TREE;
  tree name = NULL_TREE;
  tree function_call;
  tree fntype;
  int parmno = 1;            /* parameter number for error message */
  int callee_raise_exception = 0;

  /* list of assignments to run after the actual call,
     copying from the temps back to the user's variables. */
  tree copy_back = NULL_TREE;

  /* list of expressions to run before the call, copying from
     the user's variable to the temps that are passed to the function */
  tree expr_list = NULL_TREE;
 
  if (function == NULL_TREE || TREE_CODE (function) == ERROR_MARK)
    return error_mark_node;

  if (expr != NULL_TREE && TREE_CODE (expr) == ERROR_MARK)
    return error_mark_node;

  if (pass < 2)
    return error_mark_node;

  fntype = TREE_TYPE (function);
  if (TREE_CODE (function) == FUNCTION_DECL)
    {
      callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;

      /* Differs from default_conversion by not setting TREE_ADDRESSABLE
	 (because calling an inline function does not mean the function
	 needs to be separately compiled).  */
      fntype = build_type_variant (fntype,
				   TREE_READONLY (function),
				   TREE_THIS_VOLATILE (function));
      name = DECL_NAME (function);

      /* check that function is not a PROCESS */
      if (CH_DECL_PROCESS (function))
	{
	  error ("cannot call a PROCESS, you START a PROCESS");
	  return error_mark_node;
	}

      function = build1 (ADDR_EXPR, build_pointer_type (fntype), function);
    }
  else if (TREE_CODE (fntype) == POINTER_TYPE)
    {
      fntype = TREE_TYPE (fntype);
      callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;

      /* Z.200 6.7 Call Action:
	 "A procedure call causes the EMPTY exception if the
	 procedure primitive value delivers NULL. */
      if (TREE_CODE (function) != ADDR_EXPR
	  || TREE_CODE (TREE_OPERAND (function, 0)) != FUNCTION_DECL)
	function = check_non_null (function);
    }

  typelist = TYPE_ARG_TYPES (fntype);
  if (callee_raise_exception)
    {
      /* remove last two arguments from list for subsequent checking.
	  They will get added automatically after checking */
      int len = list_length (typelist);
      int i;
      tree newtypelist = NULL_TREE;
      tree wrk = typelist;
      
      for (i = 0; i < len - 3; i++)
	{
	    newtypelist = tree_cons (TREE_PURPOSE (wrk), TREE_VALUE (wrk), newtypelist);
	      wrk = TREE_CHAIN (wrk);
	  }
      /* add the void_type_node */
      newtypelist = tree_cons (NULL_TREE, void_type_node, newtypelist);
      typelist = nreverse (newtypelist);
    }

  /* Scan the given expressions and types, producing individual
     converted arguments and pushing them on ACTUAL_ARGS in 
     reverse order.  */
  for (val