actions.c

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

/* Implement actions for CHILL.
   Copyright (C) 1992, 93, 1994, 1998, 1999 Free Software Foundation, Inc.
   Authors: Per Bothner, Bill Cox, Michael Tiemann, Michael North

This file is part of GNU CC.

GNU CC is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU CC is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU CC; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "system.h"
#include "tree.h"
#include "rtl.h"
#include "expr.h"
#include "ch-tree.h"
#include "lex.h"
#include "flags.h"
#include "actions.h"
#include "obstack.h"
#include "assert.h"
#include "toplev.h"

#define obstack_chunk_alloc xmalloc
#define obstack_chunk_free free

/* reserved tag definitions */

#define TYPE_ID                 "id"
#define TAG_OBJECT              "chill_object"
#define TAG_CLASS               "chill_class"

extern int flag_short_enums;
extern int current_nesting_level;

extern struct obstack *expression_obstack, permanent_obstack;
extern struct obstack *current_obstack, *saveable_obstack;

/* This flag is checked throughout the non-CHILL-specific
   in the front end. */
tree chill_integer_type_node;
tree chill_unsigned_type_node;

/* Never used.  Referenced from c-typeck.c, which we use. */
int current_function_returns_value = 0;
int current_function_returns_null = 0;

/* data imported from toplev.c  */

extern char *dump_base_name;

/* set from command line parameter, to exit after 
   grant file written, generating no code. */
int grant_only_flag = 0;

char *
lang_identify ()
{
  return "chill";
}


void
init_chill ()
{
}

void
print_lang_statistics ()
{
}


void
lang_finish ()
{
#if 0
    extern int errorcount, sorrycount;

    /* this should be the last action in compiling a module.
       If there are other actions to be performed at lang_finish
       please insert before this */

    /* FIXME: in case of a syntax error, this leaves the grant file incomplete */
    /* for the moment we print a warning in case of errors and 
       continue granting */
    if ((errorcount || sorrycount) && grant_count)
      {
	warning ("%d errors, %d sorries, do granting", errorcount, sorrycount);
	errorcount = sorrycount = 0;
      }
#endif
}

void
chill_check_decl (decl)
     tree decl;
{
  tree type = TREE_TYPE (decl);
  static int alreadyWarned = 0;

  if (TREE_CODE (type) == RECORD_TYPE) /* && TREE_STATIC_TEMPLATE (type)) */
    {
      if (!alreadyWarned)
        {
          error ("GNU compiler does not support statically allocated objects");          
          alreadyWarned = 1;
        }
      error_with_decl (decl, "`%s' cannot be statically allocated");
    }
}

/* Comparison function for sorting identifiers in RAISES lists.
   Note that because IDENTIFIER_NODEs are unique, we can sort
   them by address, saving an indirection.  */
static int
id_cmp (p1, p2)
     tree *p1, *p2;
{
  long diff = (long)TREE_VALUE (*p1) - (long)TREE_VALUE (*p2);

  return (diff < 0) ? -1 : (diff > 0);
}

/* Build the FUNCTION_TYPE or METHOD_TYPE which may raise exceptions
   listed in RAISES.  */
tree
build_exception_variant (type, raises)
     tree type, raises;
{
  int i;
  tree v = TYPE_MAIN_VARIANT (type);
  tree t, t2;
  int constp    = TYPE_READONLY (type);
  int volatilep = TYPE_VOLATILE (type);

  if (!raises)
    return build_type_variant (v, constp, volatilep);

  if (TREE_CHAIN (raises))
    { /* Sort the list */
      tree *a = (tree *)alloca ((list_length (raises)+1) * sizeof (tree));
      for (i = 0, t = raises; t; t = TREE_CHAIN (t), i++)
	a[i] = t;
      /* NULL terminator for list.  */
      a[i] = NULL_TREE;
      qsort (a, i, sizeof (tree), id_cmp);
      while (i--)
	TREE_CHAIN (a[i]) = a[i+1];
      raises = a[0];
    }

  for (v = TYPE_NEXT_VARIANT (v); v; v = TYPE_NEXT_VARIANT (v))
    {
      if (TYPE_READONLY (v) != constp
	  || TYPE_VOLATILE (v) != volatilep)
	continue;

      t = raises;
      t2 = TYPE_RAISES_EXCEPTIONS (v);
      while (t && t2)
	{
	  if (TREE_TYPE (t) == TREE_TYPE (t2))
	    {
	      t = TREE_CHAIN (t);
	      t2 = TREE_CHAIN (t2);
	    }
	  else break;
	}
      if (t || t2)
	continue;
      /* List of exceptions raised matches previously found list.

         @@ Nice to free up storage used in consing up the
	 @@ list of exceptions raised.  */
      return v;
    }

  /* Need to build a new variant.  */
  if (TREE_PERMANENT (type))
    {
      push_obstacks_nochange ();
      end_temporary_allocation ();
      v = copy_node (type);
      pop_obstacks ();
    }
  else
    v = copy_node (type);

  TYPE_NEXT_VARIANT (v) = TYPE_NEXT_VARIANT (type);
  TYPE_NEXT_VARIANT (type) = v;
  if (raises && ! TREE_PERMANENT (raises))
    {
      push_obstacks_nochange ();
      end_temporary_allocation ();
      raises = copy_list (raises);
      pop_obstacks ();
    }
  TYPE_RAISES_EXCEPTIONS (v) = raises;
  return v;
}
#if 0

tree
build_rts_call (name, type, args)
     char *name;
     tree type, args;
{
  tree decl = lookup_name (get_identifier (name));
  tree converted_args = NULL_TREE;
  tree result, length = NULL_TREE;

  assert (decl != NULL_TREE);
  while (args)
    {
      tree arg = TREE_VALUE (args);
      if (TREE_CODE (TREE_TYPE (arg)) == SET_TYPE
	  || TREE_CODE (TREE_TYPE (arg)) == ARRAY_TYPE)
	{
	  length = size_in_bytes (TREE_TYPE (arg));
	  arg = build_chill_addr_expr (arg, (char *)0);
	}
      converted_args = tree_cons (NULL_TREE, arg, converted_args);
      args = TREE_CHAIN (args);
    }
  if (length != NULL_TREE)
    converted_args = tree_cons (NULL_TREE, length, converted_args);
  converted_args = nreverse (converted_args);
  result = build_chill_function_call (decl, converted_args);
  if (TREE_CODE (type) == SET_TYPE || TREE_CODE (type) == ARRAY_TYPE)
    result = build1 (INDIRECT_REF, type, result);
  else
    result = convert (type, result);
  return result;
}
#endif

/*
 * queue name of unhandled exception
 * to avoid multiple unhandled warnings
 * in one compilation module
 */

struct already_type
{
  struct already_type *next;
  char *name;
};

static struct already_type *already_warned = 0;

static void
warn_unhandled (ex)
     char *ex;
{
  struct already_type *p = already_warned;

  while (p)
    {
      if (!strcmp (p->name, ex))
	return;
      p = p->next;
    }
  
  /* not yet warned */
  p = (struct already_type *)xmalloc (sizeof (struct already_type));
  p->next = already_warned;
  p->name = (char *)xmalloc (strlen (ex) + 1);
  strcpy (p->name, ex);
  already_warned = p;
  pedwarn ("causing unhandled exception `%s' (this is flaged only once)", ex);
}

/*
 * build a call to the following function:
 *   void   __cause_ex1 (char* ex, const char *file, 
 *                       const unsigned lineno);
 * if the exception is handled or
 *   void __unhandled_ex (char *ex, char *file, unsigned lineno)
 * if the exception is not handled.
 */
tree
build_cause_exception (exp_name, warn_if_unhandled)
     tree exp_name;
     int warn_if_unhandled;
{
  /* We don't use build_rts_call() here, because the string (array of char)
     would be followed by its length in the parameter list built by
     build_rts_call, and the runtime routine doesn't want a length parameter.*/
  tree exp_decl = build_chill_exception_decl (IDENTIFIER_POINTER (exp_name));
  tree function, fname, lineno, result;
  int handled = is_handled (exp_name);

  switch (handled)
    {
    case 0:
      /* no handler */
      if (warn_if_unhandled)
	warn_unhandled (IDENTIFIER_POINTER (exp_name));
      function = lookup_name (get_identifier ("__unhandled_ex"));
      fname = force_addr_of (get_chill_filename ());
      lineno = get_chill_linenumber ();
      break;
    case 1:
      /* local handler */
      function = lookup_name (get_identifier ("__cause_ex1"));
      fname = force_addr_of (get_chill_filename ());
      lineno = get_chill_linenumber ();
      break;
    case 2:
      /* function may propagate this exception */
      function = lookup_name (get_identifier ("__cause_ex1"));
      fname = lookup_name (get_identifier (CALLER_FILE));
      if (fname == NULL_TREE)
	fname = error_mark_node;
      lineno = lookup_name (get_identifier (CALLER_LINE));
      if (lineno == NULL_TREE)
	lineno = error_mark_node;
      break;
    default:
      abort();
    }
  result =
    build_chill_function_call (function,
      tree_cons (NULL_TREE, build_chill_addr_expr (exp_decl, (char *)0),
	tree_cons (NULL_TREE,  fname,
	  tree_cons (NULL_TREE, lineno, NULL_TREE))));
  return result;
}

void
expand_cause_exception (exp_name)
     tree exp_name;
{
  expand_expr_stmt (build_cause_exception (exp_name, 1));
}

/* If CONDITION is true, raise EXCEPTION (an IDENTIFIER_NODE);
   otherwise return EXPR. */

tree
check_expression (expr, condition, exception)
     tree expr, condition, exception;
{
  if (integer_zerop (condition))
    return expr;
  else
    return build (COMPOUND_EXPR, TREE_TYPE (expr),
		  fold (build (TRUTH_ANDIF_EXPR, boolean_type_node,
			       condition, build_cause_exception (exception, 0))),
		  expr);
}

/* Return an expression for VALUE < LO_LIMIT || VALUE > HI_LIMIT,
   somewhat optimized and with some warnings suppressed.
   If LO_LIMIT or HI_LIMIT is NULL_TREE, assume that (sub-)test passes.  */

tree
test_range (value, lo_limit, hi_limit)
     tree value, lo_limit, hi_limit;
{
  if (lo_limit || hi_limit)
    {
      int old_inhibit_warnings = inhibit_warnings;
      tree lo_check, hi_check, check;

      /* This is a hack so that `shorten_compare' doesn't warn the
	 user about useless range checks that are too much work to
	 optimize away here.  */
      inhibit_warnings = 1;

      lo_check = lo_limit ? 
	fold (build_compare_discrete_expr (LT_EXPR, value, lo_limit)) :
	  boolean_false_node;   /* fake passing the check */

      hi_check = hi_limit ? 
	fold (build_compare_discrete_expr (GT_EXPR, value, hi_limit)) :
	  boolean_false_node;   /* fake passing the check */

      if (lo_check == boolean_false_node)
	check = hi_check;
      else if (hi_check == boolean_false_node)
	check = lo_check;
      else
	check = fold (build (TRUTH_ORIF_EXPR, boolean_type_node,
			     lo_check, hi_check));

      inhibit_warnings = old_inhibit_warnings;
      return check;
    }
  else
    return boolean_false_node;
}

/* Return EXPR, except if range_checking is on, return an expression
   that also checks that value >= low_limit && value <= hi_limit.
   If LO_LIMIT or HI_LIMIT is NULL_TREE, assume that test passes.  */

tree
check_range (expr, value, lo_limit, hi_limit)
     tree expr, value, lo_limit, hi_limit;
{
  tree check = test_range (value, lo_limit, hi_limit);
  if (!integer_zerop (check))
    {
      if (current_function_decl == NULL_TREE)
	{
	  if (TREE_CODE (check) == INTEGER_CST)
	    error ("range failure (not inside function)");
	  else
	    warning ("possible range failure (not inside function)");
	}
      else
	{
	  if (TREE_CODE (check) == INTEGER_CST)
	    warning ("expression will always cause RANGEFAIL");
	  if (range_checking)
	    expr = check_expression (expr, check,
				     ridpointers[(int) RID_RANGEFAIL]);
	}
    }
  return expr;
}

/* Same as EXPR, except raise EMPTY if EXPR is NULL. */

tree
check_non_null (expr)
     tree expr;
{
  if (empty_checking)
    {
      expr = save_if_needed (expr);
      return check_expression (expr,
			       build_compare_expr (EQ_EXPR,
						   expr, null_pointer_node),
			       ridpointers[(int) RID_EMPTY]);
    }
  return expr;
}