/* Implement actions for CHILL.
- Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000
+ Free Software Foundation, Inc.
Authors: Per Bothner, Bill Cox, Michael Tiemann, Michael North
This file is part of GNU CC.
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, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include "config.h"
#include "system.h"
#include "obstack.h"
#include "assert.h"
#include "toplev.h"
+#include "diagnostic.h"
+
+static int id_cmp PARAMS ((tree *, tree *));
+static void warn_unhandled PARAMS ((const char *));
+static tree adjust_return_value PARAMS ((tree, const char *));
+static tree update_else_range_for_int_const PARAMS ((tree, tree));
+static tree update_else_range_for_range PARAMS ((tree, tree, tree));
+static tree update_else_range_for_range_expr PARAMS ((tree, tree));
+static tree update_else_range_for_type PARAMS ((tree, tree));
+static tree compute_else_range PARAMS ((tree, tree, int));
+static tree check_case_value PARAMS ((tree, tree));
+static void chill_handle_case_label_range PARAMS ((tree, tree, tree));
+static tree chill_handle_multi_case_label_range PARAMS ((tree, tree, tree));
+static tree chill_handle_multi_case_else_label PARAMS ((tree));
+static tree chill_handle_multi_case_label PARAMS ((tree, tree));
+static tree chill_handle_multi_case_label_list PARAMS ((tree, tree));
+static void print_missing_cases PARAMS ((tree, const unsigned char *, long));
#define obstack_chunk_alloc xmalloc
#define obstack_chunk_free free
grant file written, generating no code. */
int grant_only_flag = 0;
\f
-char *
+const char *
lang_identify ()
{
return "chill";
id_cmp (p1, p2)
tree *p1, *p2;
{
- return (int)TREE_VALUE (*p1) - (int)TREE_VALUE (*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
a[i] = t;
/* NULL terminator for list. */
a[i] = NULL_TREE;
- qsort (a, i, sizeof (tree), id_cmp);
+ qsort (a, i, sizeof (tree),
+ (int (*) PARAMS ((const void*, const void*))) id_cmp);
while (i--)
TREE_CHAIN (a[i]) = a[i+1];
raises = a[0];
\f
tree
build_rts_call (name, type, args)
- char *name;
+ const char *name;
tree type, args;
{
tree decl = lookup_name (get_identifier (name));
static void
warn_unhandled (ex)
- char *ex;
+ const char *ex;
{
struct already_type *p = already_warned;
/* 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);
+ p->name = xstrdup (ex);
already_warned = p;
pedwarn ("causing unhandled exception `%s' (this is flaged only once)", ex);
}
return expr;
}
\f
-/*
- * There are four conditions to generate a runtime check:
- * 1) assigning a longer INT to a shorter (signs irrelevant)
- * 2) assigning a signed to an unsigned
- * 3) assigning an unsigned to a signed of the same size.
- * 4) TYPE is a discrete subrange
- */
+/* There are four conditions to generate a runtime check:
+ 1) assigning a longer INT to a shorter (signs irrelevant)
+ 2) assigning a signed to an unsigned
+ 3) assigning an unsigned to a signed of the same size.
+ 4) TYPE is a discrete subrange */
+
tree
chill_convert_for_assignment (type, expr, place)
tree type, expr;
- char *place; /* location description for error messages */
+ const char *place; /* location description for error messages */
{
tree ttype = type;
tree etype = TREE_TYPE (expr);
}
result = convert (type, expr);
- /* If the type is a array of PACK bits and the expression is an array constructor,
- then build a CONSTRUCTOR for a bitstring. Bitstrings are zero based, so
- decrement the value of each CONSTRUCTOR element by the amount of the lower
- bound of the array. */
+ /* If the type is a array of PACK bits and the expression is an array
+ constructor, then build a CONSTRUCTOR for a bitstring. Bitstrings are
+ zero based, so decrement the value of each CONSTRUCTOR element by the
+ amount of the lower bound of the array. */
if (TREE_CODE (type) == ARRAY_TYPE && TYPE_PACKED (type)
&& TREE_CODE (result) == CONSTRUCTOR)
{
tree domain_min = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
tree new_list = NULL_TREE;
- long index;
+ unsigned HOST_WIDE_INT index;
tree element;
+
for (element = TREE_OPERAND (result, 1);
element != NULL_TREE;
element = TREE_CHAIN (element))
switch (TREE_CODE (purpose))
{
case INTEGER_CST:
- new_list = tree_cons (NULL_TREE,
- size_binop (MINUS_EXPR, purpose, domain_min),
- new_list);
+ new_list
+ = tree_cons (NULL_TREE,
+ fold (build (MINUS_EXPR, TREE_TYPE (purpose),
+ purpose, domain_min)),
+ new_list);
break;
case RANGE_EXPR:
- for (index = TREE_INT_CST_LOW (TREE_OPERAND (purpose, 0));
+ for (index = TREE_INT_CST_LOW (TREE_OPERAND (purpose, 0));
index <= TREE_INT_CST_LOW (TREE_OPERAND (purpose, 1));
index++)
new_list = tree_cons (NULL_TREE,
- size_binop (MINUS_EXPR,
- build_int_2 (index, 0),
- domain_min),
+ fold (build (MINUS_EXPR,
+ integer_type_node,
+ build_int_2 (index, 0),
+ domain_min)),
new_list);
break;
default:
static tree
adjust_return_value (expr, action)
tree expr;
- char *action;
+ const char *action;
{
tree type = TREE_TYPE (TREE_TYPE (current_function_decl));
int result_or_return;
{
tree type;
- char *action_name = result_or_return ? "RESULT" : "RETURN";
+ const char *action_name = result_or_return ? "RESULT" : "RETURN";
if (pass == 1)
return;
update_else_range_for_int_const (else_range, label)
tree else_range, label;
{
- int lowval, highval;
+ int lowval = 0, highval = 0;
int label_value = TREE_INT_CST_LOW (label);
tree this_range, prev_range, new_range;
tree else_range, low_target, high_target;
{
tree this_range, prev_range, new_range, next_range;
- int low_range_val, high_range_val;
+ int low_range_val = 0, high_range_val = 0;
int low_target_val = TREE_INT_CST_LOW (low_target);
int high_target_val = TREE_INT_CST_LOW (high_target);
chill_handle_multi_case_label (selector, label)
tree selector, label;
{
- tree expr;
+ tree expr = NULL_TREE;
if (label == NULL_TREE || TREE_CODE (label) == ERROR_MARK)
- return;
+ return NULL_TREE;
if (TREE_CODE (label) == INTEGER_CST)
{
tree high = TREE_OPERAND (label, 1);
if (TREE_CODE (low) != INTEGER_CST)
{
- error ("Lower bound of range must be a discrete literal expression");
+ error ("lower bound of range must be a discrete literal expression");
expr = error_mark_node;
}
if (TREE_CODE (high) != INTEGER_CST)
{
- error ("Upper bound of range must be a discrete literal expression");
+ error ("upper bound of range must be a discrete literal expression");
expr = error_mark_node;
}
if (expr != error_mark_node)
}
else
{
- error ("The CASE label is not valid");
+ error ("CASE label is not valid");
expr = error_mark_node;
}
}
if (labels != NULL_TREE || selector != NULL_TREE)
- error ("The number of CASE selectors does not match the number of CASE label lists");
+ error ("number of CASE selectors does not match the number of CASE label lists");
return larg;
}
static void
print_missing_cases (type, cases_seen, count)
tree type;
- unsigned char *cases_seen;
+ const unsigned char *cases_seen;
long count;
{
long i;
long x = i;
long j;
tree t = type;
- char *err_val_name = "???";
+ const 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));
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;
- }
+ {
+ char *bufptr;
+ if ((x >= ' ' && x < 127) && x != '\'' && x != '^')
+ sprintf (buf, "'%c'", (char)x);
+ else
+ sprintf (buf, "'^(%ld)'", x);
+ bufptr = buf;
+ j = i;
+ while (j < count && !BITARRAY_TEST(cases_seen, j))
+ j++;
+ if (j > i + 1)
+ {
+ long y = x+j-i-1;
+ bufptr += strlen (bufptr);
+ if ((y >= ' ' && y < 127) && y != '\'' && y != '^')
+ sprintf (bufptr, "%s:'%c'", buf, (char)y);
+ else
+ sprintf (bufptr, "%s:'^(%ld)'", buf, y);
+ i = j - 1;
+ }
+ err_val_name = bufptr;
+ }
break;
case ENUMERAL_TYPE:
for (v = TYPE_VALUES (t); v && x; v = TREE_CHAIN (v))
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;
+ HOST_WIDE_INT bytes_needed
+ = (size + HOST_BITS_PER_CHAR) / HOST_BITS_PER_CHAR;
if (size == -1)
warning ("CASE selector with variable range");
warning ("too many cases to do CASE completeness testing");
else
{
- bzero (cases_seen, bytes_needed);
+ memset (cases_seen, 0, bytes_needed);
mark_seen_cases (type, cases_seen, size, is_sparse);
print_missing_cases (type, cases_seen, size);
free (cases_seen);
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");
+ error ("you may not assign a value to a BUFFER or EVENT location");
return;
}
}
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 set_length
+ = fold (build (PLUS_EXPR, integer_type_node,
+ fold (build (MINUS_EXPR, integer_type_node,
+ 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)
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 = size_binop (PLUS_EXPR,
- size_binop (MINUS_EXPR,
- TYPE_MAX_VALUE (domain),
- TYPE_MIN_VALUE (domain)),
- integer_one_node);
+ tree array_length = powersetlen (array);
tree filename = force_addr_of (get_chill_filename());
expand_expr_stmt (
build_chill_function_call (lookup_name (
NULL_TREE)))))))));
}
- /* The following is probably superceded by the
+ /* The following is probably superseded by the
above code for SET_IN_EXPR. FIXME! */
else if (TREE_CODE (lhs) == BIT_FIELD_REF)
{
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 set_length
+ = fold (build (PLUS_EXPR, integer_type_node,
+ fold (build (MINUS_EXPR, integer_type_node,
+ 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);
+ to_pos = fold (build (MINUS_EXPR, integer_type_node,
+ fold (build (PLUS_EXPR, integer_type_node,
+ from_pos, numbits)),
+ integer_one_node));
break;
case BOOLEAN_TYPE:
to_pos = from_pos;
if (! CH_LOCATION_P (lhs))
{
- error ("Can only set LENGTH of array location");
+ error ("can only set LENGTH of array location");
return;
}
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);
+ rhs = fold (build (MINUS_EXPR, TREE_TYPE (rhs), rhs, min_domain_val));
expand_expr_stmt (build_chill_modify_expr (lhs, rhs));
}
OSDN Git Service
