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