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 /* Here is how primitive or already-canonicalized types'
  30    hash codes are made.  */
  31 #define TYPE_HASH(TYPE) ((HOST_WIDE_INT) (TYPE) & 0777777)
  32
  33 extern struct obstack permanent_obstack;
  34 /* This is special sentinel used to communicate from build_string_type
  35    to layout_chill_range_type for the index range of a string. */
  36 tree string_index_type_dummy;
  37
  38 static tree make_powerset_type                          PARAMS ((tree));
  39 \f
  40 /* Build a chill string type.
  41    For a character string, ELT_TYPE==char_type_node;
  42    for a bit-string, ELT_TYPE==boolean_type_node. */
  43
  44 tree
  45 build_string_type (elt_type, length)
  46      tree elt_type;
  47      tree length;
  48 {
  49   register tree t;
  50
  51   if (TREE_CODE (elt_type) == ERROR_MARK || TREE_CODE (length) == ERROR_MARK)
  52     return error_mark_node;
  53
  54   /* Allocate the array after the pointer type,
  55      in case we free it in type_hash_canon.  */
  56
  57   if (pass > 0 && TREE_CODE (length) == INTEGER_CST
  58       && ! tree_int_cst_equal (length, integer_zero_node)
  59       && compare_int_csts (LT_EXPR, TYPE_MAX_VALUE (chill_unsigned_type_node),
  60                            length))
  61     {
  62       error ("string length > UPPER (UINT)");
  63       length = integer_one_node;
  64     }
  65
  66   /* Subtract 1 from length to get max index value.
  67      Note we cannot use size_binop for pass 1 expressions. */
  68   if (TREE_CODE (length) == INTEGER_CST || pass != 1)
  69     length = size_binop (MINUS_EXPR, length, size_one_node);
  70   else
  71     length = build (MINUS_EXPR, sizetype, length, size_one_node);
  72
  73   t = make_node (elt_type == boolean_type_node ? SET_TYPE : ARRAY_TYPE);
  74   TREE_TYPE (t) = elt_type;
  75
  76   MARK_AS_STRING_TYPE (t);
  77
  78   TYPE_DOMAIN (t) = build_chill_range_type (string_index_type_dummy,
  79                                             integer_zero_node, length);
  80   if (pass == 1 && TREE_CODE (length) == INTEGER_CST)
  81     TYPE_DOMAIN (t) = layout_chill_range_type (TYPE_DOMAIN (t), 0);
  82
  83   if (pass != 1
  84       || (TREE_CODE (length) == INTEGER_CST && TYPE_SIZE (elt_type)))
  85     {
  86       if (TREE_CODE (t) == SET_TYPE)
  87         t = layout_powerset_type (t);
  88       else
  89         t = layout_chill_array_type (t);
  90     }
  91   return t;
  92 }
  93 \f
  94 static tree
  95 make_powerset_type (domain)
  96      tree domain;
  97 {
  98   tree t = make_node (SET_TYPE);
  99
 100   TREE_TYPE (t) = boolean_type_node;
 101   TYPE_DOMAIN (t) = domain;
 102
 103   return t;
 104 }
 105
 106 /* Used to layout both bitstring and powerset types. */
 107
 108 tree
 109 layout_powerset_type (type)
 110      tree type;
 111 {
 112   tree domain = TYPE_DOMAIN (type);
 113
 114   if (! discrete_type_p (domain))
 115     {
 116       error ("Can only build a powerset from a discrete mode");
 117       return error_mark_node;
 118     }
 119
 120   if (TREE_CODE (TYPE_MAX_VALUE (domain)) == ERROR_MARK ||
 121       TREE_CODE (TYPE_MIN_VALUE (domain)) == ERROR_MARK)
 122     return error_mark_node;
 123
 124   if (TREE_CODE (TYPE_MAX_VALUE (domain)) != INTEGER_CST
 125       || TREE_CODE (TYPE_MIN_VALUE (domain)) != INTEGER_CST)
 126     {
 127       if (CH_BOOLS_TYPE_P (type))
 128         error ("non-constant bitstring size invalid");
 129       else
 130         error ("non-constant powerset size invalid");
 131       return error_mark_node;
 132     }
 133
 134   if (TYPE_SIZE (type) == 0)
 135     layout_type (type);
 136   return type;
 137 }
 138
 139 /* Build a SET_TYPE node whose elements are from the set of values
 140    in TYPE.  TYPE must be a discrete mode; we check for that here. */
 141 tree
 142 build_powerset_type (type)
 143      tree type;
 144 {
 145   tree t = make_powerset_type (type);
 146   if (pass != 1)
 147     t = layout_powerset_type (t);
 148   return t;
 149 }
 150
 151 tree
 152 build_bitstring_type (size_in_bits)
 153      tree size_in_bits;
 154 {
 155   return build_string_type (boolean_type_node, size_in_bits);
 156 }
 157
 158 /* Return get_identifier (the concatenations of part1, part2, and part3). */
 159
 160 tree
 161 get_identifier3 (part1, part2, part3)
 162      const char *part1, *part2, *part3;
 163 {
 164   char *buf = (char*)
 165     alloca (strlen(part1) + strlen(part2) + strlen(part3) + 1);
 166   sprintf (buf, "%s%s%s", part1, part2, part3);
 167   return get_identifier (buf);
 168 }
 169
 170 /* Build an ALIAS_DECL for the prefix renamed clause:
 171    (OLD_PREFIX -> NEW_PREFIX) ! POSTFIX. */
 172
 173 tree
 174 build_alias_decl (old_prefix, new_prefix, postfix)
 175      tree old_prefix, new_prefix, postfix;
 176 {
 177   tree decl = make_node (ALIAS_DECL);
 178
 179   const char *postfix_pointer = IDENTIFIER_POINTER (postfix);
 180   int postfix_length = IDENTIFIER_LENGTH (postfix);
 181   int old_length = old_prefix ? IDENTIFIER_LENGTH(old_prefix) : 0;
 182   int new_length = new_prefix ? IDENTIFIER_LENGTH(new_prefix) : 0;
 183
 184   char *buf = (char*) alloca (old_length + new_length + postfix_length + 3);
 185
 186   /* Convert (OP->NP)!P!ALL to (OP!P->NP!P)!ALL */
 187   if (postfix_length > 1 && postfix_pointer[postfix_length-1] == '*')
 188     {
 189       int chopped_length = postfix_length - 2; /* Without final "!*" */
 190       if (old_prefix)
 191         sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (old_prefix),
 192                  chopped_length, postfix_pointer);
 193       else
 194         sprintf (buf, "%.*s", chopped_length, postfix_pointer);
 195       old_prefix = get_identifier (buf);
 196       if (new_prefix)
 197         sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (new_prefix),
 198                  chopped_length, postfix_pointer);
 199       else
 200         sprintf (buf, "%.*s", chopped_length, postfix_pointer);
 201       new_prefix = get_identifier (buf);
 202       postfix = ALL_POSTFIX;
 203     }
 204
 205   DECL_OLD_PREFIX (decl) = old_prefix;
 206   DECL_NEW_PREFIX (decl) = new_prefix;
 207   DECL_POSTFIX (decl) = postfix;
 208
 209   if (DECL_POSTFIX_ALL (decl))
 210     DECL_NAME (decl) = NULL_TREE;
 211   else if (new_prefix == NULL_TREE)
 212     DECL_NAME (decl) = postfix;
 213   else
 214     DECL_NAME (decl) = get_identifier3 (IDENTIFIER_POINTER (new_prefix),
 215                                         "!", IDENTIFIER_POINTER (postfix));
 216
 217   return decl;
 218 }
 219
 220 /* Return the "old name string" of an ALIAS_DECL. */
 221
 222 tree
 223 decl_old_name (decl)
 224      tree decl;
 225 {
 226
 227   if (DECL_OLD_PREFIX (decl) == NULL_TREE)
 228     return DECL_POSTFIX (decl);
 229   return get_identifier3 (IDENTIFIER_POINTER (DECL_OLD_PREFIX (decl)),
 230                           "!", IDENTIFIER_POINTER (DECL_POSTFIX (decl)));
 231 }
 232
 233 /* See if OLD_NAME (an identifier) matches the OLD_PREFIX!POSTFIX
 234    of ALIAS.  If so, return the corresponding NEW_NEW!POSTFIX. */
 235
 236 tree
 237 decl_check_rename (alias, old_name)
 238      tree alias, old_name;
 239 {
 240   const char *old_pointer = IDENTIFIER_POINTER (old_name);
 241   int old_len = IDENTIFIER_LENGTH (old_name);
 242   if (DECL_OLD_PREFIX (alias))
 243     {
 244       int old_prefix_len = IDENTIFIER_LENGTH (DECL_OLD_PREFIX (alias));
 245       if (old_prefix_len >= old_len
 246           || old_pointer[old_prefix_len] != '!'
 247           || strncmp (old_pointer, IDENTIFIER_POINTER (DECL_OLD_PREFIX (alias)), old_prefix_len) != 0)
 248         return NULL_TREE;
 249
 250       /* Skip the old prefix. */
 251       old_pointer += old_prefix_len + 1; /* Also skip the '!', */
 252     }
 253   if (DECL_POSTFIX_ALL (alias)
 254       || strcmp (IDENTIFIER_POINTER (DECL_POSTFIX (alias)), old_pointer) == 0)
 255     {
 256       if (DECL_NEW_PREFIX (alias))
 257         return get_identifier3 (IDENTIFIER_POINTER (DECL_NEW_PREFIX (alias)),
 258                                 "!", old_pointer);
 259       else if (old_pointer == IDENTIFIER_POINTER (old_name))
 260         return old_name;
 261       else
 262         return get_identifier (old_pointer);
 263     }
 264   else
 265     return NULL_TREE;
 266 }
 267
 268 /* 'EXIT foo' is treated like 'GOTO EXIT!foo'.
 269     This function converts LABEL into a labal name for EXIT. */
 270
 271 tree
 272 munge_exit_label (label)
 273      tree label;
 274 {
 275   return get_identifier3 ("EXIT", "!", IDENTIFIER_POINTER (label));
 276 }
 277
 278 /* Make SAVE_EXPRs as needed, but don't turn a location into a non-location. */
 279
 280 tree
 281 save_if_needed (exp)
 282 tree exp;
 283 {
 284   return CH_REFERABLE (exp) ? stabilize_reference (exp) : save_expr (exp);
 285 }
 286
 287 /* Return the number of elements in T, which must be a discrete type. */
 288 tree
 289 discrete_count (t)
 290      tree t;
 291 {
 292   tree hi = convert (sizetype, TYPE_MAX_VALUE (t));
 293
 294   if (TYPE_MIN_VALUE (t))
 295     hi = size_binop (MINUS_EXPR, hi, convert (sizetype, TYPE_MIN_VALUE (t)));
 296
 297   return size_binop (PLUS_EXPR, hi, integer_one_node);
 298 }