expr.c

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

 * return 0 if they might be compatible
 */
static int
invalid_operand (code, type, right)
     enum chill_tree_code code;
     tree type;
     int right; /* 1 if right operand */
{
  switch ((int)code)
    {
    case ADDR_EXPR:
      break;
    case BIT_AND_EXPR:
    case BIT_IOR_EXPR:
    case BIT_NOT_EXPR:
    case BIT_XOR_EXPR:
      goto relationals;
    case CASE_EXPR:
      break;
    case CEIL_MOD_EXPR:
      goto numerics;
    case CONCAT_EXPR:           /* must be static or varying char array */
      if (TREE_CODE (type) == CHAR_TYPE)
	return 0;
      if (TREE_CODE (type) == ARRAY_TYPE 
	   && TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
	return 0;
      if (!chill_varying_type_p (type))
	  return 1;
      if (TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type)))
            == CHAR_TYPE)
        return 0;
      else
        return 1;
    /* note: CHILL conditional expressions (COND_EXPR) won't come
     *  through here; they're routed straight to C-specific code */
    case EQ_EXPR:
      return 0;                  /* ANYTHING can be compared equal */
    case FLOOR_MOD_EXPR:
      if (TREE_CODE (type) == REAL_TYPE)
	return 1;
      goto numerics;
    case GE_EXPR:
    case GT_EXPR:
      goto relatables;
    case SET_IN_EXPR:
      if (TREE_CODE (type) == SET_TYPE)
        return 0;
      else
        return 1;
    case PACKED_ARRAY_REF:
      if (TREE_CODE (type) == ARRAY_TYPE)
        return 0;
      else
        return 1;
    case LE_EXPR:
    case LT_EXPR:
    relatables:
      switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
	{
	case ARRAY_TYPE:
	  if (TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
	    return 0;
	  else
	    return 1;
	case BOOLEAN_TYPE:
	case CHAR_TYPE:
	case COMPLEX_TYPE:
	case ENUMERAL_TYPE:
	case INTEGER_TYPE:
	case OFFSET_TYPE:
	case POINTER_TYPE:
	case REAL_TYPE:
	case SET_TYPE:
	  return 0;
	case FILE_TYPE:
	case FUNCTION_TYPE:
	case GRANT_TYPE:
	case LANG_TYPE:
	case METHOD_TYPE:
	  return 1;
	case RECORD_TYPE:
	  if (chill_varying_type_p (type)
	      && TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type))) == CHAR_TYPE)
	    return 0;
	  else
	    return 1;
	case REFERENCE_TYPE:
	case SEIZE_TYPE:
	case UNION_TYPE:
	case VOID_TYPE:
	  return 1;
	}
      break;
    case MINUS_EXPR:
    case MULT_EXPR:
      goto numerics;
    case NEGATE_EXPR:
      if (TREE_CODE (type) == BOOLEAN_TYPE)
        return 0;
      else
	goto numerics;
    case NE_EXPR:
      return 0;                  /* ANYTHING can be compared unequal */
    case NOP_EXPR:
      return 0;                  /* ANYTHING can be converted */
    case PLUS_EXPR:
    numerics:
      switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
	{
	case ARRAY_TYPE:
	  if (right || TREE_CODE (TREE_TYPE (type)) != BOOLEAN_TYPE)
	    return 1;
	  else
	    return 0;
	case CHAR_TYPE:
	  return right;
	case BOOLEAN_TYPE:
	case COMPLEX_TYPE:
	case FILE_TYPE:
	case FUNCTION_TYPE:
	case GRANT_TYPE:
	case LANG_TYPE:
	case METHOD_TYPE:
	case RECORD_TYPE:
	case REFERENCE_TYPE:
	case SEIZE_TYPE:
	case UNION_TYPE:
	case VOID_TYPE:
	  return 1;
	case ENUMERAL_TYPE:
	case INTEGER_TYPE:
	case OFFSET_TYPE:
	case POINTER_TYPE:
	case REAL_TYPE:
	case SET_TYPE:
	  return 0;
	}
      break;
    case RANGE_EXPR:
      break;

    case REPLICATE_EXPR:
      switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
	{
	case COMPLEX_TYPE:
	case FILE_TYPE:
	case FUNCTION_TYPE:
	case GRANT_TYPE:
	case LANG_TYPE:
	case METHOD_TYPE:
	case OFFSET_TYPE:
	case POINTER_TYPE:
	case RECORD_TYPE:
	case REAL_TYPE:
	case SEIZE_TYPE:
	case UNION_TYPE:
	case VOID_TYPE:
	  return 1;
	case ARRAY_TYPE:
	case BOOLEAN_TYPE:
	case CHAR_TYPE:
	case ENUMERAL_TYPE:
	case INTEGER_TYPE:
	case REFERENCE_TYPE:
	case SET_TYPE:
	  return 0;
	}
      
    case TRUNC_DIV_EXPR:
      goto numerics;
    case TRUNC_MOD_EXPR:
      if (TREE_CODE (type) == REAL_TYPE)
	return 1;
      goto numerics;
    case TRUTH_ANDIF_EXPR:
    case TRUTH_AND_EXPR:
    case TRUTH_NOT_EXPR:
    case TRUTH_ORIF_EXPR:
    case TRUTH_OR_EXPR:
    relationals:
      switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
	{
	case ARRAY_TYPE:
	case CHAR_TYPE:
	case COMPLEX_TYPE:
	case ENUMERAL_TYPE:
	case FILE_TYPE:
	case FUNCTION_TYPE:
	case GRANT_TYPE:
	case INTEGER_TYPE:
	case LANG_TYPE:
	case METHOD_TYPE:
	case OFFSET_TYPE:
	case POINTER_TYPE:
	case REAL_TYPE:
	case RECORD_TYPE:
	case REFERENCE_TYPE:
	case SEIZE_TYPE:
	case UNION_TYPE:
	case VOID_TYPE:
	  return 1;
	case BOOLEAN_TYPE:
	case SET_TYPE:
	  return 0;
	}
      break;

    default:
      return 1;       /* perhaps you forgot to add a new DEFTREECODE? */
    }
  return 1;
}


static int
invalid_right_operand (code, type)
     enum chill_tree_code code;
     tree type;
{
  return invalid_operand (code, type, 1);
}

tree
build_chill_abs (expr)
     tree expr;
{
  tree temp;

  if (TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE
      || discrete_type_p (TREE_TYPE (expr)))
    temp = fold (build1 (ABS_EXPR, TREE_TYPE (expr), expr));
  else 
    {
      error("ABS argument must be discrete or real mode");
      return error_mark_node;
    }
  /* FIXME: should call
   * cond_type_range_exception (temp);
   */
  return temp;
}

tree
build_chill_abstime (exprlist)
     tree exprlist;
{
  int  mask = 0, i, numargs;
  tree args = NULL_TREE;
  tree filename, lineno;
  int  had_errors = 0;
  tree tmp;

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

  /* check for integer expressions */
  i = 1;
  tmp = exprlist;
  while (tmp != NULL_TREE)
    {
      tree exp = TREE_VALUE (tmp);

      if (exp == NULL_TREE || TREE_CODE (exp) == ERROR_MARK)
	had_errors = 1;
      else if (TREE_CODE (TREE_TYPE (exp)) != INTEGER_TYPE)
	{
	  error ("argument %d to ABSTIME must be of integer type.", i);
	  had_errors = 1;
	}
      tmp = TREE_CHAIN (tmp);
      i++;
    }
  if (had_errors)
    return error_mark_node;

  numargs = list_length (exprlist);
  for (i = 0; i < numargs; i++)
    mask |= (1 << i);

  /* make it all arguments */
  for (i = numargs; i < 6; i++)
    exprlist = tree_cons (NULL_TREE, integer_zero_node, exprlist);

  args = tree_cons (NULL_TREE, build_int_2 (mask, 0), exprlist);

  filename = force_addr_of (get_chill_filename ());
  lineno = get_chill_linenumber ();
  args = chainon (args, tree_cons (NULL_TREE, filename,
			  tree_cons (NULL_TREE, lineno, NULL_TREE)));

  return build_chill_function_call (
    lookup_name (get_identifier ("_abstime")), args);
}


tree
build_allocate_memory_call (ptr, size)
  tree ptr, size;
{
  int err = 0;
    
  /* check for ptr is referable */
  if (! CH_REFERABLE (ptr))
    {
      error ("parameter 1 must be referable.");
      err++;
    }
   /* check for pointer */
  else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
    {
      error ("mode mismatch in parameter 1.");
      err++;
    }

  /* check for size > 0 if it is a constant */
  if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
    {
      error ("parameter 2 must be a positive integer.");
      err++;
    }
  if (err)
    return error_mark_node;

  if (TREE_TYPE (ptr) != ptr_type_node)
    ptr = build_chill_cast (ptr_type_node, ptr);

  return build_chill_function_call (
    lookup_name (get_identifier ("_allocate_memory")),
           tree_cons (NULL_TREE, ptr,
	     tree_cons (NULL_TREE, size,
	       tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
		 tree_cons (NULL_TREE, get_chill_linenumber (), 
			    NULL_TREE)))));
}


tree
build_allocate_global_memory_call (ptr, size)
  tree ptr, size;
{
  int err = 0;
    
  /* check for ptr is referable */
  if (! CH_REFERABLE (ptr))
    {
      error ("parameter 1 must be referable.");
      err++;
    }
  /* check for pointer */
  else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
    {
      error ("mode mismatch in parameter 1.");
      err++;
    }

  /* check for size > 0 if it is a constant */
  if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
    {
      error ("parameter 2 must be a positive integer.");
      err++;
    }
  if (err)
    return error_mark_node;
    
  if (TREE_TYPE (ptr) != ptr_type_node)
    ptr = build_chill_cast (ptr_type_node, ptr);

  return build_chill_function_call (
    lookup_name (get_identifier ("_allocate_global_memory")),
           tree_cons (NULL_TREE, ptr,
	     tree_cons (NULL_TREE, size,
	       tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
		 tree_cons (NULL_TREE, get_chill_linenumber (), 
			    NULL_TREE)))));
}


tree
build_return_memory (ptr)
  tree ptr;
{
  /* check input */
  if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
      return error_mark_node;
  
  /* check for pointer */
  if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
    {
      error ("mode mismatch in parameter 1.");
      return error_mark_node;
    }

  if (TREE_TYPE (ptr) != ptr_type_node)
    ptr = build_chill_cast (ptr_type_node, ptr);

  return build_chill_function_call (
    lookup_name (get_identifier ("_return_memory")),
      tree_cons (NULL_TREE, ptr,
	tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
	  tree_cons (NULL_TREE, get_chill_linenumber (), 
		     NULL_TREE))));
}


/* Compute the number of runtime members of the
 * given powerset.
 */
tree
build_chill_card (powerset)
     tree powerset;
{
  if (pass == 2)
    {
      tree temp;
      tree card_func = lookup_name (get_identifier ("__cardpowerset"));
      
      if (powerset == NULL_TREE || TREE_CODE (powerset) == ERROR_MARK)
	return error_mark_node;
      
      if (TREE_CODE (powerset) == IDENTIFIER_NODE)
	powerset = lookup_name (powerset);

      if (TREE_CODE (TREE_TYPE(powerset)) == SET_TYPE)
	{ int size;

	  /* Do constant folding, if possible. */
	  if (TREE_CODE (powerset) == CONSTRUCTOR
	      && TREE_CONSTANT (powerset)
	      && (size = int_size_in_bytes (TREE_TYPE (powerset))) >= 0)
	    {
	      int bit_size = size * BITS_PER_UNIT;
	      char* buffer = (char*) alloca (bit_size);
	      temp = get_set_constructor_bits (powerset, buffer, bit_size);
	      if (!temp)
		{ int i;
		  int count = 0;
		  for (i = 0; i < bit_size; i++)
		    if (buffer[i])
		      count++;
		  temp = build_int_2 (count, 0);
		  TREE_TYPE (temp) = TREE_TYPE (TREE_TYPE (card_func));
		  return temp;
		}
	    }
	  temp = build_chill_function_call (card_func,
		     tree_cons (NULL_TREE, force_addr_of (powerset),
		       tree_cons (NULL_TREE, powersetlen (powerset), NULL_TREE)));
	  /* FIXME: should call
	   * cond_type_range_exception (op0);
	   */
	  return temp;
	}
      error("CARD argument must be powerset mode");
      return error_mark_node;
    }
  return NULL_TREE;
}

/* function to build the type needed for the DESCR-built-in
 */

void build_chill_descr_type ()
{
  tree decl1, decl2;
  
  if (descr_type != NULL_TREE)
    /* already done */
    return;
  
  decl1 = build_decl (FIELD_DECL, get_identifier ("datap"), ptr_type_node);
  decl2 = build_decl (FIELD_DECL, get_identifier ("len"),
		      TREE_TYPE (lookup_name (
					      get_identifier ((ignore_case || ! special_UC) ? "ulong" : "ULONG"))));