tree.c

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

  /* Compute length of text in len.  */
  for (len = 0; text[len]; len++);

  /* Decide how much of that length to hash on */
  hash_len = len;
  if (warn_id_clash && len > id_clash_len)
    hash_len = id_clash_len;

  /* Compute hash code */
  hi = hash_len * 613 + (unsigned)text[0];
  for (i = 1; i < hash_len; i += 2)
    hi = ((hi * 613) + (unsigned)(text[i]));

  hi &= (1 << HASHBITS) - 1;
  hi %= MAX_HASH_TABLE;
  
  /* Search table for identifier */
  for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
    if (IDENTIFIER_LENGTH (idp) == len
	&& IDENTIFIER_POINTER (idp)[0] == text[0]
	&& !bcmp (IDENTIFIER_POINTER (idp), text, len))
      return idp;		/* <-- return if found */

  /* Not found; optionally warn about a similar identifier */
  if (warn_id_clash && do_identifier_warnings && len >= id_clash_len)
    for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
      if (!strncmp (IDENTIFIER_POINTER (idp), text, id_clash_len))
	{
	  warning ("`%s' and `%s' identical in first %d characters",
		   IDENTIFIER_POINTER (idp), text, id_clash_len);
	  break;
	}

  if (tree_code_length[(int) IDENTIFIER_NODE] < 0)
    abort ();			/* set_identifier_size hasn't been called.  */

  /* Not found, create one, add to chain */
  idp = make_node (IDENTIFIER_NODE);
  IDENTIFIER_LENGTH (idp) = len;
#ifdef GATHER_STATISTICS
  id_string_size += len;
#endif

  IDENTIFIER_POINTER (idp) = obstack_copy0 (&permanent_obstack, text, len);

  TREE_CHAIN (idp) = hash_table[hi];
  hash_table[hi] = idp;
  return idp;			/* <-- return if created */
}

/* Enable warnings on similar identifiers (if requested).
   Done after the built-in identifiers are created.  */

void
start_identifier_warnings ()
{
  do_identifier_warnings = 1;
}

/* Record the size of an identifier node for the language in use.
   SIZE is the total size in bytes.
   This is called by the language-specific files.  This must be
   called before allocating any identifiers.  */

void
set_identifier_size (size)
     int size;
{
  tree_code_length[(int) IDENTIFIER_NODE]
    = (size - sizeof (struct tree_common)) / sizeof (tree);
}

/* Return a newly constructed INTEGER_CST node whose constant value
   is specified by the two ints LOW and HI.
   The TREE_TYPE is set to `int'.  */

tree
build_int_2 (low, hi)
     int low, hi;
{
  register tree t = make_node (INTEGER_CST);
  TREE_INT_CST_LOW (t) = low;
  TREE_INT_CST_HIGH (t) = hi;
  TREE_TYPE (t) = integer_type_node;
  return t;
}

/* Return a new REAL_CST node whose type is TYPE and value is D.  */

tree
build_real (type, d)
     tree type;
     REAL_VALUE_TYPE d;
{
  tree v;

  /* Check for valid float value for this type on this target machine;
     if not, can print error message and store a valid value in D.  */
#ifdef CHECK_FLOAT_VALUE
  CHECK_FLOAT_VALUE (TYPE_MODE (type), d);
#endif

  v = make_node (REAL_CST);
  TREE_TYPE (v) = type;
  TREE_REAL_CST (v) = d;
  return v;
}

/* Return a new REAL_CST node whose type is TYPE
   and whose value is the integer value of the INTEGER_CST node I.  */

#if !defined (REAL_IS_NOT_DOUBLE) || defined (REAL_ARITHMETIC)

REAL_VALUE_TYPE
real_value_from_int_cst (i)
     tree i;
{
  REAL_VALUE_TYPE d;
#ifdef REAL_ARITHMETIC
  REAL_VALUE_FROM_INT (d, TREE_INT_CST_LOW (i), TREE_INT_CST_HIGH (i));
#else /* not REAL_ARITHMETIC */
  if (TREE_INT_CST_HIGH (i) < 0)
    {
      d = (double) (~ TREE_INT_CST_HIGH (i));
      d *= ((double) (1 << (HOST_BITS_PER_INT / 2))
	    * (double) (1 << (HOST_BITS_PER_INT / 2)));
      d += (double) (unsigned) (~ TREE_INT_CST_LOW (i));
      d = (- d - 1.0);
    }
  else
    {
      d = (double) TREE_INT_CST_HIGH (i);
      d *= ((double) (1 << (HOST_BITS_PER_INT / 2))
	    * (double) (1 << (HOST_BITS_PER_INT / 2)));
      d += (double) (unsigned) TREE_INT_CST_LOW (i);
    }
#endif /* not REAL_ARITHMETIC */
  return d;
}

/* This function can't be implemented if we can't do arithmetic
   on the float representation.  */

tree
build_real_from_int_cst (type, i)
     tree type;
     tree i;
{
  tree v;
  REAL_VALUE_TYPE d;

  v = make_node (REAL_CST);
  TREE_TYPE (v) = type;

  d = real_value_from_int_cst (i);
  /* Check for valid float value for this type on this target machine;
     if not, can print error message and store a valid value in D.  */
#ifdef CHECK_FLOAT_VALUE
  CHECK_FLOAT_VALUE (TYPE_MODE (type), d);
#endif

  TREE_REAL_CST (v) = d;
  return v;
}

#endif /* not REAL_IS_NOT_DOUBLE, or REAL_ARITHMETIC */

/* Return a newly constructed STRING_CST node whose value is
   the LEN characters at STR.
   The TREE_TYPE is not initialized.  */

tree
build_string (len, str)
     int len;
     char *str;
{
  register tree s = make_node (STRING_CST);
  TREE_STRING_LENGTH (s) = len;
  TREE_STRING_POINTER (s) = obstack_copy0 (saveable_obstack, str, len);
  return s;
}

/* Return a newly constructed COMPLEX_CST node whose value is
   specified by the real and imaginary parts REAL and IMAG.
   Both REAL and IMAG should be constant nodes.
   The TREE_TYPE is not initialized.  */

tree
build_complex (real, imag)
     tree real, imag;
{
  register tree t = make_node (COMPLEX_CST);
  TREE_REALPART (t) = real;
  TREE_IMAGPART (t) = imag;
  return t;
}

/* Build a newly constructed TREE_VEC node of length LEN.  */
tree
make_tree_vec (len)
     int len;
{
  register tree t;
  register int length = (len-1) * sizeof (tree) + sizeof (struct tree_vec);
  register struct obstack *obstack = current_obstack;
  register int i;

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

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

  TREE_TYPE (t) = 0;
  TREE_CHAIN (t) = 0;
  for (i = (length / sizeof (int)) - 1;
       i >= sizeof (struct tree_common) / sizeof (int) - 1;
       i--)
    ((int *) t)[i] = 0;
  TREE_SET_CODE (t, TREE_VEC);
  TREE_VEC_LENGTH (t) = len;
  if (obstack == &permanent_obstack)
    TREE_PERMANENT (t) = 1;

  return t;
}

/* Return 1 if EXPR is the integer constant zero.  */

int
integer_zerop (expr)
     tree expr;
{
  while (TREE_CODE (expr) == NON_LVALUE_EXPR)
    expr = TREE_OPERAND (expr, 0);

  return (TREE_CODE (expr) == INTEGER_CST
	  && TREE_INT_CST_LOW (expr) == 0
	  && TREE_INT_CST_HIGH (expr) == 0);
}

/* Return 1 if EXPR is the integer constant one.  */

int
integer_onep (expr)
     tree expr;
{
  while (TREE_CODE (expr) == NON_LVALUE_EXPR)
    expr = TREE_OPERAND (expr, 0);

  return (TREE_CODE (expr) == INTEGER_CST
	  && TREE_INT_CST_LOW (expr) == 1
	  && TREE_INT_CST_HIGH (expr) == 0);
}

/* Return 1 if EXPR is an integer containing all 1's
   in as much precision as it contains.  */

int
integer_all_onesp (expr)
     tree expr;
{
  register int prec;
  register int uns;

  while (TREE_CODE (expr) == NON_LVALUE_EXPR)
    expr = TREE_OPERAND (expr, 0);

  if (TREE_CODE (expr) != INTEGER_CST)
    return 0;

  uns = TREE_UNSIGNED (TREE_TYPE (expr));
  if (!uns)
    return TREE_INT_CST_LOW (expr) == -1 && TREE_INT_CST_HIGH (expr) == -1;

  prec = TYPE_PRECISION (TREE_TYPE (expr));
  if (prec >= HOST_BITS_PER_INT)
    {
      int high_value, shift_amount;

      shift_amount = prec - HOST_BITS_PER_INT;

      if (shift_amount > HOST_BITS_PER_INT)
	/* Can not handle precisions greater than twice the host int size.  */
	abort ();
      else if (shift_amount == HOST_BITS_PER_INT)
	/* Shifting by the host word size is undefined according to the ANSI
	   standard, so we must handle this as a special case.  */
	high_value = -1;
      else
	high_value = (1 << shift_amount) - 1;

      return TREE_INT_CST_LOW (expr) == -1
	&& TREE_INT_CST_HIGH (expr) == high_value;
    }
  else
    return TREE_INT_CST_LOW (expr) == (1 << prec) - 1;
}

/* Return 1 if EXPR is an integer constant that is a power of 2 (i.e., has only
   one bit on).  */

int
integer_pow2p (expr)
     tree expr;
{
  int high, low;

  while (TREE_CODE (expr) == NON_LVALUE_EXPR)
    expr = TREE_OPERAND (expr, 0);

  if (TREE_CODE (expr) != INTEGER_CST)
    return 0;

  high = TREE_INT_CST_HIGH (expr);
  low = TREE_INT_CST_LOW (expr);

  if (high == 0 && low == 0)
    return 0;

  return ((high == 0 && (low & (low - 1)) == 0)
	  || (low == 0 && (high & (high - 1)) == 0));
}

/* Return 1 if EXPR is the real constant zero.  */

int
real_zerop (expr)
     tree expr;
{
  while (TREE_CODE (expr) == NON_LVALUE_EXPR)
    expr = TREE_OPERAND (expr, 0);

  return (TREE_CODE (expr) == REAL_CST
	  && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0));
}

/* Return 1 if EXPR is the real constant one.  */

int
real_onep (expr)
     tree expr;
{
  while (TREE_CODE (expr) == NON_LVALUE_EXPR)
    expr = TREE_OPERAND (expr, 0);

  return (TREE_CODE (expr) == REAL_CST
	  && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1));
}

/* Return 1 if EXPR is the real constant two.  */

int
real_twop (expr)
     tree expr;
{
  while (TREE_CODE (expr) == NON_LVALUE_EXPR)
    expr = TREE_OPERAND (expr, 0);

  return (TREE_CODE (expr) == REAL_CST
	  && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2));
}

/* Nonzero if EXP is a constant or a cast of a constant.  */
 
int
really_constant_p (exp)
     tree exp;
{
  while (TREE_CODE (exp) == NOP_EXPR
	 || TREE_CODE (exp) == CONVERT_EXPR
	 || TREE_CODE (exp) == NON_LVALUE_EXPR)
    exp = TREE_OPERAND (exp, 0);
  return TREE_CONSTANT (exp);
}

/* Return first list element whose TREE_VALUE is ELEM.
   Return 0 if ELEM is not it LIST.  */

tree
value_member (elem, list)
     tree elem, list;
{
  while (list)
    {
      if (elem == TREE_VALUE (list))
	return list;
      list = TREE_CHAIN (list);
    }
  return NULL_TREE;
}

/* Return first list element whose TREE_PURPOSE is ELEM.
   Return 0 if ELEM is not it LIST.  */

tree
purpose_member (elem, list)
     tree elem, list;
{
  while (list)
    {
      if (elem == TREE_PURPOSE (list))
	return list;
      list = TREE_CHAIN (list);
    }
  return NULL_TREE;
}

/* Return first list element whose BINFO_TYPE is ELEM.
   Return 0 if ELEM is not it LIST.  */

tree
binfo_member (elem, list)
     tree elem, list;
{
  while (list)
    {
      if (elem == BINFO_TYPE (list))
	return list;
      list = TREE_CHAIN (list);
    }
  return NULL_TREE;
}

/* Return nonzero if ELEM is part of the chain CHAIN.  */

int
chain_member (elem, chain)
     tree elem, chain;
{
  while (chain)
    {
      if (elem == chain)
	return 1;
      chain = TREE_CHAIN (chain);
    }

  return 0;
}

/* Return the length of a chain of nodes chained through TREE_CHAIN.
   We expect a null pointer to mark the end of the chain.
   This is the Lisp primitive `length'.  */

int
list_length (t)
     tree t;
{
  register tree tail;
  register int len = 0;

  for (tail = t; tail; tail = TREE_CHAIN (tail))
    len++;

  return len;
}

/* Concatenate two chains of nodes (chained through TREE_CHAIN)
   by modifying the last node in chain 1 to point to chain 2.
   This is the Lisp primitive `nconc'.  */

tree
chainon (op1, op2)
     tree op1, op2;
{
  tree t;

  if (op1)
    {
      for (t = op1; TREE_CHAIN (t); t = TREE_CHAIN (t))
	if (t == op2) abort ();	/* Circularity being created */
      TREE_CHAIN (t) = op2;
      return op1;
    }
  else return op2;
}

/* Return the last node in a chain of nodes (chained through TREE_CHAIN).  */

tree
tree_last (chain)
     register tree chain;
{
  register tree next;
  if (chain)
    while (next = TREE_CHAIN (chain))
      chain = next;
  return chain;
}