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.
5 This file is part of GNU CC.
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)
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.
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. */
29 /* Here is how primitive or already-canonicalized types'
30 hash codes are made. */
31 #define TYPE_HASH(TYPE) ((HOST_WIDE_INT) (TYPE) & 0777777)
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;
38 static tree make_powerset_type PARAMS ((tree));
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. */
45 build_string_type (elt_type, length)
51 if (TREE_CODE (elt_type) == ERROR_MARK || TREE_CODE (length) == ERROR_MARK)
52 return error_mark_node;
54 /* Allocate the array after the pointer type,
55 in case we free it in type_hash_canon. */
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),
62 error ("string length > UPPER (UINT)");
63 length = integer_one_node;
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);
71 length = build (MINUS_EXPR, sizetype, length, size_one_node);
73 t = make_node (elt_type == boolean_type_node ? SET_TYPE : ARRAY_TYPE);
74 TREE_TYPE (t) = elt_type;
76 MARK_AS_STRING_TYPE (t);
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);
84 || (TREE_CODE (length) == INTEGER_CST && TYPE_SIZE (elt_type)))
86 if (TREE_CODE (t) == SET_TYPE)
87 t = layout_powerset_type (t);
89 t = layout_chill_array_type (t);
95 make_powerset_type (domain)
98 tree t = make_node (SET_TYPE);
100 TREE_TYPE (t) = boolean_type_node;
101 TYPE_DOMAIN (t) = domain;
106 /* Used to layout both bitstring and powerset types. */
109 layout_powerset_type (type)
112 tree domain = TYPE_DOMAIN (type);
114 if (! discrete_type_p (domain))
116 error ("Can only build a powerset from a discrete mode");
117 return error_mark_node;
120 if (TREE_CODE (TYPE_MAX_VALUE (domain)) == ERROR_MARK ||
121 TREE_CODE (TYPE_MIN_VALUE (domain)) == ERROR_MARK)
122 return error_mark_node;
124 if (TREE_CODE (TYPE_MAX_VALUE (domain)) != INTEGER_CST
125 || TREE_CODE (TYPE_MIN_VALUE (domain)) != INTEGER_CST)
127 if (CH_BOOLS_TYPE_P (type))
128 error ("non-constant bitstring size invalid");
130 error ("non-constant powerset size invalid");
131 return error_mark_node;
134 if (TYPE_SIZE (type) == 0)
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. */
142 build_powerset_type (type)
145 tree t = make_powerset_type (type);
147 t = layout_powerset_type (t);
152 build_bitstring_type (size_in_bits)
155 return build_string_type (boolean_type_node, size_in_bits);
158 /* Return get_identifier (the concatenations of part1, part2, and part3). */
161 get_identifier3 (part1, part2, part3)
162 const char *part1, *part2, *part3;
165 alloca (strlen(part1) + strlen(part2) + strlen(part3) + 1);
166 sprintf (buf, "%s%s%s", part1, part2, part3);
167 return get_identifier (buf);
170 /* Build an ALIAS_DECL for the prefix renamed clause:
171 (OLD_PREFIX -> NEW_PREFIX) ! POSTFIX. */
174 build_alias_decl (old_prefix, new_prefix, postfix)
175 tree old_prefix, new_prefix, postfix;
177 tree decl = make_node (ALIAS_DECL);
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;
184 char *buf = (char*) alloca (old_length + new_length + postfix_length + 3);
186 /* Convert (OP->NP)!P!ALL to (OP!P->NP!P)!ALL */
187 if (postfix_length > 1 && postfix_pointer[postfix_length-1] == '*')
189 int chopped_length = postfix_length - 2; /* Without final "!*" */
191 sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (old_prefix),
192 chopped_length, postfix_pointer);
194 sprintf (buf, "%.*s", chopped_length, postfix_pointer);
195 old_prefix = get_identifier (buf);
197 sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (new_prefix),
198 chopped_length, postfix_pointer);
200 sprintf (buf, "%.*s", chopped_length, postfix_pointer);
201 new_prefix = get_identifier (buf);
202 postfix = ALL_POSTFIX;
205 DECL_OLD_PREFIX (decl) = old_prefix;
206 DECL_NEW_PREFIX (decl) = new_prefix;
207 DECL_POSTFIX (decl) = postfix;
209 if (DECL_POSTFIX_ALL (decl))
210 DECL_NAME (decl) = NULL_TREE;
211 else if (new_prefix == NULL_TREE)
212 DECL_NAME (decl) = postfix;
214 DECL_NAME (decl) = get_identifier3 (IDENTIFIER_POINTER (new_prefix),
215 "!", IDENTIFIER_POINTER (postfix));
220 /* Return the "old name string" of an ALIAS_DECL. */
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)));
233 /* See if OLD_NAME (an identifier) matches the OLD_PREFIX!POSTFIX
234 of ALIAS. If so, return the corresponding NEW_NEW!POSTFIX. */
237 decl_check_rename (alias, old_name)
238 tree alias, old_name;
240 const char *old_pointer = IDENTIFIER_POINTER (old_name);
241 int old_len = IDENTIFIER_LENGTH (old_name);
242 if (DECL_OLD_PREFIX (alias))
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)
250 /* Skip the old prefix. */
251 old_pointer += old_prefix_len + 1; /* Also skip the '!', */
253 if (DECL_POSTFIX_ALL (alias)
254 || strcmp (IDENTIFIER_POINTER (DECL_POSTFIX (alias)), old_pointer) == 0)
256 if (DECL_NEW_PREFIX (alias))
257 return get_identifier3 (IDENTIFIER_POINTER (DECL_NEW_PREFIX (alias)),
259 else if (old_pointer == IDENTIFIER_POINTER (old_name))
262 return get_identifier (old_pointer);
268 /* 'EXIT foo' is treated like 'GOTO EXIT!foo'.
269 This function converts LABEL into a labal name for EXIT. */
272 munge_exit_label (label)
275 return get_identifier3 ("EXIT", "!", IDENTIFIER_POINTER (label));
278 /* Make SAVE_EXPRs as needed, but don't turn a location into a non-location. */
284 return CH_REFERABLE (exp) ? stabilize_reference (exp) : save_expr (exp);
287 /* Return the number of elements in T, which must be a discrete type. */
292 tree hi = convert (sizetype, TYPE_MAX_VALUE (t));
294 if (TYPE_MIN_VALUE (t))
295 hi = size_binop (MINUS_EXPR, hi, convert (sizetype, TYPE_MIN_VALUE (t)));
297 return size_binop (PLUS_EXPR, hi, integer_one_node);