grant.c

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

	      if (mode_string->len)
		APPEND (result, mode_string->str);
	      FREE (mode_string);
	    }
	  else
	    {
	      mode_string = get_type_selective (TREE_TYPE (type), all_decls);
	      if (mode_string->len)
		APPEND (result, mode_string->str);
	      FREE (mode_string);
	    }
	}
      break;

    case REAL_TYPE:
      return result;
      break;

    case SET_TYPE:
      if (CH_BOOLS_TYPE_P (type))
	mode_string = grant_array_type_selective (type, all_decls);
      else
	mode_string = get_type_selective (TYPE_DOMAIN (type), all_decls);
      if (mode_string->len)
	APPEND (result, mode_string->str);
      FREE (mode_string);
      break;
	
    case REFERENCE_TYPE:
      mode_string = get_type_selective (TREE_TYPE (type), all_decls);
      if (mode_string->len)
	APPEND (result, mode_string->str);
      FREE (mode_string);
      break;
      
    default:
      APPEND (result, "/* ---- not implemented ---- */");
      break;
    }

  return (result);
}

static MYSTRING *
get_type (type)
    tree	type;
{
  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
    return newstring ("");

  return (decode_mode (type));
}

static MYSTRING *
get_type_selective (type, all_decls)
    tree	type;
    tree        all_decls;
{
  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
    return newstring ("");

  return (decode_mode_selective (type, all_decls));
}

#if 0
static int
is_forbidden (str, forbid)
    tree	str;
    tree	forbid;
{
  if (forbid == NULL_TREE)
    return (0);
  
  if (TREE_CODE (forbid) == INTEGER_CST)
    return (1);
  
  while (forbid != NULL_TREE)
    {
      if (TREE_VALUE (forbid) == str)
	return (1);
      forbid = TREE_CHAIN (forbid);
    }
  /* nothing found */
  return (0);
}
#endif

static MYSTRING *
decode_constant (init)
     tree	init;
{
  MYSTRING *result = newstring ("");
  MYSTRING *tmp_string;
  tree	    type = TREE_TYPE (init);
  tree	val = init;
  char *op;
  char	wrk[256];
  MYSTRING *mode_string;
    
  switch ((enum chill_tree_code)TREE_CODE (val))
    {
    case CALL_EXPR:
      tmp_string = decode_constant (TREE_OPERAND (val, 0));
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      val = TREE_OPERAND (val, 1);  /* argument list */
      if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
	{
	  APPEND (result, " ");
	  tmp_string = decode_constant (val);
	  APPEND (result, tmp_string->str);
	  FREE (tmp_string);
	}
      else
	{
	  APPEND (result, " (");
	  if (val != NULL_TREE)
	    {
	      for (;;)
		{
		  tmp_string = decode_constant (TREE_VALUE (val));
		  APPEND (result, tmp_string->str);
		  FREE (tmp_string);
		  val = TREE_CHAIN (val);
		  if (val == NULL_TREE)
		    break;
		  APPEND (result, ", ");
		}
	    }
	  APPEND (result, ")");
	}
      return result;

    case NOP_EXPR:
      /* Generate an "expression conversion" expression (a cast). */
      tmp_string = decode_mode (type);

      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      APPEND (result, "(");
      val = TREE_OPERAND (val, 0);
      type = TREE_TYPE (val);

      /* If the coercee is a tuple, make sure it is prefixed by its mode. */
      if (TREE_CODE (val) == CONSTRUCTOR
	&& !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
	{
	  tmp_string = decode_mode (type);
	  APPEND (result, tmp_string->str);
	  FREE (tmp_string);
	  APPEND (result, " ");
	}

      tmp_string = decode_constant (val);
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      APPEND (result, ")");
      return result;

    case IDENTIFIER_NODE:
      APPEND (result, IDENTIFIER_POINTER (val));
      return result;

    case PAREN_EXPR:
      APPEND (result, "(");
      tmp_string = decode_constant (TREE_OPERAND (val, 0));
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      APPEND (result, ")");
      return result;

    case UNDEFINED_EXPR:
      APPEND (result, "*");
      return result;

    case PLUS_EXPR:        op = "+";       goto binary;
    case MINUS_EXPR:       op = "-";       goto binary;
    case MULT_EXPR:        op = "*";       goto binary;
    case TRUNC_DIV_EXPR:   op = "/";       goto binary;
    case FLOOR_MOD_EXPR:   op = " MOD ";   goto binary;
    case TRUNC_MOD_EXPR:   op = " REM ";   goto binary;
    case CONCAT_EXPR:      op = "//";      goto binary;
    case BIT_IOR_EXPR:     op = " OR ";    goto binary;
    case BIT_XOR_EXPR:     op = " XOR ";   goto binary;
    case TRUTH_ORIF_EXPR:  op = " ORIF ";  goto binary;
    case BIT_AND_EXPR:     op = " AND ";   goto binary;
    case TRUTH_ANDIF_EXPR: op = " ANDIF "; goto binary;
    case GT_EXPR:          op = ">";       goto binary;
    case GE_EXPR:          op = ">=";      goto binary;
    case SET_IN_EXPR:      op = " IN ";    goto binary;
    case LT_EXPR:          op = "<";       goto binary;
    case LE_EXPR:          op = "<=";      goto binary;
    case EQ_EXPR:          op = "=";       goto binary;
    case NE_EXPR:          op = "/=";      goto binary;
    case RANGE_EXPR:
      if (TREE_OPERAND (val, 0) == NULL_TREE)
	{
	  APPEND (result, TREE_OPERAND (val, 1) == NULL_TREE ? "*" : "ELSE");
	  return result;
	}
      op = ":";       goto binary;
    binary:
      tmp_string = decode_constant (TREE_OPERAND (val, 0));
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      APPEND (result, op);
      tmp_string = decode_constant (TREE_OPERAND (val, 1));
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      return result;

    case REPLICATE_EXPR:
      APPEND (result, "(");
      tmp_string = decode_constant (TREE_OPERAND (val, 0));
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      APPEND (result, ")");
      tmp_string = decode_constant (TREE_OPERAND (val, 1));
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      return result;

    case NEGATE_EXPR:     op = "-";     goto unary;
    case BIT_NOT_EXPR:    op = " NOT "; goto unary;
    case ADDR_EXPR:       op = "->"; goto unary;
    unary:
      APPEND (result, op);
      tmp_string = decode_constant (TREE_OPERAND (val, 0));
      APPEND (result, tmp_string->str);
      FREE (tmp_string);
      return result;

    case INTEGER_CST:
      APPEND (result, display_int_cst (val));
      return result;

    case REAL_CST:
#ifndef REAL_IS_NOT_DOUBLE
      sprintf (wrk, "%.20g", TREE_REAL_CST (val));
#else
      REAL_VALUE_TO_DECIMAL (TREE_REAL_CST (val), "%.20g", wrk);
#endif
      APPEND (result, wrk);
      return result;

    case STRING_CST:
      {
	char *ptr = TREE_STRING_POINTER (val);
	int i = TREE_STRING_LENGTH (val);
	APPEND (result, "\"");
	while (--i >= 0)
	  {
	    char buf[10];
	    unsigned char c = *ptr++;
	    if (c == '^')
	      APPEND (result, "^^");
	    else if (c == '"')
	      APPEND (result, "\"\"");
	    else if (c == '\n')
	      APPEND (result, "^J");
	    else if (c < ' ' || c > '~')
	      {
		sprintf (buf, "^(%u)", c);
		APPEND (result, buf);
	      }
	    else
	      {
		buf[0] = c;
		buf[1] = 0;
		APPEND (result, buf);
	      }
	  }
	APPEND (result, "\"");
	return result;
      }

    case CONSTRUCTOR:
      val = TREE_OPERAND (val, 1);
      if (type != NULL && TREE_CODE (type) == SET_TYPE
	  && CH_BOOLS_TYPE_P (type))
	{
	  /* It's a bitstring. */
	  tree domain = TYPE_DOMAIN (type);
	  tree domain_max = TYPE_MAX_VALUE (domain);
	  char *buf;
	  register char *ptr;
	  int len;
	  if (TREE_CODE (domain_max) != INTEGER_CST
	      || (val && TREE_CODE (val) != TREE_LIST))
	    goto fail;

	  len = TREE_INT_CST_LOW (domain_max) + 1;
	  if (TREE_CODE (init) != CONSTRUCTOR)
	    goto fail;
	  buf = (char *) alloca (len + 10);
	  ptr = buf;
	  *ptr++ = ' ';	  
	  *ptr++ = 'B';
	  *ptr++ = '\'';
	  if (get_set_constructor_bits (init, ptr, len))
	    goto fail;
	  for (; --len >= 0; ptr++)
	    *ptr += '0';
	  *ptr++ = '\'';
	  *ptr = '\0';
	  APPEND (result, buf);
	  return result;
	}
      else
	{ /* It's some kind of tuple */
	  if (type != NULL_TREE)
	    {
	      mode_string = get_type (type);
	      APPEND (result, mode_string->str);
	      FREE (mode_string);
	      APPEND (result, " ");
	    }
	  if (val == NULL_TREE
	      || TREE_CODE (val) == ERROR_MARK)
	    APPEND (result, "[ ]");
	  else if (TREE_CODE (val) != TREE_LIST)
	    goto fail;
	  else
	    {
	      APPEND (result, "[");
	      for ( ; ; )
		{
		  tree lo_val = TREE_PURPOSE (val);
		  tree hi_val = TREE_VALUE (val);
		  MYSTRING *val_string;
		  if (TUPLE_NAMED_FIELD (val))
		    APPEND(result, ".");
		  if (lo_val != NULL_TREE)
		    {
		      val_string = decode_constant (lo_val);
		      APPEND (result, val_string->str);
		      FREE (val_string);
		      APPEND (result, ":");
		    }
		  val_string = decode_constant (hi_val);
		  APPEND (result, val_string->str);
		  FREE (val_string);
		  val = TREE_CHAIN (val);
		  if (val == NULL_TREE)
		    break;
		  APPEND (result, ", ");
		}
	      APPEND (result, "]");
	    }
	}
      return result;
    case COMPONENT_REF:
      {
	tree op1;

	mode_string = decode_constant (TREE_OPERAND (init, 0));
	APPEND (result, mode_string->str);
	FREE (mode_string);
	op1 = TREE_OPERAND (init, 1);
	if (TREE_CODE (op1) != IDENTIFIER_NODE)
	  {
	    error ("decode_constant: invalid component_ref");
	    break;
	  }
	APPEND (result, ".");
	APPEND (result, IDENTIFIER_POINTER (op1));
	return result;
      }
    fail:
      error ("decode_constant: mode and value mismatch");
      break;
    default:
      error ("decode_constant: cannot decode this mode");
      break;
    }
  return result;
}

static MYSTRING *
decode_constant_selective (init, all_decls)
     tree	init;
     tree       all_decls;
{
  MYSTRING *result = newstring ("");
  MYSTRING *tmp_string;
  tree	    type = TREE_TYPE (init);
  tree	val = init;
  MYSTRING *mode_string;
    
  switch ((enum chill_tree_code)TREE_CODE (val))
    {
    case CALL_EXPR:
      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      val = TREE_OPERAND (val, 1);  /* argument list */
      if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
	{
	  tmp_string = decode_constant_selective (val, all_decls);
	  if (tmp_string->len)
	    {
	      MAYBE_NEWLINE (result);
	      APPEND (result, tmp_string->str);
	    }
	  FREE (tmp_string);
	}
      else
	{
	  if (val != NULL_TREE)
	    {
	      for (;;)
		{
		  tmp_string = decode_constant_selective (TREE_VALUE (val), all_decls);
		  if (tmp_string->len)
		    {
		      MAYBE_NEWLINE (result);
		      APPEND (result, tmp_string->str);
		    }
		  FREE (tmp_string);
		  val = TREE_CHAIN (val);
		  if (val == NULL_TREE)
		    break;
		}
	    }
	}
      return result;

    case NOP_EXPR:
      /* Generate an "expression conversion" expression (a cast). */
      tmp_string = decode_mode_selective (type, all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      val = TREE_OPERAND (val, 0);
      type = TREE_TYPE (val);

      /* If the coercee is a tuple, make sure it is prefixed by its mode. */
      if (TREE_CODE (val) == CONSTRUCTOR
	&& !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
	{
	  tmp_string = decode_mode_selective (type, all_decls);
	  if (tmp_string->len)
	    APPEND (result, tmp_string->str);
	  FREE (tmp_string);
	}

      tmp_string = decode_constant_selective (val, all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      return result;

    case IDENTIFIER_NODE:
      tmp_string = decode_mode_selective (val, all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      return result;

    case PAREN_EXPR:
      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      return result;

    case UNDEFINED_EXPR:
      return result;

    case PLUS_EXPR:
    case MINUS_EXPR:
    case MULT_EXPR:
    case TRUNC_DIV_EXPR:
    case FLOOR_MOD_EXPR:
    case TRUNC_MOD_EXPR:
    case CONCAT_EXPR:
    case BIT_IOR_EXPR:
    case BIT_XOR_EXPR:
    case TRUTH_ORIF_EXPR:
    case BIT_AND_EXPR:
    case TRUTH_ANDIF_EXPR:
    case GT_EXPR:
    case GE_EXPR:
    case SET_IN_EXPR:
    case LT_EXPR:
    case LE_EXPR:
    case EQ_EXPR:
    case NE_EXPR:
      goto binary;
    case RANGE_EXPR:
      if (TREE_OPERAND (val, 0) == NULL_TREE)
	  return result;

    binary:
      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
      if (tmp_string->len)
	{
	  MAYBE_NEWLINE (result);
	  APPEND (result, tmp_string->str);
	}
      FREE (tmp_string);
      return result;

    case REPLICATE_EXPR:
      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
      if (tmp_string->len)
	{
	  MAYBE_NEWLINE (result);
	  APPEND (result, tmp_string->str);
	}
      FREE (tmp_string);
      return result;

    case NEGATE_EXPR:
    case BIT_NOT_EXPR:
    case ADDR_EXPR:
      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
      if (tmp_string->len)
	APPEND (result, tmp_string->str);
      FREE (tmp_string);
      return result;