gcc/ch/tree.c

   1 /* Language-dependent node constructors for parse phase of GNU compiler.
   2    Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GNU CC.
   6
   7 GNU CC is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU CC is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU CC; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 #include "config.h"
  23 #include "system.h"
  24 #include "obstack.h"
  25 #include "tree.h"
  26 #include "ch-tree.h"
  27 #include "toplev.h"
  28
  29 extern struct obstack permanent_obstack;
  30 /* This is special sentinel used to communicate from build_string_type
  31    to layout_chill_range_type for the index range of a string. */
  32 tree string_index_type_dummy;
  33
  34 static tree make_powerset_type                          PARAMS ((tree));
  35 \f
  36 /* Build a chill string type.
  37    For a character string, ELT_TYPE==char_type_node;
  38    for a bit-string, ELT_TYPE==boolean_type_node. */
  39
  40 tree
  41 build_string_type (elt_type, length)
  42      tree elt_type;
  43      tree length;
  44 {
  45   register tree t;
  46
  47   if (TREE_CODE (elt_type) == ERROR_MARK || TREE_CODE (length) == ERROR_MARK)
  48     return error_mark_node;
  49
  50   /* Allocate the array after the pointer type,
  51      in case we free it in type_hash_canon.  */
  52
  53   if (pass > 0 && TREE_CODE (length) == INTEGER_CST
  54       && ! tree_int_cst_equal (length, integer_zero_node)
  55       && compare_int_csts (LT_EXPR, TYPE_MAX_VALUE (chill_unsigned_type_node),
  56                            length))
  57     {
  58       error ("string length > UPPER (UINT)");
  59       length = integer_one_node;
  60     }
  61
  62   /* Subtract 1 from length to get max index value.
  63      Note we cannot use size_binop for pass 1 expressions. */
  64   if (TREE_CODE (length) == INTEGER_CST || pass != 1)
  65     length = size_binop (MINUS_EXPR, length, size_one_node);
  66   else
  67     length = build (MINUS_EXPR, sizetype, length, size_one_node);
  68
  69   t = make_node (elt_type == boolean_type_node ? SET_TYPE : ARRAY_TYPE);
  70   TREE_TYPE (t) = elt_type;
  71
  72   MARK_AS_STRING_TYPE (t);
  73
  74   TYPE_DOMAIN (t) = build_chill_range_type (string_index_type_dummy,
  75                                             integer_zero_node, length);
  76   if (pass == 1 && TREE_CODE (length) == INTEGER_CST)
  77     TYPE_DOMAIN (t) = layout_chill_range_type (TYPE_DOMAIN (t), 0);
  78
  79   if (pass != 1
  80       || (TREE_CODE (length) == INTEGER_CST && TYPE_SIZE (elt_type)))
  81     {
  82       if (TREE_CODE (t) == SET_TYPE)
  83         t = layout_powerset_type (t);
  84       else
  85         t = layout_chill_array_type (t);
  86     }
  87   return t;
  88 }
  89 \f
  90 static tree
  91 make_powerset_type (domain)
  92      tree domain;
  93 {
  94   tree t = make_node (SET_TYPE);
  95
  96   TREE_TYPE (t) = boolean_type_node;
  97   TYPE_DOMAIN (t) = domain;
  98
  99   return t;
 100 }
 101
 102 /* Used to layout both bitstring and powerset types. */
 103
 104 tree
 105 layout_powerset_type (type)
 106      tree type;
 107 {
 108   tree domain = TYPE_DOMAIN (type);
 109
 110   if (! discrete_type_p (domain))
 111     {
 112       error ("can only build a powerset from a discrete mode");
 113       return error_mark_node;
 114     }
 115
 116   if (TREE_CODE (TYPE_MAX_VALUE (domain)) == ERROR_MARK ||
 117       TREE_CODE (TYPE_MIN_VALUE (domain)) == ERROR_MARK)
 118     return error_mark_node;
 119
 120   if (TREE_CODE (TYPE_MAX_VALUE (domain)) != INTEGER_CST
 121       || TREE_CODE (TYPE_MIN_VALUE (domain)) != INTEGER_CST)
 122     {
 123       if (CH_BOOLS_TYPE_P (type))
 124         error ("non-constant bitstring size invalid");
 125       else
 126         error ("non-constant powerset size invalid");
 127       return error_mark_node;
 128     }
 129
 130   if (TYPE_SIZE (type) == 0)
 131     layout_type (type);
 132   return type;
 133 }
 134
 135 /* Build a SET_TYPE node whose elements are from the set of values
 136    in TYPE.  TYPE must be a discrete mode; we check for that here. */
 137 tree
 138 build_powerset_type (type)
 139      tree type;
 140 {
 141   tree t = make_powerset_type (type);
 142   if (pass != 1)
 143     t = layout_powerset_type (t);
 144   return t;
 145 }
 146
 147 tree
 148 build_bitstring_type (size_in_bits)
 149      tree size_in_bits;
 150 {
 151   return build_string_type (boolean_type_node, size_in_bits);
 152 }
 153
 154 /* Return get_identifier (the concatenations of part1, part2, and part3). */
 155
 156 tree
 157 get_identifier3 (part1, part2, part3)
 158      const char *part1, *part2, *part3;
 159 {
 160   char *buf = (char*)
 161     alloca (strlen(part1) + strlen(part2) + strlen(part3) + 1);
 162   sprintf (buf, "%s%s%s", part1, part2, part3);
 163   return get_identifier (buf);
 164 }
 165
 166 /* Build an ALIAS_DECL for the prefix renamed clause:
 167    (OLD_PREFIX -> NEW_PREFIX) ! POSTFIX. */
 168
 169 tree
 170 build_alias_decl (old_prefix, new_prefix, postfix)
 171      tree old_prefix, new_prefix, postfix;
 172 {
 173   tree decl = make_node (ALIAS_DECL);
 174
 175   const char *postfix_pointer = IDENTIFIER_POINTER (postfix);
 176   int postfix_length = IDENTIFIER_LENGTH (postfix);
 177   int old_length = old_prefix ? IDENTIFIER_LENGTH(old_prefix) : 0;
 178   int new_length = new_prefix ? IDENTIFIER_LENGTH(new_prefix) : 0;
 179
 180   char *buf = (char*) alloca (old_length + new_length + postfix_length + 3);
 181
 182   /* Convert (OP->NP)!P!ALL to (OP!P->NP!P)!ALL */
 183   if (postfix_length > 1 && postfix_pointer[postfix_length-1] == '*')
 184     {
 185       int chopped_length = postfix_length - 2; /* Without final "!*" */
 186       if (old_prefix)
 187         sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (old_prefix),
 188                  chopped_length, postfix_pointer);
 189       else
 190         sprintf (buf, "%.*s", chopped_length, postfix_pointer);
 191       old_prefix = get_identifier (buf);
 192       if (new_prefix)
 193         sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (new_prefix),
 194                  chopped_length, postfix_pointer);
 195       else
 196         sprintf (buf, "%.*s", chopped_length, postfix_pointer);
 197       new_prefix = get_identifier (buf);
 198       postfix = ALL_POSTFIX;
 199     }
 200
 201   DECL_OLD_PREFIX (decl) = old_prefix;
 202   DECL_NEW_PREFIX (decl) = new_prefix;
 203   DECL_POSTFIX (decl) = postfix;
 204
 205   if (DECL_POSTFIX_ALL (decl))
 206     DECL_NAME (decl) = NULL_TREE;
 207   else if (new_prefix == NULL_TREE)
 208     DECL_NAME (decl) = postfix;
 209   else
 210     DECL_NAME (decl) = get_identifier3 (IDENTIFIER_POINTER (new_prefix),
 211                                         "!", IDENTIFIER_POINTER (postfix));
 212
 213   return decl;
 214 }
 215
 216 /* Return the "old name string" of an ALIAS_DECL. */
 217
 218 tree
 219 decl_old_name (decl)
 220      tree decl;
 221 {
 222
 223   if (DECL_OLD_PREFIX (decl) == NULL_TREE)
 224     return DECL_POSTFIX (decl);
 225   return get_identifier3 (IDENTIFIER_POINTER (DECL_OLD_PREFIX (decl)),
 226                           "!", IDENTIFIER_POINTER (DECL_POSTFIX (decl)));
 227 }
 228
 229 /* See if OLD_NAME (an identifier) matches the OLD_PREFIX!POSTFIX
 230    of ALIAS.  If so, return the corresponding NEW_NEW!POSTFIX. */
 231
 232 tree
 233 decl_check_rename (alias, old_name)
 234      tree alias, old_name;
 235 {
 236   const char *old_pointer = IDENTIFIER_POINTER (old_name);
 237   int old_len = IDENTIFIER_LENGTH (old_name);
 238   if (DECL_OLD_PREFIX (alias))
 239     {
 240       int old_prefix_len = IDENTIFIER_LENGTH (DECL_OLD_PREFIX (alias));
 241       if (old_prefix_len >= old_len
 242           || old_pointer[old_prefix_len] != '!'
 243           || strncmp (old_pointer, IDENTIFIER_POINTER (DECL_OLD_PREFIX (alias)), old_prefix_len) != 0)
 244         return NULL_TREE;
 245
 246       /* Skip the old prefix. */
 247       old_pointer += old_prefix_len + 1; /* Also skip the '!', */
 248     }
 249   if (DECL_POSTFIX_ALL (alias)
 250       || strcmp (IDENTIFIER_POINTER (DECL_POSTFIX (alias)), old_pointer) == 0)
 251     {
 252       if (DECL_NEW_PREFIX (alias))
 253         return get_identifier3 (IDENTIFIER_POINTER (DECL_NEW_PREFIX (alias)),
 254                                 "!", old_pointer);
 255       else if (old_pointer == IDENTIFIER_POINTER (old_name))
 256         return old_name;
 257       else
 258         return get_identifier (old_pointer);
 259     }
 260   else
 261     return NULL_TREE;
 262 }
 263
 264 /* 'EXIT foo' is treated like 'GOTO EXIT!foo'.
 265     This function converts LABEL into a labal name for EXIT. */
 266
 267 tree
 268 munge_exit_label (label)
 269      tree label;
 270 {
 271   return get_identifier3 ("EXIT", "!", IDENTIFIER_POINTER (label));
 272 }
 273
 274 /* Make SAVE_EXPRs as needed, but don't turn a location into a non-location. */
 275
 276 tree
 277 save_if_needed (exp)
 278 tree exp;
 279 {
 280   return CH_REFERABLE (exp) ? stabilize_reference (exp) : save_expr (exp);
 281 }
 282
 283 /* Return the number of elements in T, which must be a discrete type. */
 284 tree
 285 discrete_count (t)
 286      tree t;
 287 {
 288   tree hi = convert (sizetype, TYPE_MAX_VALUE (t));
 289
 290   if (TYPE_MIN_VALUE (t))
 291     hi = size_binop (MINUS_EXPR, hi, convert (sizetype, TYPE_MIN_VALUE (t)));
 292
 293   return size_binop (PLUS_EXPR, hi, integer_one_node);
 294 }