actions.c

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

{
  long i;
  for (i = 0;  i < count; i++)
    {
      if (BITARRAY_TEST(cases_seen, i) == 0)
	{
	  char buf[20];
	  long x = i;
	  long j;
	  tree t = type;
	  char *err_val_name = "???";
	  if (TYPE_MIN_VALUE (t)
	      && TREE_CODE (TYPE_MIN_VALUE (t)) == INTEGER_CST)
	    x += TREE_INT_CST_LOW (TYPE_MIN_VALUE (t));
	  while (TREE_TYPE (t) != NULL_TREE)
	    t = TREE_TYPE (t);
	  switch (TREE_CODE (t))
	    {
	      tree v;
	    case BOOLEAN_TYPE:
	      err_val_name = x ? "TRUE" : "FALSE";
	      break;
	    case CHAR_TYPE:
	      if ((x >= ' ' && x < 127) && x != '\'' && x != '^')
		sprintf (buf, "'%c'", (char)x);
	      else
		sprintf (buf, "'^(%ld)'", x);
	      err_val_name = buf;
	      j = i;
	      while (j < count && !BITARRAY_TEST(cases_seen, j))
		j++;
	      if (j > i + 1)
		{
		  long y = x+j-i-1;
		  err_val_name += strlen (err_val_name);
		  if ((y >= ' ' && y < 127) && y != '\'' && y != '^')
		    sprintf (err_val_name, "%s:'%c'", buf, (char)y);
		  else
		    sprintf (err_val_name, "%s:'^(%ld)'", buf, y);
		  i = j - 1;      
		}
	      break;
	    case ENUMERAL_TYPE:
	      for (v = TYPE_VALUES (t);  v && x;  v = TREE_CHAIN (v))
		x--;
	      if (v)
		err_val_name = IDENTIFIER_POINTER (TREE_PURPOSE (v));
	      break;
	    default:
	      j = i;
	      while (j < count && !BITARRAY_TEST(cases_seen, j))
		j++;
	      if (j == i + 1)
		sprintf (buf, "%ld", x);
	      else
		sprintf (buf, "%ld:%ld", x, x+j-i-1);
	      i = j - 1;      
	      err_val_name = buf;
	      break;
	    }
	  error ("incomplete CASE - %s not handled", err_val_name);
	}
    }
}

void
check_missing_cases (type)
     tree type;
{
  int is_sparse;
  /* For each possible selector value. a one iff it has been matched
     by a case value alternative. */
  unsigned char *cases_seen;
  /* The number of possible selector values. */
  HOST_WIDE_INT size = all_cases_count (type, &is_sparse);
  long bytes_needed = (size+HOST_BITS_PER_CHAR)/HOST_BITS_PER_CHAR;

  if (size == -1)
    warning ("CASE selector with variable range");
  else if (size < 0 || size > 600000
	   /* We deliberately use malloc here - not xmalloc. */
	   || (cases_seen = (char*) malloc (bytes_needed)) == NULL)
    warning ("too many cases to do CASE completeness testing");
  else
    {
      bzero (cases_seen, bytes_needed);
      mark_seen_cases (type, cases_seen, size, is_sparse);
      print_missing_cases (type, cases_seen, size);
      free (cases_seen);
    }
}

/*
 * We build an expression tree here because, in many contexts,
 * we don't know the type of result that's desired.  By the
 * time we get to expanding the tree, we do know.
 */
tree
build_chill_case_expr (exprlist, casealtlist_expr,
		       optelsecase_expr)
     tree exprlist, casealtlist_expr, optelsecase_expr;
{
  return build (CASE_EXPR, NULL_TREE, exprlist,
		optelsecase_expr ?
		  tree_cons (NULL_TREE,
			     optelsecase_expr,
			     casealtlist_expr) :
		  casealtlist_expr);
}

/* This function transforms the selector_list and alternatives into a COND_EXPR. */
tree
build_chill_multi_dimension_case_expr (selector_list, alternatives, else_expr)
  tree selector_list, alternatives, else_expr;
{
  tree expr;

  selector_list = check_case_selector_list (selector_list);

  if (alternatives == NULL_TREE)
    return NULL_TREE;

  alternatives = nreverse (alternatives);
  /* alternatives represents the CASE label specifications and resulting values in
     the reverse order in which they appeared.
     If there is an ELSE expression, then use it. If there is no
     ELSE expression, make the last alternative (which is the first in the list)
     into the ELSE expression. This is safe because, if the CASE is complete
     (as required), then the last condition need not be checked anyway. */
  if (else_expr != NULL_TREE)
    expr = else_expr;
  else
    {
      expr = TREE_VALUE (alternatives);
      alternatives = TREE_CHAIN (alternatives);
    }

  for ( ; alternatives != NULL_TREE; alternatives = TREE_CHAIN (alternatives))
    { 
      tree value  = TREE_VALUE (alternatives);
      tree labels = TREE_PURPOSE (alternatives);
      tree cond   = build_multi_case_selector_expression(selector_list, labels);
      expr = build_nt (COND_EXPR, cond, value, expr);
    }

  return expr;
}


/* This is called with the assumption that RHS has been stabilized.  
   It has one purpose:  to iterate through the CHILL list of LHS's */
void
expand_assignment_action (loclist, modifycode, rhs)
     tree loclist;
     enum chill_tree_code modifycode;
     tree rhs;
{
  if (loclist == NULL_TREE || TREE_CODE (loclist) == ERROR_MARK
      || rhs == NULL_TREE  || TREE_CODE (rhs) == ERROR_MARK)
    return;

  if (TREE_CHAIN (loclist) != NULL_TREE)
    { /* Multiple assignment */
      tree target;
      if (TREE_TYPE (rhs) != NULL_TREE)
	rhs = save_expr (rhs);
      else if (TREE_CODE (rhs) == CONSTRUCTOR)
	error ("type of tuple cannot be implicit in multiple assignent");
      else if (TREE_CODE (rhs) == CASE_EXPR || TREE_CODE (rhs) == COND_EXPR)
	error ("conditional expression cannot be used in multiple assignent");
      else
	error ("internal error - unknown type in multiple assignment");

      if (modifycode != NOP_EXPR)
	{
	  error ("no operator allowed in multiple assignment,");
	  modifycode = NOP_EXPR;
	}

      for (target = TREE_CHAIN (loclist); target; target = TREE_CHAIN (target))
	{
	  if (!CH_EQUIVALENT (TREE_TYPE (TREE_VALUE (target)),
			      TREE_TYPE (TREE_VALUE (loclist))))
	    {
	      error
		("location modes in multiple assignment are not equivalent");
	      break;
	    }
	}
    }
  for ( ; loclist != NULL_TREE; loclist = TREE_CHAIN (loclist))
    chill_expand_assignment (TREE_VALUE (loclist), modifycode, rhs);
}

void
chill_expand_assignment (lhs, modifycode, rhs)
     tree lhs;
     enum chill_tree_code modifycode;
     tree rhs;
{
  tree loc;

  while (TREE_CODE (lhs) == COMPOUND_EXPR)
    {
      expand_expr (TREE_OPERAND (lhs, 0), const0_rtx, VOIDmode, 0);
      emit_queue ();
      lhs = TREE_OPERAND (lhs, 1);
    }

  if (TREE_CODE (lhs) == ERROR_MARK)
    return;

  /* errors for assignment to BUFFER, EVENT locations.
     what about SIGNALs? FIXME: Need similar test in
     build_chill_function_call. */
  if (TREE_CODE (lhs) == IDENTIFIER_NODE)
    {
      tree decl = lookup_name (lhs);
      if (decl)
	{
	  tree type = TREE_TYPE (decl);
	  if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
	    {
	      error ("You may not assign a value to a BUFFER or EVENT location");
	      return;
	    }
	}
    }

  if (TYPE_READONLY_PROPERTY (TREE_TYPE (lhs)) || TREE_READONLY (lhs))
    {
      error ("can't assign value to READonly location");
      return;
    }
  if (CH_TYPE_NONVALUE_P (TREE_TYPE (lhs)))
    {
      error ("cannot assign to location with non-value property");
      return;
    }

  if (TREE_CODE (TREE_TYPE (lhs)) == REFERENCE_TYPE)
    lhs = convert_from_reference (lhs);

  /* check for lhs is a location */
  loc = lhs;
  while (1)
    {
      if (TREE_CODE (loc) == SLICE_EXPR)
	loc = TREE_OPERAND (loc, 0);
      else if (TREE_CODE (loc) == SET_IN_EXPR)
	loc = TREE_OPERAND (loc, 1);
      else
	break;
    }
  if (! CH_LOCATION_P (loc))
    {
      error ("lefthand side of assignment is not a location");
      return;
    }

  /* If a binary op has been requested, combine the old LHS value with
     the RHS producing the value we should actually store into the LHS. */

  if (modifycode != NOP_EXPR)
    {
      lhs = stabilize_reference (lhs);
      /* This is to handle border-line cases such
	 as: LHS OR := [I].  This seems to be permitted
	 by the letter of Z.200, though it violates
	 its spirit, since LHS:=LHS OR [I] is
	 *not* legal. */
      if (TREE_TYPE (rhs) == NULL_TREE)
	rhs = convert (TREE_TYPE (lhs), rhs);
      rhs = build_chill_binary_op (modifycode, lhs, rhs);
    }

  rhs = chill_convert_for_assignment (TREE_TYPE (lhs), rhs, "assignment");

  /* handle the LENGTH (vary_array) := expr action */
  loc = lhs;
  if (TREE_CODE (loc) == NOP_EXPR)
    loc = TREE_OPERAND (loc, 0);
  if (TREE_CODE (loc) == COMPONENT_REF
      && chill_varying_type_p (TREE_TYPE (TREE_OPERAND (loc, 0)))
      && DECL_NAME (TREE_OPERAND (loc, 1)) == var_length_id)
    {
      expand_varying_length_assignment (TREE_OPERAND (loc, 0), rhs);
    }
  else if (TREE_CODE (lhs) == SLICE_EXPR)
    {
      tree func = lookup_name (get_identifier ("__pscpy"));
      tree dst = TREE_OPERAND (lhs, 0);
      tree dst_offset = TREE_OPERAND (lhs, 1);
      tree length = TREE_OPERAND (lhs, 2);
      tree src, src_offset;
      if (TREE_CODE (rhs) == SLICE_EXPR)
	{
	  src = TREE_OPERAND (rhs, 0);
	  /* Should check that the TREE_OPERAND (src, 0) is
	     the same as length and powerserlen (src).  FIXME */
	  src_offset = TREE_OPERAND (rhs, 1);
	}
      else
	{
	  src = rhs;
	  src_offset = integer_zero_node;
	}
      expand_expr_stmt (build_chill_function_call (func,
	tree_cons (NULL_TREE, force_addr_of (dst),
	  tree_cons (NULL_TREE, powersetlen (dst),
	    tree_cons (NULL_TREE, convert (long_unsigned_type_node, dst_offset),
	      tree_cons (NULL_TREE, force_addr_of (src),
		tree_cons (NULL_TREE, powersetlen (src),
		  tree_cons (NULL_TREE, convert (long_unsigned_type_node, src_offset),
		    tree_cons (NULL_TREE, convert (long_unsigned_type_node, length),
		       NULL_TREE)))))))));
    }

  else if (TREE_CODE (lhs) == SET_IN_EXPR)
    {
      tree from_pos = save_expr (TREE_OPERAND (lhs, 0));
      tree set = TREE_OPERAND (lhs, 1);
      tree domain = TYPE_DOMAIN (TREE_TYPE (set));
      tree set_length = size_binop (PLUS_EXPR,
				    size_binop (MINUS_EXPR,
						TYPE_MAX_VALUE (domain),
						TYPE_MIN_VALUE (domain)),
				    integer_one_node);
      tree filename = force_addr_of (get_chill_filename());
      
      if (TREE_CODE (TREE_TYPE (lhs)) != BOOLEAN_TYPE)
	sorry("bitstring slice");
      expand_expr_stmt (
	build_chill_function_call (lookup_name (
	  get_identifier ("__setbitpowerset")),
	      tree_cons (NULL_TREE, build_chill_addr_expr (set, "powerset"),
		  tree_cons (NULL_TREE, set_length,
		    tree_cons (NULL_TREE, TYPE_MIN_VALUE (domain),
		      tree_cons (NULL_TREE, convert (long_integer_type_node, from_pos),
			tree_cons (NULL_TREE, rhs,
			  tree_cons (NULL_TREE, filename,
			    tree_cons (NULL_TREE, get_chill_linenumber(),
  			      NULL_TREE)))))))));
    }

  /* Handle arrays of packed bitfields. Currently, this is limited to bitfields
     which are 1 bit wide, so use the powerset runtime function. */
  else if (TREE_CODE (lhs) == PACKED_ARRAY_REF)
    {
      tree from_pos = save_expr (TREE_OPERAND (lhs, 1));
      tree array = TREE_OPERAND (lhs, 0);
      tree domain = TYPE_DOMAIN (TREE_TYPE (array));
      tree array_length = powersetlen (array);
      tree filename = force_addr_of (get_chill_filename());
      expand_expr_stmt (
	build_chill_function_call (lookup_name (
	  get_identifier ("__setbitpowerset")),
            tree_cons (NULL_TREE, build_chill_addr_expr (array, "packed bitfield array"),
		tree_cons (NULL_TREE, convert (long_unsigned_type_node, array_length),
		  tree_cons (NULL_TREE, convert (long_integer_type_node,
						 TYPE_MIN_VALUE (domain)),
		    tree_cons (NULL_TREE, convert (long_integer_type_node, from_pos),
		      tree_cons (NULL_TREE, build1 (CONVERT_EXPR, boolean_type_node, rhs),
			tree_cons (NULL_TREE, filename,
			  tree_cons (NULL_TREE, get_chill_linenumber(),
  			    NULL_TREE)))))))));
    }

  /* The following is probably superceded by the
     above code for SET_IN_EXPR. FIXME! */
  else if (TREE_CODE (lhs) == BIT_FIELD_REF)
    {
      tree set = TREE_OPERAND (lhs, 0);
      tree numbits = TREE_OPERAND (lhs, 1);
      tree from_pos = save_expr (TREE_OPERAND (lhs, 2));
      tree domain = TYPE_DOMAIN (TREE_TYPE (set));
      tree set_length = size_binop (PLUS_EXPR,
				    size_binop (MINUS_EXPR,
						TYPE_MAX_VALUE (domain),
						TYPE_MIN_VALUE (domain)),
				    integer_one_node);
      tree filename = force_addr_of (get_chill_filename());
      tree to_pos;
      switch (TREE_CODE (TREE_TYPE (rhs)))
	{
	case SET_TYPE:
	  to_pos = size_binop (MINUS_EXPR,
			       size_binop (PLUS_EXPR, from_pos, numbits),
			       integer_one_node);
	  break;
	case BOOLEAN_TYPE:
	  to_pos = from_pos;
	  break;
	default:
	  abort ();
	}
      
      if (TREE_CODE (TREE_TYPE (lhs)) != BOOLEAN_TYPE)
	sorry("bitstring slice");
      expand_expr_stmt (
	  build_chill_function_call( lookup_name (
	      get_identifier ("__setbitpowerset")),
		tree_cons (NULL_TREE, build_chill_addr_expr (set, "powerset"),
		  tree_cons (NULL_TREE, set_length,
		    tree_cons (NULL_TREE, TYPE_MIN_VALUE (domain),
		      tree_cons (NULL_TREE, from_pos,
			tree_cons (NULL_TREE, rhs,
			  tree_cons (NULL_TREE, filename,
			    tree_cons (NULL_TREE, get_chill_linenumber(),
	  		      NULL_TREE)))))))));
    }

  else
    expand_expr_stmt (build_chill_modify_expr (lhs, rhs));
}

/* Also assumes that rhs has been stabilized */
void
expand_varying_length_assignment (lhs, rhs)
     tree lhs, rhs;
{
  tree base_array, min_domain_val;

  pedwarn ("LENGTH on left-hand-side is non-portable");
      
  if (! CH_LOCATION_P (lhs))
    {
      error ("Can only set LENGTH of array location");
      return;
    }

  /* cause a RANGE exception if rhs would cause a 'hole' in the array. */
  rhs = valid_array_index_p (lhs, rhs, "new array length too large", 1);

  base_array     = CH_VARYING_ARRAY_TYPE (TREE_TYPE (lhs));
  min_domain_val = TYPE_MIN_VALUE (TYPE_DOMAIN (base_array));

  lhs = build_component_ref (lhs, var_length_id);
  rhs = size_binop (MINUS_EXPR, rhs, min_domain_val);

  expand_expr_stmt (build_chill_modify_expr (lhs, rhs));
}

void
push_action ()
{
  push_handler ();
  if (ignoring)
    return;
  emit_line_note (input_filename, lineno);
}