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