tree.c

使用yacc和lex编写的cmm语言的词法分析和语法分析程序.

   of varargs, which is expensive for RISC machines.  */
tree
build1 (code, type, node)
     enum tree_code code;
     tree type;
     tree node;
{
  register struct obstack *obstack = current_obstack;
  register int i, length;
  register tree_node_kind kind;
  register tree t;

#ifdef GATHER_STATISTICS
  if (TREE_CODE_CLASS (code) == 'r')
    kind = r_kind;
  else
    kind = e_kind;
#endif

  obstack = expression_obstack;
  length = sizeof (struct tree_exp);

  t = (tree) obstack_alloc (obstack, length);

#ifdef GATHER_STATISTICS
  tree_node_counts[(int)kind]++;
  tree_node_sizes[(int)kind] += length;
#endif

  TREE_TYPE (t) = type;
  TREE_CHAIN (t) = 0;

  for (i = (length / sizeof (int)) - 2;
       i >= sizeof (struct tree_common) / sizeof (int) - 1;
       i--)
    ((int *) t)[i] = 0;
  TREE_SET_CODE (t, code);

  if (obstack == &permanent_obstack)
    TREE_PERMANENT (t) = 1;

  TREE_OPERAND (t, 0) = node;
  if (node)
    {
      if (TREE_SIDE_EFFECTS (node))
	TREE_SIDE_EFFECTS (t) = 1;
      if (TREE_RAISES (node))
	TREE_RAISES (t) = 1;
    }

  return t;
}

/* Similar except don't specify the TREE_TYPE
   and leave the TREE_SIDE_EFFECTS as 0.
   It is permissible for arguments to be null,
   or even garbage if their values do not matter.  */

tree
build_nt (va_alist)
     va_dcl
{
  va_list p;
  register enum tree_code code;
  register tree t;
  register int length;
  register int i;

  va_start (p);

  code = va_arg (p, enum tree_code);
  t = make_node (code);
  length = tree_code_length[(int) code];

  for (i = 0; i < length; i++)
    TREE_OPERAND (t, i) = va_arg (p, tree);

  va_end (p);
  return t;
}

/* Similar to `build_nt', except we build
   on the temp_decl_obstack, regardless.  */

tree
build_parse_node (va_alist)
     va_dcl
{
  register struct obstack *ambient_obstack = expression_obstack;
  va_list p;
  register enum tree_code code;
  register tree t;
  register int length;
  register int i;

  expression_obstack = &temp_decl_obstack;

  va_start (p);

  code = va_arg (p, enum tree_code);
  t = make_node (code);
  length = tree_code_length[(int) code];

  for (i = 0; i < length; i++)
    TREE_OPERAND (t, i) = va_arg (p, tree);

  va_end (p);
  expression_obstack = ambient_obstack;
  return t;
}

#if 0
/* Commented out because this wants to be done very
   differently.  See cp-lex.c.  */
tree
build_op_identifier (op1, op2)
     tree op1, op2;
{
  register tree t = make_node (OP_IDENTIFIER);
  TREE_PURPOSE (t) = op1;
  TREE_VALUE (t) = op2;
  return t;
}
#endif

/* Create a DECL_... node of code CODE, name NAME and data type TYPE.
   We do NOT enter this node in any sort of symbol table.

   layout_decl is used to set up the decl's storage layout.
   Other slots are initialized to 0 or null pointers.  */

tree
build_decl (code, name, type)
     enum tree_code code;
     tree name, type;
{
  register tree t;

  t = make_node (code);

/*  if (type == error_mark_node)
    type = integer_type_node; */
/* That is not done, deliberately, so that having error_mark_node
   as the type can suppress useless errors in the use of this variable.  */

  DECL_NAME (t) = name;
  DECL_ASSEMBLER_NAME (t) = name;
  TREE_TYPE (t) = type;

  if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
    layout_decl (t, 0);
  else if (code == FUNCTION_DECL)
    DECL_MODE (t) = FUNCTION_MODE;

  return t;
}

/* BLOCK nodes are used to represent the structure of binding contours
   and declarations, once those contours have been exited and their contents
   compiled.  This information is used for outputting debugging info.
   A BLOCK may have a "controller" which is a BIND_EXPR node.
   Then the BLOCK is ignored unless the controller has the TREE_USED flag.  */

tree
build_block (vars, tags, subblocks, supercontext, chain)
     tree vars, tags, subblocks, supercontext, chain;
{
  register tree block = make_node (BLOCK);
  BLOCK_VARS (block) = vars;
  BLOCK_TYPE_TAGS (block) = tags;
  BLOCK_SUBBLOCKS (block) = subblocks;
  BLOCK_SUPERCONTEXT (block) = supercontext;
  BLOCK_CHAIN (block) = chain;
  return block;
}

/* Return a type like TYPE except that its TYPE_READONLY is CONSTP
   and its TYPE_VOLATILE is VOLATILEP.

   Such variant types already made are recorded so that duplicates
   are not made.

   A variant types should never be used as the type of an expression.
   Always copy the variant information into the TREE_READONLY
   and TREE_THIS_VOLATILE of the expression, and then give the expression
   as its type the "main variant", the variant whose TYPE_READONLY
   and TYPE_VOLATILE are zero.  Use TYPE_MAIN_VARIANT to find the
   main variant.  */

tree
build_type_variant (type, constp, volatilep)
     tree type;
     int constp, volatilep;
{
  register tree t, m = TYPE_MAIN_VARIANT (type);
  register struct obstack *ambient_obstack = current_obstack;

  /* Treat any nonzero argument as 1.  */
  constp = !!constp;
  volatilep = !!volatilep;

  /* If not generating auxilliary info, search the chain of variants to see
     if there is already one there just like the one we need to have.  If so,
     use that existing one.

     We don't do this in the case where we are generating aux info because
     in that case we want each typedef names to get it's own distinct type
     node, even if the type of this new typedef is the same as some other
     (existing) type.  */

  if (!flag_gen_aux_info)
    for (t = m; t; t = TYPE_NEXT_VARIANT (t))
      if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t))
        return t;

  /* We need a new one.  */
  current_obstack
    = TREE_PERMANENT (type) ? &permanent_obstack : saveable_obstack;

  t = copy_node (type);
  TYPE_READONLY (t) = constp;
  TYPE_VOLATILE (t) = volatilep;
  TYPE_POINTER_TO (t) = 0;
  TYPE_REFERENCE_TO (t) = 0;

  /* Add this type to the chain of variants of TYPE.  */
  TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
  TYPE_NEXT_VARIANT (m) = t;

  current_obstack = ambient_obstack;
  return t;
}

/* Hashing of types so that we don't make duplicates.
   The entry point is `type_hash_canon'.  */

/* Each hash table slot is a bucket containing a chain
   of these structures.  */

struct type_hash
{
  struct type_hash *next;	/* Next structure in the bucket.  */
  int hashcode;			/* Hash code of this type.  */
  tree type;			/* The type recorded here.  */
};

/* Now here is the hash table.  When recording a type, it is added
   to the slot whose index is the hash code mod the table size.
   Note that the hash table is used for several kinds of types
   (function types, array types and array index range types, for now).
   While all these live in the same table, they are completely independent,
   and the hash code is computed differently for each of these.  */

#define TYPE_HASH_SIZE 59
struct type_hash *type_hash_table[TYPE_HASH_SIZE];

/* Here is how primitive or already-canonicalized types' hash
   codes are made.  */
#define TYPE_HASH(TYPE) ((int) (TYPE) & 0777777)

/* Compute a hash code for a list of types (chain of TREE_LIST nodes
   with types in the TREE_VALUE slots), by adding the hash codes
   of the individual types.  */

int
type_hash_list (list)
     tree list;
{
  register int hashcode;
  register tree tail;
  for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
    hashcode += TYPE_HASH (TREE_VALUE (tail));
  return hashcode;
}

/* Look in the type hash table for a type isomorphic to TYPE.
   If one is found, return it.  Otherwise return 0.  */

tree
type_hash_lookup (hashcode, type)
     int hashcode;
     tree type;
{
  register struct type_hash *h;
  for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
    if (h->hashcode == hashcode
	&& TREE_CODE (h->type) == TREE_CODE (type)
	&& TREE_TYPE (h->type) == TREE_TYPE (type)
	&& (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
	    || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
				   TYPE_MAX_VALUE (type)))
	&& (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
	    || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
				   TYPE_MIN_VALUE (type)))
	&& (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
	    || (TYPE_DOMAIN (h->type)
		&& TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
		&& TYPE_DOMAIN (type)
		&& TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
		&& type_list_equal (TYPE_DOMAIN (h->type), TYPE_DOMAIN (type)))))
      return h->type;
  return 0;
}

/* Add an entry to the type-hash-table
   for a type TYPE whose hash code is HASHCODE.  */

void
type_hash_add (hashcode, type)
     int hashcode;
     tree type;
{
  register struct type_hash *h;

  h = (struct type_hash *) oballoc (sizeof (struct type_hash));
  h->hashcode = hashcode;
  h->type = type;
  h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
  type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
}

/* Given TYPE, and HASHCODE its hash code, return the canonical
   object for an identical type if one already exists.
   Otherwise, return TYPE, and record it as the canonical object
   if it is a permanent object.

   To use this function, first create a type of the sort you want.
   Then compute its hash code from the fields of the type that
   make it different from other similar types.
   Then call this function and use the value.
   This function frees the type you pass in if it is a duplicate.  */

/* Set to 1 to debug without canonicalization.  Never set by program.  */
int debug_no_type_hash = 0;

tree
type_hash_canon (hashcode, type)
     int hashcode;
     tree type;
{
  tree t1;

  if (debug_no_type_hash)
    return type;

  t1 = type_hash_lookup (hashcode, type);
  if (t1 != 0)
    {
      struct obstack *o
	= TREE_PERMANENT (type) ? &permanent_obstack : saveable_obstack;
      obstack_free (o, type);
#ifdef GATHER_STATISTICS
      tree_node_counts[(int)t_kind]--;
      tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
#endif
      return t1;
    }

  /* If this is a new type, record it for later reuse.  */
  if (current_obstack == &permanent_obstack)
    type_hash_add (hashcode, type);

  return type;
}

/* Given two lists of types
   (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
   return 1 if the lists contain the same types in the same order.
   Also, the TREE_PURPOSEs must match.  */

int
type_list_equal (l1, l2)
     tree l1, l2;
{
  register tree t1, t2;
  for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
    {
      if (TREE_VALUE (t1) != TREE_VALUE (t2))
	return 0;
      if (TREE_PURPOSE (t1) != TREE_PURPOSE (t2))
	{
	  int cmp = simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2));
	  if (cmp < 0)
	    abort ();
	  if (cmp == 0)
	    return 0;
	}
    }

  return t1 == t2;
}

/* Nonzero if integer constants T1 and T2
   represent the same constant value.  */

int
tree_int_cst_equal (t1, t2)
     tree t1, t2;
{
  if (t1 == t2)
    return 1;
  if (t1 == 0 || t2 == 0)
    return 0;
  if (TREE_CODE (t1) == INTEGER_CST
      && TREE_CODE (t2) == INTEGER_CST
      && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
      && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
    return 1;
  return 0;
}

/* Nonzero if integer constants T1 and T2 represent values that satisfy <.
   The precise way of comparison depends on their data type.  */

int
tree_int_cst_lt (t1, t2)
     tree t1, t2;
{
  if (t1 == t2)
    return 0;

  if (!TREE_UNSIGNED (TREE_TYPE (t1)))
    return INT_CST_LT (t1, t2);
  return INT_CST_LT_UNSIGNED (t1, t2);
}

/* Compare two constructor-element-type constants.  */
int
simple_cst_list_equal (l1, l2)
     tree l1, l2;
{
  while (l1 != NULL_TREE && l2 != NULL_TREE)
    {
      int cmp = simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2));
      if (cmp < 0)
	abort ();
      if (cmp == 0)
	return 0;
      l1 = TREE_CHAIN (l1);
      l2 = TREE_CHAIN (l2);
    }
  return (l1 == l2);
}

/* Return truthvalue of whether T1 is the same tree structure as T2.
   Return 1 if they are the same.
   Return 0 if they are understandably different.
   Return -1 if either contains tree structure not understood by
   this function.  */

int
simple_cst_equal (t1, t2)
     tree t1, t2;
{
  register enum tree_code code1, code2;
  int cmp;

  if (t1 == t2)
    return 1;
  if (t1 == 0 || t2 == 0)
    return 0;

  code1 = TREE_CODE (t1);
  code2 = TREE_CODE (t2);

  if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
    if (code2 == NOP_EXPR || code2 == CONVERT_EXPR || code2 == NON_LVALUE_EXPR)
      return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
    else
      return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
  else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
	   || code2 == NON_LVALUE_EXPR)
    return simple_cst_equal (t1, TREE_OPERAND (t2, 0));

  if (code1 != code2)
    return 0;

  switch (code1)
    {
    case INTEGER_CST:
      return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
	&& TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);

    case REAL_CST:
      return REAL_VALUES_EQUAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));

    case STRING_CST: