1 /* Build expressions with type checking for CHILL 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. */
23 /* This file is part of the CHILL front end.
24 It contains routines to build C expressions given their operands,
25 including computing the modes of the result, C-specific error checks,
26 and some optimization.
28 There are also routines to build RETURN_STMT nodes and CASE_STMT nodes,
29 and to process initializations in declarations (since they work
30 like a strange sort of assignment). */
43 /* forward declarations */
44 static int chill_l_equivalent
PARAMS ((tree
, tree
, struct mode_chain
*));
45 static tree extract_constant_from_buffer
PARAMS ((tree
, const unsigned char *, int));
46 static int expand_constant_to_buffer
PARAMS ((tree
, unsigned char *, int));
47 static tree build_empty_string
PARAMS ((tree
));
48 static tree make_chill_pointer_type
PARAMS ((tree
, enum tree_code
));
49 static unsigned int min_precision
PARAMS ((tree
, int));
50 static tree make_chill_range_type
PARAMS ((tree
, tree
, tree
));
51 static void apply_chill_array_layout
PARAMS ((tree
));
52 static int field_decl_cmp
PARAMS ((tree
*, tree
*));
53 static tree make_chill_struct_type
PARAMS ((tree
));
54 static int apply_chill_field_layout
PARAMS ((tree
, int *));
57 * This function checks an array access.
58 * It calls error (ERROR_MESSAGE) if the condition (index <= domain max value
59 * index >= domain min value)
60 * is not met at compile time,
61 * If a runtime test is required and permitted,
62 * check_expression is used to do so.
63 * the global RANGE_CHECKING flags controls the
64 * generation of runtime checking code.
67 valid_array_index_p (array
, idx
, error_message
, is_varying_lhs
)
69 const char *error_message
;
72 tree cond
, low_limit
, high_cond
, atype
, domain
;
73 tree orig_index
= idx
;
74 enum chill_tree_code condition
;
76 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
77 || idx
== NULL_TREE
|| TREE_CODE (idx
) == ERROR_MARK
)
78 return error_mark_node
;
80 if (TREE_CODE (idx
) == TYPE_DECL
81 || TREE_CODE_CLASS (TREE_CODE (idx
)) == 't')
83 error ("array or string index is a mode (instead of a value)");
84 return error_mark_node
;
87 atype
= TREE_TYPE (array
);
89 if (chill_varying_type_p (atype
))
91 domain
= TYPE_DOMAIN (CH_VARYING_ARRAY_TYPE (atype
));
92 high_cond
= build_component_ref (array
, var_length_id
);
93 if (chill_varying_string_type_p (atype
))
105 domain
= TYPE_DOMAIN (atype
);
106 high_cond
= TYPE_MAX_VALUE (domain
);
110 if (CH_STRING_TYPE_P (atype
))
112 if (! CH_SIMILAR (TREE_TYPE (orig_index
), integer_type_node
))
114 error ("index is not an integer expression");
115 return error_mark_node
;
120 if (! CH_COMPATIBLE (orig_index
, domain
))
122 error ("index not compatible with index mode");
123 return error_mark_node
;
127 /* Convert BOOLS(1) to BOOL and CHARS(1) to CHAR. */
128 if (flag_old_strings
)
130 idx
= convert_to_discrete (idx
);
131 if (idx
== NULL
) /* should never happen */
132 error ("index is not discrete");
135 /* we know we'll refer to this value twice */
137 idx
= save_expr (idx
);
139 low_limit
= TYPE_MIN_VALUE (domain
);
140 high_cond
= build_compare_discrete_expr (condition
, idx
, high_cond
);
142 /* an invalid index expression meets this condition */
143 cond
= fold (build (TRUTH_ORIF_EXPR
, boolean_type_node
,
144 build_compare_discrete_expr (LT_EXPR
, idx
, low_limit
),
147 /* strip a redundant NOP_EXPR */
148 if (TREE_CODE (cond
) == NOP_EXPR
149 && TREE_TYPE (cond
) == boolean_type_node
150 && TREE_CODE (TREE_OPERAND (cond
, 0)) == INTEGER_CST
)
151 cond
= TREE_OPERAND (cond
, 0);
153 idx
= convert (CH_STRING_TYPE_P (atype
) ? integer_type_node
: domain
,
156 if (TREE_CODE (cond
) == INTEGER_CST
)
158 if (tree_int_cst_equal (cond
, boolean_false_node
))
159 return idx
; /* condition met at compile time */
160 error ("%s", error_message
); /* condition failed at compile time */
161 return error_mark_node
;
163 else if (range_checking
)
165 /* FIXME: often, several of these conditions will
166 be generated for the same source file and line number.
167 A great optimization would be to share the
168 cause_exception function call among them rather
169 than generating a cause_exception call for each. */
170 return check_expression (idx
, cond
,
171 ridpointers
[(int) RID_RANGEFAIL
]);
174 return idx
; /* don't know at compile time */
178 * Extract a slice from an array, which could look like a
179 * SET_TYPE if it's a bitstring. The array could also be VARYING
180 * if the element type is CHAR. The min_value and length values
181 * must have already been checked with valid_array_index_p. No
182 * checking is done here.
185 build_chill_slice (array
, min_value
, length
)
186 tree array
, min_value
, length
;
189 tree array_type
= TREE_TYPE (array
);
191 if (!CH_REFERABLE (array
) && TREE_CODE (array
) != SAVE_EXPR
192 && (TREE_CODE (array
) != COMPONENT_REF
193 || TREE_CODE (TREE_OPERAND (array
, 0)) != SAVE_EXPR
))
195 if (!TREE_CONSTANT (array
))
196 warning ("possible internal error - slice argument is neither referable nor constant");
200 NOTE: This could mean multiple identical copies of
201 the same constant. FIXME. */
202 tree mydecl
= decl_temp1 (get_unique_identifier("SLICEE"),
203 array_type
, 1, array
, 0, 0);
204 TREE_READONLY (mydecl
) = 1;
205 /* mark_addressable (mydecl); FIXME: necessary? */
211 The code-generation which uses a slice tree needs not only to
212 know the dynamic upper and lower limits of that slice, but the
213 original static allocation, to use to build temps where one or both
214 of the dynamic limits must be calculated at runtime.. We pass the
215 dynamic size by building a new array_type whose limits are the
216 min_value and min_value + length values passed to us.
218 The static allocation info is passed by using the parent array's
219 limits to compute a temp_size, which is passed in the lang_specific
220 field of the slice_type. */
222 if (TREE_CODE (array_type
) == ARRAY_TYPE
)
224 tree domain_type
= TYPE_DOMAIN (array_type
);
225 tree domain_min
= TYPE_MIN_VALUE (domain_type
);
227 = fold (build (PLUS_EXPR
, domain_type
,
229 fold (build (MINUS_EXPR
, integer_type_node
,
230 length
, integer_one_node
))));
231 tree index_type
= build_chill_range_type (TYPE_DOMAIN (array_type
),
235 tree element_type
= TREE_TYPE (array_type
);
236 tree slice_type
= build_simple_array_type (element_type
, index_type
, NULL_TREE
);
237 tree slice_pointer_type
;
240 if (CH_CHARS_TYPE_P (array_type
))
241 MARK_AS_STRING_TYPE (slice_type
);
243 TYPE_PACKED (slice_type
) = TYPE_PACKED (array_type
);
245 SET_CH_NOVELTY (slice_type
, CH_NOVELTY (array_type
));
247 if (TREE_CONSTANT (array
) && host_integerp (min_value
, 0)
248 && host_integerp (length
, 0))
250 unsigned HOST_WIDE_INT type_size
= int_size_in_bytes (array_type
);
251 unsigned char *buffer
= (unsigned char *) alloca (type_size
);
252 int delta
= (int_size_in_bytes (element_type
)
253 * (tree_low_cst (min_value
, 0)
254 - tree_low_cst (domain_min
, 0)));
256 memset (buffer
, 0, type_size
);
257 if (expand_constant_to_buffer (array
, buffer
, type_size
))
259 result
= extract_constant_from_buffer (slice_type
,
267 /* Kludge used by case CONCAT_EXPR in chill_expand_expr.
268 Set TYPE_ARRAY_MAX_SIZE to a constant upper bound on the
270 max_size
= size_in_bytes (slice_type
);
271 if (TREE_CODE (max_size
) != INTEGER_CST
)
273 max_size
= TYPE_ARRAY_MAX_SIZE (array_type
);
274 if (max_size
== NULL_TREE
)
275 max_size
= size_in_bytes (array_type
);
277 TYPE_ARRAY_MAX_SIZE (slice_type
) = max_size
;
279 mark_addressable (array
);
280 /* Contruct a SLICE_EXPR to represent a slice of a packed array of bits. */
281 if (TYPE_PACKED (array_type
))
283 if (pass
== 2 && TREE_CODE (length
) != INTEGER_CST
)
285 sorry ("bit array slice with non-constant length");
286 return error_mark_node
;
288 if (domain_min
&& ! integer_zerop (domain_min
))
289 min_value
= size_binop (MINUS_EXPR
, min_value
,
290 convert (sizetype
, domain_min
));
291 result
= build (SLICE_EXPR
, slice_type
, array
, min_value
, length
);
292 TREE_READONLY (result
)
293 = TREE_READONLY (array
) | TYPE_READONLY (TREE_TYPE (array_type
));
297 slice_pointer_type
= build_chill_pointer_type (slice_type
);
298 if (TREE_CODE (min_value
) == INTEGER_CST
299 && domain_min
&& TREE_CODE (domain_min
) == INTEGER_CST
300 && compare_int_csts (EQ_EXPR
, min_value
, domain_min
))
301 result
= fold (build1 (ADDR_EXPR
, slice_pointer_type
, array
));
304 min_value
= convert (sizetype
, min_value
);
305 if (domain_min
&& ! integer_zerop (domain_min
))
306 min_value
= size_binop (MINUS_EXPR
, min_value
,
307 convert (sizetype
, domain_min
));
308 min_value
= size_binop (MULT_EXPR
, min_value
,
309 size_in_bytes (element_type
));
310 result
= fold (build (PLUS_EXPR
, slice_pointer_type
,
311 build1 (ADDR_EXPR
, slice_pointer_type
,
313 convert (slice_pointer_type
, min_value
)));
315 /* Return the final array value. */
316 result
= fold (build1 (INDIRECT_REF
, slice_type
, result
));
317 TREE_READONLY (result
)
318 = TREE_READONLY (array
) | TYPE_READONLY (element_type
);
321 else if (TREE_CODE (array_type
) == SET_TYPE
) /* actually a bitstring */
323 if (pass
== 2 && TREE_CODE (length
) != INTEGER_CST
)
325 sorry ("bitstring slice with non-constant length");
326 return error_mark_node
;
328 result
= build (SLICE_EXPR
, build_bitstring_type (length
),
329 array
, min_value
, length
);
330 TREE_READONLY (result
)
331 = TREE_READONLY (array
) | TYPE_READONLY (TREE_TYPE (array_type
));
334 else if (chill_varying_type_p (array_type
))
335 return build_chill_slice (varying_to_slice (array
), min_value
, length
);
338 error ("slice operation on non-array, non-bitstring value not supported");
339 return error_mark_node
;
344 build_empty_string (type
)
347 int orig_pass
= pass
;
350 range
= build_chill_range_type (type
, integer_zero_node
,
351 integer_minus_one_node
);
352 result
= build_chill_array_type (type
,
353 tree_cons (NULL_TREE
, range
, NULL_TREE
), 0, NULL_TREE
);
355 range
= build_chill_range_type (type
, integer_zero_node
,
356 integer_minus_one_node
);
357 result
= build_chill_array_type (type
,
358 tree_cons (NULL_TREE
, range
, NULL_TREE
), 0, NULL_TREE
);
361 return decl_temp1 (get_unique_identifier ("EMPTY_STRING"),
362 result
, 0, NULL_TREE
, 0, 0);
365 /* We build the runtime range-checking as a separate list
366 * rather than making a compound_expr with min_value
367 * (for example), to control when that comparison gets
368 * generated. We cannot allow it in a TYPE_MAX_VALUE or
369 * TYPE_MIN_VALUE expression, for instance, because that code
370 * will get generated when the slice is laid out, which would
371 * put it outside the scope of an exception handler for the
372 * statement we're generating. I.e. we would be generating
373 * cause_exception calls which might execute before the
374 * necessary ch_link_handler call.
377 build_chill_slice_with_range (array
, min_value
, max_value
)
378 tree array
, min_value
, max_value
;
380 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
381 || min_value
== NULL_TREE
|| TREE_CODE(min_value
) == ERROR_MARK
382 || max_value
== NULL_TREE
|| TREE_CODE(max_value
) == ERROR_MARK
)
383 return error_mark_node
;
385 if (TREE_TYPE (array
) == NULL_TREE
386 || (TREE_CODE (TREE_TYPE (array
)) != ARRAY_TYPE
387 && TREE_CODE (TREE_TYPE (array
)) != SET_TYPE
388 && !chill_varying_type_p (TREE_TYPE (array
))))
390 error ("can only take slice of array or string");
391 return error_mark_node
;
394 array
= save_if_needed (array
);
396 /* FIXME: test here for max_value >= min_value, except
397 for max_value == -1, min_value == 0 (empty string) */
398 min_value
= valid_array_index_p (array
, min_value
,
399 "slice lower limit out-of-range", 0);
400 if (TREE_CODE (min_value
) == ERROR_MARK
)
403 /* FIXME: suppress this test if max_value is the LENGTH of a
404 varying array, which has presumably already been checked. */
405 max_value
= valid_array_index_p (array
, max_value
,
406 "slice upper limit out-of-range", 0);
407 if (TREE_CODE (max_value
) == ERROR_MARK
)
408 return error_mark_node
;
410 if (TREE_CODE (min_value
) == INTEGER_CST
411 && TREE_CODE (max_value
) == INTEGER_CST
412 && tree_int_cst_lt (max_value
, min_value
))
413 return build_empty_string (TREE_TYPE (TREE_TYPE (array
)));
418 save_expr (fold (build (PLUS_EXPR
, integer_type_node
,
419 fold (build (MINUS_EXPR
, integer_type_node
,
420 max_value
, min_value
)),
421 integer_one_node
))));
425 build_chill_slice_with_length (array
, min_value
, length
)
426 tree array
, min_value
, length
;
429 tree cond
, high_cond
, atype
;
431 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
432 || min_value
== NULL_TREE
|| TREE_CODE(min_value
) == ERROR_MARK
433 || length
== NULL_TREE
|| TREE_CODE(length
) == ERROR_MARK
)
434 return error_mark_node
;
436 if (TREE_TYPE (array
) == NULL_TREE
437 || (TREE_CODE (TREE_TYPE (array
)) != ARRAY_TYPE
438 && TREE_CODE (TREE_TYPE (array
)) != SET_TYPE
439 && !chill_varying_type_p (TREE_TYPE (array
))))
441 error ("can only take slice of array or string");
442 return error_mark_node
;
445 if (TREE_CONSTANT (length
)
446 && tree_int_cst_lt (length
, integer_zero_node
))
447 return build_empty_string (TREE_TYPE (TREE_TYPE (array
)));
449 array
= save_if_needed (array
);
450 min_value
= save_expr (min_value
);
451 length
= save_expr (length
);
453 if (! CH_SIMILAR (TREE_TYPE (length
), integer_type_node
))
455 error ("slice length is not an integer");
456 length
= integer_one_node
;
459 max_index
= fold (build (MINUS_EXPR
, integer_type_node
,
460 fold (build (PLUS_EXPR
, integer_type_node
,
463 max_index
= convert_to_class (chill_expr_class (min_value
), max_index
);
465 min_value
= valid_array_index_p (array
, min_value
,
466 "slice start index out-of-range", 0);
467 if (TREE_CODE (min_value
) == ERROR_MARK
)
468 return error_mark_node
;
470 atype
= TREE_TYPE (array
);
472 if (chill_varying_type_p (atype
))
473 high_cond
= build_component_ref (array
, var_length_id
);
475 high_cond
= TYPE_MAX_VALUE (TYPE_DOMAIN (atype
));
477 /* an invalid index expression meets this condition */
478 cond
= fold (build (TRUTH_ORIF_EXPR
, boolean_type_node
,
479 build_compare_discrete_expr (LT_EXPR
,
480 length
, integer_zero_node
),
481 build_compare_discrete_expr (GT_EXPR
,
482 max_index
, high_cond
)));
484 if (TREE_CODE (cond
) == INTEGER_CST
)
486 if (! tree_int_cst_equal (cond
, boolean_false_node
))
488 error ("slice length out-of-range");
489 return error_mark_node
;
493 else if (range_checking
)
495 min_value
= check_expression (min_value
, cond
,
496 ridpointers
[(int) RID_RANGEFAIL
]);
499 return build_chill_slice (array
, min_value
, length
);
503 build_chill_array_ref (array
, indexlist
)
504 tree array
, indexlist
;
508 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
)
509 return error_mark_node
;
510 if (indexlist
== NULL_TREE
|| TREE_CODE (indexlist
) == ERROR_MARK
)
511 return error_mark_node
;
513 idx
= TREE_VALUE (indexlist
); /* handle first index */
515 idx
= valid_array_index_p (array
, idx
,
516 "array index out-of-range", 0);
517 if (TREE_CODE (idx
) == ERROR_MARK
)
518 return error_mark_node
;
520 array
= build_chill_array_ref_1 (array
, idx
);
522 if (array
&& TREE_CODE (array
) != ERROR_MARK
523 && TREE_CHAIN (indexlist
))
525 /* Z.200 (1988) section 4.2.8 says that:
526 <array> '(' <expression {',' <expression> }* ')'
527 is derived syntax (i.e. syntactic sugar) for:
528 <array> '(' <expression ')' { '(' <expression> ')' }*
529 The intent is clear if <array> has mode: ARRAY (...) ARRAY (...) XXX.
530 But what if <array> has mode: ARRAY (...) CHARS (N)
531 or: ARRAY (...) BOOLS (N).
532 Z.200 doesn't explicitly prohibit it, but the intent is unclear.
533 We'll allow it, since it seems reasonable and useful.
534 However, we won't allow it if <array> is:
535 ARRAY (...) PROC (...).
536 (The latter would make sense if we allowed general
537 Currying, which Chill doesn't.) */
538 if (TREE_CODE (TREE_TYPE (array
)) == ARRAY_TYPE
539 || chill_varying_type_p (TREE_TYPE (array
))
540 || CH_BOOLS_TYPE_P (TREE_TYPE (array
)))
541 array
= build_generalized_call (array
, TREE_CHAIN (indexlist
));
543 error ("too many index expressions");
549 * Don't error check the index in here. It's supposed to be
550 * checked by the caller.
553 build_chill_array_ref_1 (array
, idx
)
560 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
561 || idx
== NULL_TREE
|| TREE_CODE (idx
) == ERROR_MARK
)
562 return error_mark_node
;
564 if (chill_varying_type_p (TREE_TYPE (array
)))
565 array
= varying_to_slice (array
);
567 domain
= TYPE_DOMAIN (TREE_TYPE (array
));
570 if (! integer_zerop (TYPE_MIN_VALUE (domain
)))
572 /* The C part of the compiler doesn't understand how to do
573 arithmetic with dissimilar enum types. So we check compatability
574 here, and perform the math in INTEGER_TYPE. */
575 if (TREE_CODE (TREE_TYPE (idx
)) == ENUMERAL_TYPE
576 && chill_comptypes (TREE_TYPE (idx
), domain
, 0))
577 idx
= convert (TREE_TYPE (TYPE_MIN_VALUE (domain
)), idx
);
578 idx
= build_binary_op (MINUS_EXPR
, idx
, TYPE_MIN_VALUE (domain
), 0);
582 if (CH_STRING_TYPE_P (TREE_TYPE (array
)))
584 /* Could be bitstring or char string. */
585 if (TREE_TYPE (TREE_TYPE (array
)) == boolean_type_node
)
587 rval
= build (SET_IN_EXPR
, boolean_type_node
, idx
, array
);
588 TREE_READONLY (rval
) = TREE_READONLY (array
);
593 if (!discrete_type_p (TREE_TYPE (idx
)))
595 error ("array index is not discrete");
596 return error_mark_node
;
599 /* An array that is indexed by a non-constant
600 cannot be stored in a register; we must be able to do
601 address arithmetic on its address.
602 Likewise an array of elements of variable size. */
603 if (TREE_CODE (idx
) != INTEGER_CST
604 || (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array
))) != 0
605 && TREE_CODE (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array
)))) != INTEGER_CST
))
607 if (mark_addressable (array
) == 0)
608 return error_mark_node
;
611 type
= TREE_TYPE (TREE_TYPE (array
));
613 /* Do constant folding */
614 if (TREE_CODE (idx
) == INTEGER_CST
&& TREE_CONSTANT (array
))
616 struct ch_class
class;
617 class.kind
= CH_VALUE_CLASS
;
620 if (TREE_CODE (array
) == CONSTRUCTOR
)
622 tree list
= CONSTRUCTOR_ELTS (array
);
623 for ( ; list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
625 if (tree_int_cst_equal (TREE_PURPOSE (list
), idx
))
626 return convert_to_class (class, TREE_VALUE (list
));
629 else if (TREE_CODE (array
) == STRING_CST
630 && CH_CHARS_TYPE_P (TREE_TYPE (array
)))
632 HOST_WIDE_INT i
= tree_low_cst (idx
, 0);
634 if (i
>= 0 && i
< TREE_STRING_LENGTH (array
))
639 ((unsigned char) TREE_STRING_POINTER (array
) [i
], 0));
643 if (TYPE_PACKED (TREE_TYPE (array
)))
644 rval
= build (PACKED_ARRAY_REF
, type
, array
, idx
);
646 rval
= build (ARRAY_REF
, type
, array
, idx
);
648 /* Array ref is const/volatile if the array elements are
649 or if the array is. */
650 TREE_READONLY (rval
) = TREE_READONLY (array
) | TYPE_READONLY (type
);
651 TREE_SIDE_EFFECTS (rval
)
652 |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array
)))
653 | TREE_SIDE_EFFECTS (array
));
654 TREE_THIS_VOLATILE (rval
)
655 |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array
)))
656 /* This was added by rms on 16 Nov 91.
657 It fixes vol struct foo *a; a->elts[1]
658 in an inline function.
659 Hope it doesn't break something else. */
660 | TREE_THIS_VOLATILE (array
));
665 build_chill_bitref (bitstring
, indexlist
)
666 tree bitstring
, indexlist
;
668 if (TREE_CODE (bitstring
) == ERROR_MARK
)
670 if (TREE_CODE (indexlist
) == ERROR_MARK
)
673 if (TREE_CHAIN (indexlist
) != NULL_TREE
)
675 error ("invalid compound index for bitstring mode");
676 return error_mark_node
;
679 if (TREE_CODE (indexlist
) == TREE_LIST
)
681 tree result
= build (SET_IN_EXPR
, boolean_type_node
,
682 TREE_VALUE (indexlist
), bitstring
);
683 TREE_READONLY (result
) = TREE_READONLY (bitstring
);
691 discrete_type_p (type
)
694 return INTEGRAL_TYPE_P (type
);
697 /* Checks that EXP has discrete type, or can be converted to discrete.
698 Otherwise, returns NULL_TREE.
699 Normally returns the (possibly-converted) EXP. */
702 convert_to_discrete (exp
)
705 if (! discrete_type_p (TREE_TYPE (exp
)))
707 if (flag_old_strings
)
709 if (CH_CHARS_ONE_P (TREE_TYPE (exp
)))
710 return convert (char_type_node
, exp
);
711 if (CH_BOOLS_ONE_P (TREE_TYPE (exp
)))
712 return convert (boolean_type_node
, exp
);
719 /* Write into BUFFER the target-machine representation of VALUE.
720 Returns 1 on success, or 0 on failure. (Either the VALUE was
721 not constant, or we don't know how to do the conversion.) */
724 expand_constant_to_buffer (value
, buffer
, buf_size
)
726 unsigned char *buffer
;
729 tree type
= TREE_TYPE (value
);
730 int size
= int_size_in_bytes (type
);
732 if (size
< 0 || size
> buf_size
)
734 switch (TREE_CODE (value
))
738 unsigned HOST_WIDE_INT lo
= TREE_INT_CST_LOW (value
);
739 HOST_WIDE_INT hi
= TREE_INT_CST_HIGH (value
);
740 for (i
= 0; i
< size
; i
++)
742 /* Doesn't work if host and target BITS_PER_UNIT differ. */
743 unsigned char byte
= lo
& ((1 << BITS_PER_UNIT
) - 1);
745 if (BYTES_BIG_ENDIAN
)
746 buffer
[size
- i
- 1] = byte
;
750 rshift_double (lo
, hi
, BITS_PER_UNIT
, BITS_PER_UNIT
* size
,
757 size
= TREE_STRING_LENGTH (value
);
760 bcopy (TREE_STRING_POINTER (value
), buffer
, size
);
764 if (TREE_CODE (type
) == ARRAY_TYPE
)
766 tree element_type
= TREE_TYPE (type
);
767 int element_size
= int_size_in_bytes (element_type
);
768 tree list
= CONSTRUCTOR_ELTS (value
);
769 HOST_WIDE_INT next_index
;
770 HOST_WIDE_INT min_index
= 0;
771 if (element_size
< 0)
774 if (TYPE_DOMAIN (type
) != 0)
776 tree min_val
= TYPE_MIN_VALUE (TYPE_DOMAIN (type
));
779 if (! host_integerp (min_val
, 0))
782 min_index
= tree_low_cst (min_val
, 0);
786 next_index
= min_index
;
788 for (; list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
790 HOST_WIDE_INT offset
;
791 HOST_WIDE_INT last_index
;
792 tree purpose
= TREE_PURPOSE (list
);
796 if (host_integerp (purpose
, 0))
797 last_index
= next_index
= tree_low_cst (purpose
, 0);
798 else if (TREE_CODE (purpose
) == RANGE_EXPR
)
800 next_index
= tree_low_cst (TREE_OPERAND (purpose
, 0), 0);
801 last_index
= tree_low_cst (TREE_OPERAND (purpose
, 1), 0);
807 last_index
= next_index
;
808 for ( ; next_index
<= last_index
; next_index
++)
810 offset
= (next_index
- min_index
) * element_size
;
811 if (!expand_constant_to_buffer (TREE_VALUE (list
),
819 else if (TREE_CODE (type
) == RECORD_TYPE
)
821 tree list
= CONSTRUCTOR_ELTS (value
);
822 for (; list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
824 tree field
= TREE_PURPOSE (list
);
825 HOST_WIDE_INT offset
;
827 if (field
== NULL_TREE
|| TREE_CODE (field
) != FIELD_DECL
)
830 if (DECL_BIT_FIELD (field
))
833 offset
= int_byte_position (field
);
834 if (!expand_constant_to_buffer (TREE_VALUE (list
),
841 else if (TREE_CODE (type
) == SET_TYPE
)
843 if (get_set_constructor_bytes (value
, buffer
, buf_size
)
854 /* Given that BUFFER contains a target-machine representation of
855 a value of type TYPE, return that value as a tree.
856 Returns NULL_TREE on failure. (E.g. the TYPE might be variable size,
857 or perhaps we don't know how to do the conversion.) */
860 extract_constant_from_buffer (type
, buffer
, buf_size
)
862 const unsigned char *buffer
;
866 HOST_WIDE_INT size
= int_size_in_bytes (type
);
869 if (size
< 0 || size
> buf_size
)
872 switch (TREE_CODE (type
))
880 HOST_WIDE_INT lo
= 0, hi
= 0;
881 /* Accumulate (into (lo,hi) the bytes (from buffer). */
882 for (i
= size
; --i
>= 0; )
885 /* Get next byte (in big-endian order). */
886 if (BYTES_BIG_ENDIAN
)
887 byte
= buffer
[size
- i
- 1];
890 lshift_double (lo
, hi
, BITS_PER_UNIT
, TYPE_PRECISION (type
),
892 add_double (lo
, hi
, byte
, 0, &lo
, &hi
);
894 value
= build_int_2 (lo
, hi
);
895 TREE_TYPE (value
) = type
;
900 tree element_type
= TREE_TYPE (type
);
901 int element_size
= int_size_in_bytes (element_type
);
902 tree list
= NULL_TREE
;
903 HOST_WIDE_INT min_index
= 0, max_index
, cur_index
;
904 if (element_size
== 1 && CH_CHARS_TYPE_P (type
))
906 value
= build_string (size
, buffer
);
907 CH_DERIVED_FLAG (value
) = 1;
908 TREE_TYPE (value
) = type
;
911 if (TYPE_DOMAIN (type
) == 0)
913 value
= TYPE_MIN_VALUE (TYPE_DOMAIN (type
));
916 if (! host_integerp (value
, 0))
919 min_index
= tree_low_cst (value
, 0);
922 value
= TYPE_MAX_VALUE (TYPE_DOMAIN (type
));
923 if (value
== NULL_TREE
|| ! host_integerp (value
, 0))
926 max_index
= tree_low_cst (value
, 0);
928 for (cur_index
= max_index
; cur_index
>= min_index
; cur_index
--)
930 HOST_WIDE_INT offset
= (cur_index
- min_index
) * element_size
;
931 value
= extract_constant_from_buffer (element_type
,
934 if (value
== NULL_TREE
)
936 list
= tree_cons (build_int_2 (cur_index
, 0), value
, list
);
938 value
= build (CONSTRUCTOR
, type
, NULL_TREE
, list
);
939 TREE_CONSTANT (value
) = 1;
940 TREE_STATIC (value
) = 1;
945 tree list
= NULL_TREE
;
946 tree field
= TYPE_FIELDS (type
);
947 for (; field
!= NULL_TREE
; field
= TREE_CHAIN (field
))
949 HOST_WIDE_INT offset
= int_byte_position (field
);
951 if (DECL_BIT_FIELD (field
))
953 value
= extract_constant_from_buffer (TREE_TYPE (field
),
956 if (value
== NULL_TREE
)
958 list
= tree_cons (field
, value
, list
);
960 value
= build (CONSTRUCTOR
, type
, NULL_TREE
, nreverse (list
));
961 TREE_CONSTANT (value
) = 1;
962 TREE_STATIC (value
) = 1;
968 tree longest_variant
= NULL_TREE
;
969 unsigned HOST_WIDE_INT longest_size
= 0;
970 tree field
= TYPE_FIELDS (type
);
972 /* This is a kludge. We assume that converting the data to te
973 longest variant will provide valid data for the "correct"
974 variant. This is usually the case, but is not guaranteed.
975 For example, the longest variant may include holes.
976 Also incorrect interpreting the given value as the longest
977 variant may confuse the compiler if that should happen
978 to yield invalid values. ??? */
980 for (; field
!= NULL_TREE
; field
= TREE_CHAIN (field
))
982 unsigned HOST_WIDE_INT size
983 = int_size_in_bytes (TREE_TYPE (field
));
985 if (size
> longest_size
)
988 longest_variant
= field
;
992 if (longest_variant
== NULL_TREE
)
996 extract_constant_from_buffer (TREE_TYPE (longest_variant
),
1002 tree list
= NULL_TREE
;
1004 HOST_WIDE_INT min_index
, max_index
;
1006 if (TYPE_DOMAIN (type
) == 0)
1009 value
= TYPE_MIN_VALUE (TYPE_DOMAIN (type
));
1010 if (value
== NULL_TREE
)
1013 else if (! host_integerp (value
, 0))
1016 min_index
= tree_low_cst (value
, 0);
1018 value
= TYPE_MAX_VALUE (TYPE_DOMAIN (type
));
1019 if (value
== NULL_TREE
)
1021 else if (! host_integerp (value
, 0))
1024 max_index
= tree_low_cst (value
, 0);
1026 for (i
= max_index
+ 1 - min_index
; --i
>= 0; )
1028 unsigned char byte
= (unsigned char) buffer
[i
/ BITS_PER_UNIT
];
1029 unsigned bit_pos
= (unsigned) i
% (unsigned) BITS_PER_UNIT
;
1031 if (BYTES_BIG_ENDIAN
1032 ? (byte
& (1 << (BITS_PER_UNIT
- 1 - bit_pos
)))
1033 : (byte
& (1 << bit_pos
)))
1034 list
= tree_cons (NULL_TREE
,
1035 build_int_2 (i
+ min_index
, 0), list
);
1037 value
= build (CONSTRUCTOR
, type
, NULL_TREE
, list
);
1038 TREE_CONSTANT (value
) = 1;
1039 TREE_STATIC (value
) = 1;
1049 build_chill_cast (type
, expr
)
1055 int type_is_discrete
;
1056 int expr_type_is_discrete
;
1058 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
1059 return error_mark_node
;
1060 if (expr
== NULL_TREE
|| TREE_CODE (expr
) == ERROR_MARK
)
1061 return error_mark_node
;
1063 /* if expression was untyped because of its context (an
1064 if_expr or case_expr in a tuple, perhaps) just apply
1066 expr_type
= TREE_TYPE (expr
);
1067 if (expr_type
== NULL_TREE
1068 || TREE_CODE (expr_type
) == ERROR_MARK
)
1069 return convert (type
, expr
);
1071 if (expr_type
== type
)
1074 expr_type_size
= int_size_in_bytes (expr_type
);
1075 type_size
= int_size_in_bytes (type
);
1077 if (expr_type_size
== -1)
1079 error ("conversions from variable_size value");
1080 return error_mark_node
;
1082 if (type_size
== -1)
1084 error ("conversions to variable_size mode");
1085 return error_mark_node
;
1088 /* FIXME: process REAL ==> INT && INT ==> REAL && REAL ==> REAL. I hope this is correct. */
1089 if ((TREE_CODE (expr_type
) == INTEGER_TYPE
&& TREE_CODE (type
) == REAL_TYPE
) ||
1090 (TREE_CODE (expr_type
) == REAL_TYPE
&& TREE_CODE (type
) == INTEGER_TYPE
) ||
1091 (TREE_CODE (expr_type
) == REAL_TYPE
&& TREE_CODE (type
) == REAL_TYPE
))
1092 return convert (type
, expr
);
1094 /* FIXME: Don't know if this is correct */
1095 /* Don't allow conversions to or from REAL with others then integer */
1096 if (TREE_CODE (type
) == REAL_TYPE
)
1098 error ("cannot convert to float");
1099 return error_mark_node
;
1101 else if (TREE_CODE (expr_type
) == REAL_TYPE
)
1103 error ("cannot convert float to this mode");
1104 return error_mark_node
;
1107 if (expr_type_size
== type_size
&& CH_REFERABLE (expr
))
1108 goto do_location_conversion
;
1111 = discrete_type_p (type
) || TREE_CODE (type
) == POINTER_TYPE
;
1112 expr_type_is_discrete
1113 = discrete_type_p (expr_type
) || TREE_CODE (expr_type
) == POINTER_TYPE
;
1114 if (expr_type_is_discrete
&& type_is_discrete
)
1116 /* do an overflow check
1117 FIXME: is this always neccessary ??? */
1118 /* FIXME: don't do range chacking when target type is PTR.
1119 PTR doesn't have MIN and MAXVALUE. result is sigsegv. */
1120 if (range_checking
&& type
!= ptr_type_node
)
1125 if (TREE_CONSTANT (tmp
) && TREE_CODE (tmp
) != ADDR_EXPR
)
1127 if (compare_int_csts (LT_EXPR
, tmp
, TYPE_MIN_VALUE (type
)) ||
1128 compare_int_csts (GT_EXPR
, tmp
, TYPE_MAX_VALUE (type
)))
1130 error ("OVERFLOW in expression conversion");
1131 return error_mark_node
;
1136 int cond1
= tree_int_cst_lt (TYPE_SIZE (type
),
1137 TYPE_SIZE (expr_type
));
1138 int cond2
= TREE_UNSIGNED (type
) && (! TREE_UNSIGNED (expr_type
));
1139 int cond3
= (! TREE_UNSIGNED (type
))
1140 && TREE_UNSIGNED (expr_type
)
1141 && tree_int_cst_equal (TYPE_SIZE (type
),
1142 TYPE_SIZE (expr_type
));
1143 int cond4
= TREE_TYPE (type
) && type_is_discrete
;
1145 if (cond1
|| cond2
|| cond3
|| cond4
)
1147 tree type_min
= TYPE_MIN_VALUE (type
);
1148 tree type_max
= TYPE_MAX_VALUE (type
);
1150 expr
= save_if_needed (expr
);
1151 if (expr
&& type_min
&& type_max
)
1153 tree check
= test_range (expr
, type_min
, type_max
);
1154 if (!integer_zerop (check
))
1156 if (current_function_decl
== NULL_TREE
)
1158 if (TREE_CODE (check
) == INTEGER_CST
)
1159 error ("overflow (not inside function)");
1161 warning ("possible overflow (not inside function)");
1165 if (TREE_CODE (check
) == INTEGER_CST
)
1166 warning ("expression will always cause OVERFLOW");
1167 expr
= check_expression (expr
, check
,
1168 ridpointers
[(int) RID_OVERFLOW
]);
1175 return convert (type
, expr
);
1178 if (TREE_CODE (expr
) == INTEGER_CST
&& expr_type_size
!= type_size
)
1180 /* There should probably be a pedwarn here ... */
1181 tree itype
= type_for_size (type_size
* BITS_PER_UNIT
, 1);
1184 expr
= convert (itype
, expr
);
1185 expr_type
= TREE_TYPE (expr
);
1186 expr_type_size
= type_size
;
1190 /* If expr is a constant of the right size, use it to to
1191 initialize a static variable. */
1192 if (expr_type_size
== type_size
&& TREE_CONSTANT (expr
) && !pedantic
)
1194 unsigned char *buffer
= (unsigned char*) alloca (type_size
);
1196 memset (buffer
, 0, type_size
);
1197 if (!expand_constant_to_buffer (expr
, buffer
, type_size
))
1199 error ("not implemented: constant conversion from that kind of expression");
1200 return error_mark_node
;
1202 value
= extract_constant_from_buffer (type
, buffer
, type_size
);
1203 if (value
== NULL_TREE
)
1205 error ("not implemented: constant conversion to that kind of mode");
1206 return error_mark_node
;
1211 if (!CH_REFERABLE (expr
) && expr_type_size
== type_size
)
1213 tree temp
= decl_temp1 (get_unique_identifier ("CAST"),
1214 TREE_TYPE (expr
), 0, 0, 0, 0);
1215 tree convert1
= build_chill_modify_expr (temp
, expr
);
1216 pedwarn ("non-standard, non-portable value conversion");
1217 return build (COMPOUND_EXPR
, type
, convert1
,
1218 build_chill_cast (type
, temp
));
1221 if (CH_REFERABLE (expr
) && expr_type_size
!= type_size
)
1222 error ("location conversion between differently-sized modes");
1224 error ("unsupported value conversion");
1225 return error_mark_node
;
1227 do_location_conversion
:
1228 /* To avoid confusing other parts of gcc,
1229 represent this as the C expression: *(TYPE*)EXPR. */
1230 mark_addressable (expr
);
1231 expr
= build1 (INDIRECT_REF
, type
,
1232 build1 (NOP_EXPR
, build_pointer_type (type
),
1233 build1 (ADDR_EXPR
, build_pointer_type (expr_type
),
1235 TREE_READONLY (expr
) = TYPE_READONLY (type
);
1239 /* Given a set_type, build an integer array from it that C will grok. */
1242 build_array_from_set (type
)
1245 tree bytespint
, bit_array_size
, int_array_count
;
1247 if (type
== NULL_TREE
|| type
== error_mark_node
1248 || TREE_CODE (type
) != SET_TYPE
)
1249 return error_mark_node
;
1251 /* ??? Should this really be *HOST*?? */
1252 bytespint
= size_int (HOST_BITS_PER_INT
/ HOST_BITS_PER_CHAR
);
1253 bit_array_size
= size_in_bytes (type
);
1254 int_array_count
= size_binop (TRUNC_DIV_EXPR
, bit_array_size
, bytespint
);
1255 if (integer_zerop (int_array_count
))
1256 int_array_count
= size_one_node
;
1257 type
= build_array_type (integer_type_node
,
1258 build_index_type (int_array_count
));
1264 build_chill_bin_type (size
)
1268 HOST_WIDE_INT isize
;
1270 if (! host_integerp (size
, 1))
1272 error ("operand to bin must be a non-negative integer literal");
1273 return error_mark_node
;
1276 isize
= tree_low_cst (size
, 1);
1278 if (isize
<= TYPE_PRECISION (unsigned_char_type_node
))
1279 return unsigned_char_type_node
;
1280 if (isize
<= TYPE_PRECISION (short_unsigned_type_node
))
1281 return short_unsigned_type_node
;
1282 if (isize
<= TYPE_PRECISION (unsigned_type_node
))
1283 return unsigned_type_node
;
1284 if (isize
<= TYPE_PRECISION (long_unsigned_type_node
))
1285 return long_unsigned_type_node
;
1286 if (isize
<= TYPE_PRECISION (long_long_unsigned_type_node
))
1287 return long_long_unsigned_type_node
;
1288 error ("size %d of BIN too big - no such integer mode", isize
);
1289 return error_mark_node
;
1295 bintype
= make_node (INTEGER_TYPE
);
1296 TREE_TYPE (bintype
) = ridpointers
[(int) RID_BIN
];
1297 TYPE_MIN_VALUE (bintype
) = size
;
1298 TYPE_MAX_VALUE (bintype
) = size
;
1302 error ("BIN in pass 2");
1303 return error_mark_node
;
1309 chill_expand_tuple (type
, constructor
)
1310 tree type
, constructor
;
1313 tree nonreft
= type
;
1315 if (TYPE_NAME (type
) != NULL_TREE
)
1317 if (TREE_CODE (TYPE_NAME (type
)) == IDENTIFIER_NODE
)
1318 name
= IDENTIFIER_POINTER (TYPE_NAME (type
));
1320 name
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (type
)));
1325 /* get to actual underlying type for digest_init */
1326 while (nonreft
&& TREE_CODE (nonreft
) == REFERENCE_TYPE
)
1327 nonreft
= TREE_TYPE (nonreft
);
1329 if (TREE_CODE (nonreft
) == ARRAY_TYPE
1330 || TREE_CODE (nonreft
) == RECORD_TYPE
1331 || TREE_CODE (nonreft
) == SET_TYPE
)
1332 return convert (nonreft
, constructor
);
1335 error ("mode of tuple is neither ARRAY, STRUCT, nor POWERSET");
1336 return error_mark_node
;
1340 /* This function classifies an expr into the Null class,
1341 the All class, the M-Value, the M-derived, or the M-reference class.
1342 It probably has some inaccuracies. */
1345 chill_expr_class (expr
)
1348 struct ch_class
class;
1349 /* The Null class contains the NULL pointer constant (only). */
1350 if (expr
== null_pointer_node
)
1352 class.kind
= CH_NULL_CLASS
;
1353 class.mode
= NULL_TREE
;
1357 /* The All class contains the <undefined value> "*". */
1358 if (TREE_CODE (expr
) == UNDEFINED_EXPR
)
1360 class.kind
= CH_ALL_CLASS
;
1361 class.mode
= NULL_TREE
;
1365 if (CH_DERIVED_FLAG (expr
))
1367 class.kind
= CH_DERIVED_CLASS
;
1368 class.mode
= TREE_TYPE (expr
);
1372 /* The M-Reference contains <references location> (address-of) expressions.
1373 Note that something that's been converted to a reference doesn't count. */
1374 if (TREE_CODE (expr
) == ADDR_EXPR
1375 && TREE_CODE (TREE_TYPE (expr
)) != REFERENCE_TYPE
)
1377 class.kind
= CH_REFERENCE_CLASS
;
1378 class.mode
= TREE_TYPE (TREE_TYPE (expr
));
1382 /* The M-Value class contains expressions with a known, specific mode M. */
1383 class.kind
= CH_VALUE_CLASS
;
1384 class.mode
= TREE_TYPE (expr
);
1388 /* Returns >= 1 iff REF is a location. Return 2 if it is referable. */
1390 int chill_location (ref
)
1393 register enum tree_code code
= TREE_CODE (ref
);
1400 case PACKED_ARRAY_REF
:
1402 case NOP_EXPR
: /* RETYPE_EXPR */
1403 return chill_location (TREE_OPERAND (ref
, 0));
1405 return chill_location (TREE_OPERAND (ref
, 1));
1409 /* A bit-string slice is nor referable. */
1410 return chill_location (TREE_OPERAND (ref
, 0)) == 0 ? 0 : 1;
1421 if (TREE_CODE (TREE_TYPE (ref
)) != FUNCTION_TYPE
1422 && TREE_CODE (TREE_TYPE (ref
)) != METHOD_TYPE
)
1433 chill_referable (val
)
1436 return chill_location (val
) > 1;
1439 /* Make a copy of MODE, but with the given NOVELTY. */
1442 copy_novelty (novelty
, mode
)
1445 if (CH_NOVELTY (mode
) != novelty
)
1447 mode
= copy_node (mode
);
1448 TYPE_MAIN_VARIANT (mode
) = mode
;
1449 TYPE_NEXT_VARIANT (mode
) = 0;
1450 TYPE_POINTER_TO (mode
) = 0;
1451 TYPE_REFERENCE_TO (mode
) = 0;
1452 SET_CH_NOVELTY (mode
, novelty
);
1460 struct mode_chain
*prev
;
1464 /* Tests if MODE1 and MODE2 are SIMILAR.
1465 This is more or less as defined in the Blue Book, though
1466 see FIXME for parts that are unfinished.
1467 CHAIN is used to catch infinite recursion: It is a list of pairs
1468 of mode arguments to calls to chill_similar "outer" to this call. */
1471 chill_similar (mode1
, mode2
, chain
)
1473 struct mode_chain
*chain
;
1475 int varying1
, varying2
;
1477 struct mode_chain
*link
, node
;
1478 if (mode1
== NULL_TREE
|| mode2
== NULL_TREE
)
1481 while (TREE_CODE (mode1
) == REFERENCE_TYPE
)
1482 mode1
= TREE_TYPE (mode1
);
1483 while (TREE_CODE (mode2
) == REFERENCE_TYPE
)
1484 mode2
= TREE_TYPE (mode2
);
1486 /* Range modes are similar to their parent types. */
1487 while (TREE_CODE (mode1
) == INTEGER_TYPE
&& TREE_TYPE (mode1
) != NULL_TREE
)
1488 mode1
= TREE_TYPE (mode1
);
1489 while (TREE_CODE (mode2
) == INTEGER_TYPE
&& TREE_TYPE (mode2
) != NULL_TREE
)
1490 mode2
= TREE_TYPE (mode2
);
1493 /* see Z.200 sections 12.1.2.2 and 13.2 - all integer precisions
1494 are similar to INT and to each other */
1495 if (mode1
== mode2
||
1496 (TREE_CODE (mode1
) == INTEGER_TYPE
&& TREE_CODE (mode2
) == INTEGER_TYPE
))
1499 /* This guards against certain kinds of recursion.
1501 SYNMODE a = STRUCT ( next REF a );
1502 SYNMODE b = STRUCT ( next REF b );
1503 These moes are similar, but will get an infite recursion trying
1504 to prove that. So, if we are recursing, assume the moes are similar.
1505 If they are not, we'll find some other discrepancy. */
1506 for (link
= chain
; link
!= NULL
; link
= link
->prev
)
1508 if (link
->mode1
== mode1
&& link
->mode2
== mode2
)
1516 varying1
= chill_varying_type_p (mode1
);
1517 varying2
= chill_varying_type_p (mode2
);
1518 /* FIXME: This isn't quite strict enough. */
1519 if ((varying1
&& varying2
)
1520 || (varying1
&& TREE_CODE (mode2
) == ARRAY_TYPE
)
1521 || (varying2
&& TREE_CODE (mode1
) == ARRAY_TYPE
))
1524 if (TREE_CODE(mode1
) != TREE_CODE(mode2
))
1526 if (flag_old_strings
)
1528 /* The recursion is to handle varying strings. */
1529 if ((TREE_CODE (mode1
) == CHAR_TYPE
1530 && CH_SIMILAR (mode2
, string_one_type_node
))
1531 || (TREE_CODE (mode2
) == CHAR_TYPE
1532 && CH_SIMILAR (mode1
, string_one_type_node
)))
1534 if ((TREE_CODE (mode1
) == BOOLEAN_TYPE
1535 && CH_SIMILAR (mode2
, bitstring_one_type_node
))
1536 || (TREE_CODE (mode2
) == BOOLEAN_TYPE
1537 && CH_SIMILAR (mode1
, bitstring_one_type_node
)))
1540 if (TREE_CODE (mode1
) == FUNCTION_TYPE
1541 && TREE_CODE (mode2
) == POINTER_TYPE
1542 && TREE_CODE (TREE_TYPE (mode2
)) == FUNCTION_TYPE
)
1543 mode2
= TREE_TYPE (mode2
);
1544 else if (TREE_CODE (mode2
) == FUNCTION_TYPE
1545 && TREE_CODE (mode1
) == POINTER_TYPE
1546 && TREE_CODE (TREE_TYPE (mode1
)) == FUNCTION_TYPE
)
1547 mode1
= TREE_TYPE (mode1
);
1552 if (CH_IS_BUFFER_MODE (mode1
) && CH_IS_BUFFER_MODE (mode2
))
1554 tree len1
= max_queue_size (mode1
);
1555 tree len2
= max_queue_size (mode2
);
1556 return tree_int_cst_equal (len1
, len2
);
1558 else if (CH_IS_EVENT_MODE (mode1
) && CH_IS_EVENT_MODE (mode2
))
1560 tree len1
= max_queue_size (mode1
);
1561 tree len2
= max_queue_size (mode2
);
1562 return tree_int_cst_equal (len1
, len2
);
1564 else if (CH_IS_ACCESS_MODE (mode1
) && CH_IS_ACCESS_MODE (mode2
))
1566 tree index1
= access_indexmode (mode1
);
1567 tree index2
= access_indexmode (mode2
);
1568 tree record1
= access_recordmode (mode1
);
1569 tree record2
= access_recordmode (mode2
);
1570 if (! chill_read_compatible (index1
, index2
))
1572 return chill_read_compatible (record1
, record2
);
1574 switch ((enum chill_tree_code
)TREE_CODE (mode1
))
1581 if (TYPE_VALUES (mode1
) == TYPE_VALUES (mode2
))
1585 /* FIXME: This is more strict than z.200, which seems to
1586 allow the elements to be reordered, as long as they
1587 have the same values. */
1589 tree field1
= TYPE_VALUES (mode1
);
1590 tree field2
= TYPE_VALUES (mode2
);
1592 while (field1
!= NULL_TREE
&& field2
!= NULL_TREE
)
1594 tree value1
, value2
;
1595 /* Check that the names are equal. */
1596 if (TREE_PURPOSE (field1
) != TREE_PURPOSE (field2
))
1599 value1
= TREE_VALUE (field1
);
1600 value2
= TREE_VALUE (field2
);
1601 /* This isn't quite sufficient in general, but will do ... */
1602 /* Note that proclaim_decl can cause the SET modes to be
1603 compared BEFORE they are satisfied, but otherwise
1604 chill_similar is mostly called after satisfaction. */
1605 if (TREE_CODE (value1
) == CONST_DECL
)
1606 value1
= DECL_INITIAL (value1
);
1607 if (TREE_CODE (value2
) == CONST_DECL
)
1608 value2
= DECL_INITIAL (value2
);
1609 /* Check that the values are equal or both NULL. */
1610 if (!(value1
== NULL_TREE
&& value2
== NULL_TREE
)
1611 && (value1
== NULL_TREE
|| value2
== NULL_TREE
1612 || ! tree_int_cst_equal (value1
, value2
)))
1614 field1
= TREE_CHAIN (field1
);
1615 field2
= TREE_CHAIN (field2
);
1617 return field1
== NULL_TREE
&& field2
== NULL_TREE
;
1620 /* check for bit strings */
1621 if (CH_BOOLS_TYPE_P (mode1
))
1622 return CH_BOOLS_TYPE_P (mode2
);
1623 if (CH_BOOLS_TYPE_P (mode2
))
1624 return CH_BOOLS_TYPE_P (mode1
);
1625 /* both are powerset modes */
1626 return CH_EQUIVALENT (TYPE_DOMAIN (mode1
), TYPE_DOMAIN (mode2
));
1629 /* Are the referenced modes equivalent? */
1630 return !integer_zerop (chill_equivalent (TREE_TYPE (mode1
),
1635 /* char for char strings */
1636 if (CH_CHARS_TYPE_P (mode1
))
1637 return CH_CHARS_TYPE_P (mode2
);
1638 if (CH_CHARS_TYPE_P (mode2
))
1639 return CH_CHARS_TYPE_P (mode1
);
1641 if (CH_V_EQUIVALENT (TYPE_DOMAIN (mode1
), TYPE_DOMAIN (mode2
))
1642 /* Are the elements modes equivalent? */
1643 && !integer_zerop (chill_equivalent (TREE_TYPE (mode1
),
1647 /* FIXME: Check that element layouts are equivalent */
1649 tree count1
= fold (build (MINUS_EXPR
, sizetype
,
1650 TYPE_MAX_VALUE (TYPE_DOMAIN (mode1
)),
1651 TYPE_MIN_VALUE (TYPE_DOMAIN (mode1
))));
1652 tree count2
= fold (build (MINUS_EXPR
, sizetype
,
1653 TYPE_MAX_VALUE (TYPE_DOMAIN (mode2
)),
1654 TYPE_MIN_VALUE (TYPE_DOMAIN (mode2
))));
1655 tree cond
= build_compare_discrete_expr (EQ_EXPR
, count1
, count2
);
1656 if (TREE_CODE (cond
) == INTEGER_CST
)
1657 return !integer_zerop (cond
);
1661 extern int ignoring
;
1664 && current_function_decl
)
1674 for (t1
= TYPE_FIELDS (mode1
), t2
= TYPE_FIELDS (mode2
);
1675 t1
&& t2
; t1
= TREE_CHAIN (t1
), t2
= TREE_CHAIN (t2
))
1677 if (TREE_CODE (t1
) != TREE_CODE (t2
))
1679 /* Are the field modes equivalent? */
1680 if (integer_zerop (chill_equivalent (TREE_TYPE (t1
),
1688 if (!chill_l_equivalent (TREE_TYPE (mode1
), TREE_TYPE (mode2
), &node
))
1690 for (t1
= TYPE_ARG_TYPES (mode1
), t2
= TYPE_ARG_TYPES (mode2
);
1691 t1
!= NULL_TREE
&& t2
!= NULL_TREE
;
1692 t1
= TREE_CHAIN (t1
), t2
= TREE_CHAIN (t2
))
1694 tree attr1
= TREE_PURPOSE (t1
)
1695 ? TREE_PURPOSE (t1
) : ridpointers
[(int) RID_IN
];
1696 tree attr2
= TREE_PURPOSE (t2
)
1697 ? TREE_PURPOSE (t2
) : ridpointers
[(int) RID_IN
];
1700 if (!chill_l_equivalent (TREE_VALUE (t1
), TREE_VALUE (t2
), &node
))
1703 if (t1
!= t2
) /* Both NULL_TREE */
1705 /* check list of exception names */
1706 t1
= TYPE_RAISES_EXCEPTIONS (mode1
);
1707 t2
= TYPE_RAISES_EXCEPTIONS (mode2
);
1708 if (t1
== NULL_TREE
&& t2
!= NULL_TREE
)
1710 if (t1
!= NULL_TREE
&& t2
== NULL_TREE
)
1712 if (list_length (t1
) != list_length (t2
))
1714 while (t1
!= NULL_TREE
)
1716 if (value_member (TREE_VALUE (t1
), t2
) == NULL_TREE
)
1718 t1
= TREE_CHAIN (t1
);
1720 /* FIXME: Should also check they have the same RECURSIVITY */
1726 /* Need to handle row modes, instance modes,
1727 association modes, access modes, text modes,
1728 duration modes, absolute time modes, structure modes,
1729 parameterized structure modes */
1735 /* Return a node that is true iff MODE1 and MODE2 are equivalent.
1736 This is normally boolean_true_node or boolean_false_node,
1737 but can be dynamic for dynamic types.
1738 CHAIN is as for chill_similar. */
1741 chill_equivalent (mode1
, mode2
, chain
)
1743 struct mode_chain
*chain
;
1745 int varying1
, varying2
;
1746 int is_string1
, is_string2
;
1747 tree base_mode1
, base_mode2
;
1749 /* Are the modes v-equivalent? */
1751 if (!chill_similar (mode1
, mode2
, chain
)
1752 || CH_NOVELTY(mode1
) != CH_NOVELTY(mode2
))
1753 return boolean_false_node
;
1755 if (!chill_similar (mode1
, mode2
, chain
))
1756 return boolean_false_node
;
1757 else if (TREE_CODE (mode2
) == FUNCTION_TYPE
1758 && TREE_CODE (mode1
) == POINTER_TYPE
1759 && TREE_CODE (TREE_TYPE (mode1
)) == FUNCTION_TYPE
)
1760 /* don't check novelty in this case to avoid error in case of
1761 NEWMODE'd proceduremode gets assigned a function */
1762 return boolean_true_node
;
1763 else if (CH_NOVELTY(mode1
) != CH_NOVELTY(mode2
))
1764 return boolean_false_node
;
1766 varying1
= chill_varying_type_p (mode1
);
1767 varying2
= chill_varying_type_p (mode2
);
1769 if (varying1
!= varying2
)
1770 return boolean_false_node
;
1771 base_mode1
= varying1
? CH_VARYING_ARRAY_TYPE (mode1
) : mode1
;
1772 base_mode2
= varying2
? CH_VARYING_ARRAY_TYPE (mode2
) : mode2
;
1773 is_string1
= CH_STRING_TYPE_P (base_mode1
);
1774 is_string2
= CH_STRING_TYPE_P (base_mode2
);
1775 if (is_string1
|| is_string2
)
1777 if (is_string1
!= is_string2
)
1778 return boolean_false_node
;
1779 return fold (build (EQ_EXPR
, boolean_type_node
,
1780 TYPE_SIZE (base_mode1
),
1781 TYPE_SIZE (base_mode2
)));
1784 /* && some more stuff FIXME! */
1785 if (TREE_CODE(mode1
) == INTEGER_TYPE
|| TREE_CODE(mode2
) == INTEGER_TYPE
)
1787 if (TREE_CODE(mode1
) != INTEGER_TYPE
|| TREE_CODE(mode2
) != INTEGER_TYPE
)
1788 return boolean_false_node
;
1789 /* If one is a range, the other has to be a range. */
1790 if ((TREE_TYPE (mode1
) != NULL_TREE
) != (TREE_TYPE (mode2
) != NULL_TREE
))
1791 return boolean_false_node
;
1792 if (TYPE_PRECISION (mode1
) != TYPE_PRECISION (mode2
))
1793 return boolean_false_node
;
1794 if (!tree_int_cst_equal (TYPE_MIN_VALUE (mode1
), TYPE_MIN_VALUE (mode2
)))
1795 return boolean_false_node
;
1796 if (!tree_int_cst_equal (TYPE_MAX_VALUE (mode1
), TYPE_MAX_VALUE (mode2
)))
1797 return boolean_false_node
;
1799 return boolean_true_node
;
1803 chill_l_equivalent (mode1
, mode2
, chain
)
1805 struct mode_chain
*chain
;
1807 /* Are the modes equivalent? */
1808 if (integer_zerop (chill_equivalent (mode1
, mode2
, chain
)))
1810 if (TYPE_READONLY (mode1
) != TYPE_READONLY (mode2
))
1813 ... other conditions
...;
1818 /* See Z200 12.1.2.12 */
1821 chill_read_compatible (modeM
, modeN
)
1824 while (TREE_CODE (modeM
) == REFERENCE_TYPE
)
1825 modeM
= TREE_TYPE (modeM
);
1826 while (TREE_CODE (modeN
) == REFERENCE_TYPE
)
1827 modeN
= TREE_TYPE (modeN
);
1829 if (!CH_EQUIVALENT (modeM
, modeN
))
1831 if (TYPE_READONLY (modeN
))
1833 if (!TYPE_READONLY (modeM
))
1835 if (CH_IS_BOUND_REFERENCE_MODE (modeM
)
1836 && CH_IS_BOUND_REFERENCE_MODE (modeN
))
1838 return chill_l_equivalent (TREE_TYPE (modeM
), TREE_TYPE (modeN
), 0);
1847 /* Tests if MODE is compatible with the class of EXPR.
1848 Cfr. Chill Blue Book 12.1.2.15. */
1851 chill_compatible (expr
, mode
)
1854 struct ch_class
class;
1856 if (expr
== NULL_TREE
|| TREE_CODE (expr
) == ERROR_MARK
)
1858 if (mode
== NULL_TREE
|| TREE_CODE (mode
) == ERROR_MARK
)
1861 while (TREE_CODE (mode
) == REFERENCE_TYPE
)
1862 mode
= TREE_TYPE (mode
);
1864 if (TREE_TYPE (expr
) == NULL_TREE
)
1866 if (TREE_CODE (expr
) == CONSTRUCTOR
)
1867 return TREE_CODE (mode
) == RECORD_TYPE
1868 || ((TREE_CODE (mode
) == SET_TYPE
|| TREE_CODE (mode
) == ARRAY_TYPE
)
1869 && ! TYPE_STRING_FLAG (mode
));
1871 return TREE_CODE (expr
) == CASE_EXPR
|| TREE_CODE (expr
) == COND_EXPR
;
1874 class = chill_expr_class (expr
);
1880 return CH_IS_REFERENCE_MODE (mode
) || CH_IS_PROCEDURE_MODE (mode
)
1881 || CH_IS_INSTANCE_MODE (mode
);
1882 case CH_VALUE_CLASS
:
1883 if (CH_HAS_REFERENCING_PROPERTY (mode
))
1884 return CH_RESTRICTABLE_TO(mode
, class.mode
);
1886 return CH_V_EQUIVALENT(mode
, class.mode
);
1887 case CH_DERIVED_CLASS
:
1888 return CH_SIMILAR (class.mode
, mode
);
1889 case CH_REFERENCE_CLASS
:
1890 if (!CH_IS_REFERENCE_MODE (mode
))
1894 if (class.mode is a row mode
)
1896 else if (class.mode is
not a
static mode
)
1897 return 0; /* is this possible? FIXME */
1899 return !CH_IS_BOUND_REFERENCE_MODE(mode
)
1900 || CH_READ_COMPATIBLE (TREE_TYPE (mode
), class.mode
);
1902 return 0; /* ERROR! */
1905 /* Tests if the class of of EXPR1 and EXPR2 are compatible.
1906 Cfr. Chill Blue Book 12.1.2.16. */
1909 chill_compatible_classes (expr1
, expr2
)
1912 struct ch_class temp
;
1913 struct ch_class class1
, class2
;
1914 class1
= chill_expr_class (expr1
);
1915 class2
= chill_expr_class (expr2
);
1917 switch (class1
.kind
)
1922 switch (class2
.kind
)
1926 case CH_REFERENCE_CLASS
:
1928 case CH_VALUE_CLASS
:
1929 case CH_DERIVED_CLASS
:
1932 case CH_REFERENCE_CLASS
:
1933 switch (class2
.kind
)
1938 case CH_REFERENCE_CLASS
:
1939 return CH_EQUIVALENT (class1
.mode
, class2
.mode
);
1940 case CH_VALUE_CLASS
:
1942 case CH_DERIVED_CLASS
:
1945 case CH_DERIVED_CLASS
:
1946 switch (class2
.kind
)
1950 case CH_VALUE_CLASS
:
1951 case CH_DERIVED_CLASS
:
1952 return CH_SIMILAR (class1
.mode
, class2
.mode
);
1956 case CH_REFERENCE_CLASS
:
1959 case CH_VALUE_CLASS
:
1960 switch (class2
.kind
)
1964 case CH_DERIVED_CLASS
:
1965 return CH_SIMILAR (class1
.mode
, class2
.mode
);
1966 case CH_VALUE_CLASS
:
1967 return CH_V_EQUIVALENT (class1
.mode
, class2
.mode
);
1971 case CH_REFERENCE_CLASS
:
1972 temp
= class1
; class1
= class2
; class2
= temp
;
1977 /* The Null class is Compatible with the M-derived class or M-value class
1978 if and only if M is a reference mdoe, procedure mode or instance mode.*/
1979 return CH_IS_REFERENCE_MODE (class2
.mode
)
1980 || CH_IS_PROCEDURE_MODE (class2
.mode
)
1981 || CH_IS_INSTANCE_MODE (class2
.mode
);
1984 /* The M-reference class is compatible with the N-value class if and
1985 only if N is a reference mode and ... */
1986 if (!CH_IS_REFERENCE_MODE (class2
.mode
))
1988 if (1) /* If M is a static mode - FIXME */
1990 if (!CH_IS_BOUND_REFERENCE_MODE (class2
.mode
))
1992 if (CH_EQUIVALENT (TREE_TYPE (class2
.mode
), class1
.mode
))
1995 /* If N is a row mode whose .... FIXME */
1999 /* Cfr. Blue Book 12.1.1.6, with some "extensions." */
2002 chill_root_mode (mode
)
2005 /* Reference types are not user-visible types.
2006 This seems like a good place to get rid of them. */
2007 if (TREE_CODE (mode
) == REFERENCE_TYPE
)
2008 mode
= TREE_TYPE (mode
);
2010 while (TREE_CODE (mode
) == INTEGER_TYPE
&& TREE_TYPE (mode
) != NULL_TREE
)
2011 mode
= TREE_TYPE (mode
); /* a sub-range */
2013 /* This extension in not in the Blue Book - which only has a
2014 single Integer type.
2015 We should probably use chill_integer_type_node rather
2016 than integer_type_node, but that is likely to bomb.
2017 At some point, these will become the same, I hope. FIXME */
2018 if (TREE_CODE (mode
) == INTEGER_TYPE
2019 && TYPE_PRECISION (mode
) < TYPE_PRECISION (integer_type_node
)
2020 && CH_NOVELTY (mode
) == NULL_TREE
)
2021 mode
= integer_type_node
;
2023 if (TREE_CODE (mode
) == FUNCTION_TYPE
)
2024 return build_pointer_type (mode
);
2029 /* Cfr. Blue Book 12.1.1.7. */
2032 chill_resulting_mode (mode1
, mode2
)
2035 mode1
= CH_ROOT_MODE (mode1
);
2036 mode2
= CH_ROOT_MODE (mode2
);
2037 if (chill_varying_type_p (mode1
))
2039 if (chill_varying_type_p (mode2
))
2044 /* Cfr. Blue Book (z200, 1988) 12.1.1.7 Resulting class. */
2047 chill_resulting_class (class1
, class2
)
2048 struct ch_class class1
, class2
;
2050 struct ch_class
class;
2051 switch (class1
.kind
)
2053 case CH_VALUE_CLASS
:
2054 switch (class2
.kind
)
2056 case CH_DERIVED_CLASS
:
2058 class.kind
= CH_VALUE_CLASS
;
2059 class.mode
= CH_ROOT_MODE (class1
.mode
);
2061 case CH_VALUE_CLASS
:
2062 class.kind
= CH_VALUE_CLASS
;
2064 = CH_ROOT_MODE (CH_RESULTING_MODE (class1
.mode
, class2
.mode
));
2070 case CH_DERIVED_CLASS
:
2071 switch (class2
.kind
)
2073 case CH_VALUE_CLASS
:
2074 class.kind
= CH_VALUE_CLASS
;
2075 class.mode
= CH_ROOT_MODE (class2
.mode
);
2077 case CH_DERIVED_CLASS
:
2078 class.kind
= CH_DERIVED_CLASS
;
2079 class.mode
= CH_RESULTING_MODE (class1
.mode
, class2
.mode
);
2082 class.kind
= CH_DERIVED_CLASS
;
2083 class.mode
= CH_ROOT_MODE (class1
.mode
);
2090 switch (class2
.kind
)
2092 case CH_VALUE_CLASS
:
2093 class.kind
= CH_VALUE_CLASS
;
2094 class.mode
= CH_ROOT_MODE (class2
.mode
);
2097 class.kind
= CH_ALL_CLASS
;
2098 class.mode
= NULL_TREE
;
2100 case CH_DERIVED_CLASS
:
2101 class.kind
= CH_DERIVED_CLASS
;
2102 class.mode
= CH_ROOT_MODE (class2
.mode
);
2111 error ("internal error in chill_root_resulting_mode");
2112 class.kind
= CH_VALUE_CLASS
;
2113 class.mode
= CH_ROOT_MODE (class1
.mode
);
2119 * See Z.200, section 6.3, static conditions. This function
2120 * returns bool_false_node if the condition is not met at compile time,
2121 * bool_true_node if the condition is detectably met at compile time
2122 * an expression if a runtime check would be required or was generated.
2123 * It should only be called with string modes and values.
2126 string_assignment_condition (lhs_mode
, rhs_value
)
2127 tree lhs_mode
, rhs_value
;
2129 tree lhs_size
, rhs_size
, cond
;
2130 tree rhs_mode
= TREE_TYPE (rhs_value
);
2131 int lhs_varying
= chill_varying_type_p (lhs_mode
);
2134 lhs_size
= size_in_bytes (CH_VARYING_ARRAY_TYPE (lhs_mode
));
2135 else if (CH_BOOLS_TYPE_P (lhs_mode
))
2136 lhs_size
= TYPE_MAX_VALUE (TYPE_DOMAIN (lhs_mode
));
2138 lhs_size
= size_in_bytes (lhs_mode
);
2139 lhs_size
= convert (chill_unsigned_type_node
, lhs_size
);
2141 if (rhs_mode
&& TREE_CODE (rhs_mode
) == REFERENCE_TYPE
)
2142 rhs_mode
= TREE_TYPE (rhs_mode
);
2143 if (rhs_mode
== NULL_TREE
)
2145 /* actually, count constructor's length */
2148 else if (chill_varying_type_p (rhs_mode
))
2149 rhs_size
= build_component_ref (rhs_value
, var_length_id
);
2150 else if (CH_BOOLS_TYPE_P (rhs_mode
))
2151 rhs_size
= TYPE_MAX_VALUE (TYPE_DOMAIN (rhs_mode
));
2153 rhs_size
= size_in_bytes (rhs_mode
);
2154 rhs_size
= convert (chill_unsigned_type_node
, rhs_size
);
2156 /* validity condition */
2157 cond
= fold (build (lhs_varying
? GE_EXPR
: EQ_EXPR
,
2158 boolean_type_node
, lhs_size
, rhs_size
));
2163 * take a basic CHILL type and wrap it in a VARYING structure.
2164 * Be sure the length field is initialized. Return the wrapper.
2167 build_varying_struct (type
)
2170 tree decl1
, decl2
, result
;
2172 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
2173 return error_mark_node
;
2175 decl1
= build_decl (FIELD_DECL
, var_length_id
, chill_integer_type_node
);
2176 decl2
= build_decl (FIELD_DECL
, var_data_id
, type
);
2177 TREE_CHAIN (decl1
) = decl2
;
2178 TREE_CHAIN (decl2
) = NULL_TREE
;
2179 result
= build_chill_struct_type (decl1
);
2181 /* mark this so we don't complain about missing initializers.
2182 It's fine for a VARYING array to be partially initialized.. */
2183 C_TYPE_VARIABLE_SIZE(type
) = 1;
2189 * This is the struct type that forms the runtime initializer
2190 * list. There's at least one of these generated per module.
2191 * It's attached to the global initializer list by the module's
2192 * 'constructor' code. Should only be called in pass 2.
2195 build_init_struct ()
2197 tree decl1
, decl2
, result
;
2198 /* We temporarily reset the maximum_field_alignment to zero so the
2199 compiler's init data structures can be compatible with the
2200 run-time system, even when we're compiling with -fpack. */
2201 unsigned int save_maximum_field_alignment
= maximum_field_alignment
;
2202 maximum_field_alignment
= 0;
2204 decl1
= build_decl (FIELD_DECL
, get_identifier ("__INIT_ENTRY"),
2205 build_chill_pointer_type (
2206 build_function_type (void_type_node
, NULL_TREE
)));
2208 decl2
= build_decl (FIELD_DECL
, get_identifier ("__INIT_NEXT"),
2209 build_chill_pointer_type (void_type_node
));
2211 TREE_CHAIN (decl1
) = decl2
;
2212 TREE_CHAIN (decl2
) = NULL_TREE
;
2213 result
= build_chill_struct_type (decl1
);
2214 maximum_field_alignment
= save_maximum_field_alignment
;
2220 * Return 1 if the given type is a single-bit boolean set,
2221 * in which the domain's min and max values
2223 * 0 if not. This can become a macro later..
2226 ch_singleton_set (type
)
2229 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
2231 if (TREE_CODE (type
) != SET_TYPE
)
2233 if (TREE_TYPE (type
) == NULL_TREE
2234 || TREE_CODE (TREE_TYPE (type
)) != BOOLEAN_TYPE
)
2236 if (TYPE_DOMAIN (type
) == NULL_TREE
)
2238 if (! tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type
)),
2241 if (! tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type
)),
2247 /* return non-zero if TYPE is a compiler-generated VARYING
2248 array of some base type */
2250 chill_varying_type_p (type
)
2253 if (type
== NULL_TREE
)
2255 if (TREE_CODE (type
) != RECORD_TYPE
)
2257 if (TYPE_FIELDS (type
) == NULL_TREE
2258 || TREE_CHAIN (TYPE_FIELDS (type
)) == NULL_TREE
)
2260 if (DECL_NAME (TYPE_FIELDS (type
)) != var_length_id
)
2262 if (DECL_NAME (TREE_CHAIN (TYPE_FIELDS (type
))) != var_data_id
)
2264 if (TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (type
))) != NULL_TREE
)
2269 /* return non-zero if TYPE is a compiler-generated VARYING
2272 chill_varying_string_type_p (type
)
2277 if (!chill_varying_type_p (type
))
2280 var_data_type
= CH_VARYING_ARRAY_TYPE (type
);
2281 return CH_CHARS_TYPE_P (var_data_type
);
2284 /* swiped from c-typeck.c */
2285 /* Build an assignment expression of lvalue LHS from value RHS. */
2288 build_chill_modify_expr (lhs
, rhs
)
2291 register tree result
;
2294 tree lhstype
= TREE_TYPE (lhs
);
2296 /* Avoid duplicate error messages from operands that had errors. */
2297 if (lhs
== NULL_TREE
|| TREE_CODE (lhs
) == ERROR_MARK
|| rhs
== NULL_TREE
|| TREE_CODE (rhs
) == ERROR_MARK
)
2298 return error_mark_node
;
2300 /* Strip NON_LVALUE_EXPRs since we aren't using as an lvalue. */
2301 /* Do not use STRIP_NOPS here. We do not want an enumerator
2302 whose value is 0 to count as a null pointer constant. */
2303 if (TREE_CODE (rhs
) == NON_LVALUE_EXPR
)
2304 rhs
= TREE_OPERAND (rhs
, 0);
2307 /* Handle a cast used as an "lvalue".
2308 We have already performed any binary operator using the value as cast.
2309 Now convert the result to the cast type of the lhs,
2310 and then true type of the lhs and store it there;
2311 then convert result back to the cast type to be the value
2312 of the assignment. */
2314 switch (TREE_CODE (lhs
))
2319 case FIX_TRUNC_EXPR
:
2320 case FIX_FLOOR_EXPR
:
2321 case FIX_ROUND_EXPR
:
2324 tree inner_lhs
= TREE_OPERAND (lhs
, 0);
2326 result
= build_chill_modify_expr (inner_lhs
,
2327 convert (TREE_TYPE (inner_lhs
),
2328 convert (lhstype
, rhs
)));
2329 pedantic_lvalue_warning (CONVERT_EXPR
);
2330 return convert (TREE_TYPE (lhs
), result
);
2334 /* Now we have handled acceptable kinds of LHS that are not truly lvalues.
2335 Reject anything strange now. */
2337 if (!lvalue_or_else (lhs
, "assignment"))
2338 return error_mark_node
;
2340 /* FIXME: need to generate a RANGEFAIL if the RHS won't
2341 fit into the LHS. */
2343 if (TREE_CODE (lhs
) != VAR_DECL
2344 && ((TREE_CODE (TREE_TYPE (lhs
)) == ARRAY_TYPE
&&
2345 (TREE_TYPE (rhs
) && TREE_CODE (TREE_TYPE (rhs
)) == ARRAY_TYPE
)) ||
2346 chill_varying_type_p (TREE_TYPE (lhs
)) ||
2347 chill_varying_type_p (TREE_TYPE (rhs
))))
2349 int lhs_varying
= chill_varying_type_p (TREE_TYPE (lhs
));
2350 int rhs_varying
= chill_varying_type_p (TREE_TYPE (rhs
));
2352 /* point at actual RHS data's type */
2353 tree rhs_data_type
= rhs_varying
?
2354 CH_VARYING_ARRAY_TYPE (TREE_TYPE (rhs
)) :
2357 /* point at actual LHS data's type */
2358 tree lhs_data_type
= lhs_varying
?
2359 CH_VARYING_ARRAY_TYPE (TREE_TYPE (lhs
)) :
2362 int lhs_bytes
= int_size_in_bytes (lhs_data_type
);
2363 int rhs_bytes
= int_size_in_bytes (rhs_data_type
);
2365 /* if both sides not varying, and sizes not dynamically
2366 computed, sizes must *match* */
2367 if (! lhs_varying
&& ! rhs_varying
&& lhs_bytes
!= rhs_bytes
2368 && lhs_bytes
> 0 && rhs_bytes
> 0)
2370 error ("string lengths not equal");
2371 return error_mark_node
;
2373 /* Must have enough space on LHS for static size of RHS */
2375 if (lhs_bytes
> 0 && rhs_bytes
> 0
2376 && lhs_bytes
< rhs_bytes
)
2380 /* FIXME: generate runtime test for room */
2385 error ("can't do ARRAY assignment - too large");
2386 return error_mark_node
;
2391 /* now we know the RHS will fit in LHS, build trees for the
2392 emit_block_move parameters */
2395 rhs
= convert (TREE_TYPE (lhs
), rhs
);
2399 rhs
= build_component_ref (rhs
, var_data_id
);
2401 if (! mark_addressable (rhs
))
2403 error ("rhs of array assignment is not addressable");
2404 return error_mark_node
;
2407 lhs
= force_addr_of (lhs
);
2408 rhs
= build1 (ADDR_EXPR
, const_ptr_type_node
, rhs
);
2410 build_chill_function_call (lookup_name (get_identifier ("memmove")),
2411 tree_cons (NULL_TREE
, lhs
,
2412 tree_cons (NULL_TREE
, rhs
,
2413 tree_cons (NULL_TREE
, size_in_bytes (rhs_data_type
),
2418 result
= build (MODIFY_EXPR
, lhstype
, lhs
, rhs
);
2419 TREE_SIDE_EFFECTS (result
) = 1;
2424 /* Constructors for pointer, array and function types.
2425 (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
2426 constructed by language-dependent code, not here.) */
2428 /* Construct, lay out and return the type of pointers to TO_TYPE.
2429 If such a type has already been constructed, reuse it. */
2432 make_chill_pointer_type (to_type
, code
)
2434 enum tree_code code
; /* POINTER_TYPE or REFERENCE_TYPE */
2436 extern struct obstack
*current_obstack
;
2437 extern struct obstack
*saveable_obstack
;
2438 extern struct obstack permanent_obstack
;
2440 register struct obstack
*ambient_obstack
= current_obstack
;
2441 register struct obstack
*ambient_saveable_obstack
= saveable_obstack
;
2443 /* If TO_TYPE is permanent, make this permanent too. */
2444 if (TREE_PERMANENT (to_type
))
2446 current_obstack
= &permanent_obstack
;
2447 saveable_obstack
= &permanent_obstack
;
2450 t
= make_node (code
);
2451 TREE_TYPE (t
) = to_type
;
2453 current_obstack
= ambient_obstack
;
2454 saveable_obstack
= ambient_saveable_obstack
;
2460 build_chill_pointer_type (to_type
)
2463 int is_type_node
= TREE_CODE_CLASS (TREE_CODE (to_type
)) == 't';
2464 register tree t
= is_type_node
? TYPE_POINTER_TO (to_type
) : NULL_TREE
;
2466 /* First, if we already have a type for pointers to TO_TYPE, use it. */
2471 /* We need a new one. */
2472 t
= make_chill_pointer_type (to_type
, POINTER_TYPE
);
2474 /* Lay out the type. This function has many callers that are concerned
2475 with expression-construction, and this simplifies them all.
2476 Also, it guarantees the TYPE_SIZE is permanent if the type is. */
2477 if ((is_type_node
&& (TYPE_SIZE (to_type
) != NULL_TREE
))
2480 /* Record this type as the pointer to TO_TYPE. */
2481 TYPE_POINTER_TO (to_type
) = t
;
2489 build_chill_reference_type (to_type
)
2492 int is_type_node
= TREE_CODE_CLASS (TREE_CODE (to_type
)) == 't';
2493 register tree t
= is_type_node
? TYPE_REFERENCE_TO (to_type
) : NULL_TREE
;
2495 /* First, if we already have a type for references to TO_TYPE, use it. */
2500 /* We need a new one. */
2501 t
= make_chill_pointer_type (to_type
, REFERENCE_TYPE
);
2503 /* Lay out the type. This function has many callers that are concerned
2504 with expression-construction, and this simplifies them all.
2505 Also, it guarantees the TYPE_SIZE is permanent if the type is. */
2506 if ((is_type_node
&& (TYPE_SIZE (to_type
) != NULL_TREE
))
2509 /* Record this type as the reference to TO_TYPE. */
2510 TYPE_REFERENCE_TO (to_type
) = t
;
2512 CH_NOVELTY (t
) = CH_NOVELTY (to_type
);
2519 make_chill_range_type (type
, lowval
, highval
)
2520 tree type
, lowval
, highval
;
2522 register tree itype
= make_node (INTEGER_TYPE
);
2523 TREE_TYPE (itype
) = type
;
2524 TYPE_MIN_VALUE (itype
) = lowval
;
2525 TYPE_MAX_VALUE (itype
) = highval
;
2530 /* Return the minimum number of bits needed to represent VALUE in a
2531 signed or unsigned type, UNSIGNEDP says which. */
2534 min_precision (value
, unsignedp
)
2540 /* If the value is negative, compute its negative minus 1. The latter
2541 adjustment is because the absolute value of the largest negative value
2542 is one larger than the largest positive value. This is equivalent to
2543 a bit-wise negation, so use that operation instead. */
2545 if (tree_int_cst_sgn (value
) < 0)
2546 value
= fold (build1 (BIT_NOT_EXPR
, TREE_TYPE (value
), value
));
2548 /* Return the number of bits needed, taking into account the fact
2549 that we need one more bit for a signed than unsigned type. */
2551 if (integer_zerop (value
))
2554 log
= tree_floor_log2 (value
);
2556 return log
+ 1 + ! unsignedp
;
2560 layout_chill_range_type (rangetype
, must_be_const
)
2564 tree type
= TREE_TYPE (rangetype
);
2565 tree lowval
= TYPE_MIN_VALUE (rangetype
);
2566 tree highval
= TYPE_MAX_VALUE (rangetype
);
2569 if (TYPE_SIZE (rangetype
) != NULL_TREE
)
2573 if (type
== ridpointers
[(int) RID_BIN
])
2577 /* Make a range out of it */
2578 if (TREE_CODE (highval
) != INTEGER_CST
)
2580 error ("non-constant expression for BIN");
2581 return error_mark_node
;
2583 else if (tree_int_cst_sgn (highval
) < 0)
2585 error ("expression for BIN must not be negative");
2586 return error_mark_node
;
2588 else if (compare_tree_int (highval
, 32) > 0)
2590 error ("cannot process BIN (>32)");
2591 return error_mark_node
;
2594 binsize
= tree_low_cst (highval
, 1);
2595 type
= ridpointers
[(int) RID_RANGE
];
2596 lowval
= integer_zero_node
;
2597 highval
= build_int_2 ((1 << binsize
) - 1, 0);
2600 if (TREE_CODE (lowval
) == ERROR_MARK
2601 || TREE_CODE (highval
) == ERROR_MARK
)
2602 return error_mark_node
;
2604 if (!CH_COMPATIBLE_CLASSES (lowval
, highval
))
2606 error ("bounds of range are not compatible");
2607 return error_mark_node
;
2610 if (type
== string_index_type_dummy
)
2612 if (TREE_CODE (highval
) == INTEGER_CST
2613 && compare_int_csts (LT_EXPR
, highval
, integer_minus_one_node
))
2615 error ("negative string length");
2616 highval
= integer_minus_one_node
;
2618 if (compare_int_csts (EQ_EXPR
, highval
, integer_minus_one_node
))
2619 type
= integer_type_node
;
2622 TREE_TYPE (rangetype
) = type
;
2624 else if (type
== ridpointers
[(int) RID_RANGE
])
2626 /* This isn't 100% right, since the Blue Book definition
2627 uses Resulting Class, rather than Resulting Mode,
2628 but it's close enough. */
2629 type
= CH_ROOT_RESULTING_CLASS (lowval
, highval
).mode
;
2631 /* The default TYPE is the type of the constants -
2632 except if the constants are integers, we choose an
2633 integer type that fits. */
2634 if (TREE_CODE (type
) == INTEGER_TYPE
2635 && TREE_CODE (lowval
) == INTEGER_CST
2636 && TREE_CODE (highval
) == INTEGER_CST
)
2638 int unsignedp
= tree_int_cst_sgn (lowval
) >= 0;
2639 unsigned int precision
= MAX (min_precision (highval
, unsignedp
),
2640 min_precision (lowval
, unsignedp
));
2642 type
= type_for_size (precision
, unsignedp
);
2646 TREE_TYPE (rangetype
) = type
;
2650 if (!CH_COMPATIBLE (lowval
, type
))
2652 error ("range's lower bound and parent mode don't match");
2653 return integer_type_node
; /* an innocuous fake */
2655 if (!CH_COMPATIBLE (highval
, type
))
2657 error ("range's upper bound and parent mode don't match");
2658 return integer_type_node
; /* an innocuous fake */
2662 if (TREE_CODE (type
) == ERROR_MARK
)
2664 else if (TREE_CODE_CLASS (TREE_CODE (type
)) != 't')
2666 error ("making range from non-mode");
2667 return error_mark_node
;
2670 if (TREE_CODE (lowval
) == REAL_CST
|| TREE_CODE (highval
) == REAL_CST
)
2672 sorry ("floating point ranges");
2673 return integer_type_node
; /* another fake */
2676 if (TREE_CODE (lowval
) != INTEGER_CST
|| TREE_CODE (highval
) != INTEGER_CST
)
2680 error ("range mode has non-constant limits");
2684 else if (tree_int_cst_equal (lowval
, integer_zero_node
)
2685 && tree_int_cst_equal (highval
, integer_minus_one_node
))
2686 ; /* do nothing - this is the index type for an empty string */
2687 else if (compare_int_csts (LT_EXPR
, highval
, TYPE_MIN_VALUE (type
)))
2689 error ("range's high bound < mode's low bound");
2692 else if (compare_int_csts (GT_EXPR
, highval
, TYPE_MAX_VALUE (type
)))
2694 error ("range's high bound > mode's high bound");
2697 else if (compare_int_csts (LT_EXPR
, highval
, lowval
))
2699 error ("range mode high bound < range mode low bound");
2702 else if (compare_int_csts (LT_EXPR
, lowval
, TYPE_MIN_VALUE (type
)))
2704 error ("range's low bound < mode's low bound");
2707 else if (compare_int_csts (GT_EXPR
, lowval
, TYPE_MAX_VALUE (type
)))
2709 error ("range's low bound > mode's high bound");
2715 lowval
= TYPE_MIN_VALUE (type
);
2719 highval
= convert (type
, highval
);
2720 lowval
= convert (type
, lowval
);
2721 TYPE_MIN_VALUE (rangetype
) = lowval
;
2722 TYPE_MAX_VALUE (rangetype
) = highval
;
2723 TYPE_PRECISION (rangetype
) = TYPE_PRECISION (type
);
2724 TYPE_MODE (rangetype
) = TYPE_MODE (type
);
2725 TYPE_SIZE (rangetype
) = TYPE_SIZE (type
);
2726 TYPE_SIZE_UNIT (rangetype
) = TYPE_SIZE_UNIT (type
);
2727 TYPE_ALIGN (rangetype
) = TYPE_ALIGN (type
);
2728 TYPE_USER_ALIGN (rangetype
) = TYPE_USER_ALIGN (type
);
2729 TREE_UNSIGNED (rangetype
) = TREE_UNSIGNED (type
);
2730 CH_NOVELTY (rangetype
) = CH_NOVELTY (type
);
2734 /* Build a _TYPE node that has range bounds associated with its values.
2735 TYPE is the base type for the range type. */
2737 build_chill_range_type (type
, lowval
, highval
)
2738 tree type
, lowval
, highval
;
2742 if (type
== NULL_TREE
)
2743 type
= ridpointers
[(int) RID_RANGE
];
2744 else if (TREE_CODE (type
) == ERROR_MARK
)
2745 return error_mark_node
;
2747 rangetype
= make_chill_range_type (type
, lowval
, highval
);
2749 rangetype
= layout_chill_range_type (rangetype
, 0);
2754 /* Build a CHILL array type, but with minimal checking etc. */
2757 build_simple_array_type (type
, idx
, layout
)
2758 tree type
, idx
, layout
;
2760 tree array_type
= make_node (ARRAY_TYPE
);
2761 TREE_TYPE (array_type
) = type
;
2762 TYPE_DOMAIN (array_type
) = idx
;
2763 TYPE_ATTRIBUTES (array_type
) = layout
;
2765 array_type
= layout_chill_array_type (array_type
);
2770 apply_chill_array_layout (array_type
)
2773 tree layout
, temp
, what
, element_type
;
2774 HOST_WIDE_INT stepsize
= 0;
2775 HOST_WIDE_INT word
, start_bit
= 0, length
;
2776 HOST_WIDE_INT natural_length
;
2777 int stepsize_specified
;
2778 int start_bit_error
= 0;
2779 int length_error
= 0;
2781 layout
= TYPE_ATTRIBUTES (array_type
);
2782 if (layout
== NULL_TREE
)
2785 if (layout
== integer_zero_node
) /* NOPACK */
2787 TYPE_PACKED (array_type
) = 0;
2791 /* Allow for the packing of 1 bit discrete modes at the bit level. */
2792 element_type
= TREE_TYPE (array_type
);
2793 if (discrete_type_p (element_type
)
2794 && get_type_precision (TYPE_MIN_VALUE (element_type
),
2795 TYPE_MAX_VALUE (element_type
)) == 1)
2797 else if (host_integerp (TYPE_SIZE (element_type
), 1))
2798 natural_length
= tree_low_cst (TYPE_SIZE (element_type
), 1);
2800 natural_length
= -1;
2802 if (layout
== integer_one_node
) /* PACK */
2804 if (natural_length
== 1)
2805 TYPE_PACKED (array_type
) = 1;
2809 /* The layout is a STEP (...).
2810 The current implementation restricts STEP specifications to be of the form
2811 STEP(POS(0,0,n),n) where n is the natural size of the element mode. */
2812 stepsize_specified
= 0;
2813 temp
= TREE_VALUE (layout
);
2814 if (TREE_VALUE (temp
) != NULL_TREE
)
2816 if (! host_integerp (TREE_VALUE (temp
), 0))
2817 error ("Stepsize in STEP must be an integer constant");
2820 if (tree_int_cst_sgn (TREE_VALUE (temp
)) <= 0)
2821 error ("Stepsize in STEP must be > 0");
2823 stepsize_specified
= 1;
2825 stepsize
= tree_low_cst (TREE_VALUE (temp
), 1);
2826 if (stepsize
!= natural_length
)
2827 sorry ("Stepsize in STEP must be the natural width of the array element mode");
2831 temp
= TREE_PURPOSE (temp
);
2832 if (! host_integerp (TREE_PURPOSE (temp
), 0))
2833 error ("Starting word in POS must be an integer constant");
2836 if (tree_int_cst_sgn (TREE_PURPOSE (temp
)) < 0)
2837 error ("Starting word in POS must be >= 0");
2838 if (! integer_zerop (TREE_PURPOSE (temp
)))
2839 sorry ("Starting word in POS within STEP must be 0");
2841 word
= tree_low_cst (TREE_PURPOSE (temp
), 0);
2844 length
= natural_length
;
2845 temp
= TREE_VALUE (temp
);
2846 if (temp
!= NULL_TREE
)
2848 int wordsize
= TYPE_PRECISION (chill_integer_type_node
);
2849 if (! host_integerp (TREE_PURPOSE (temp
), 0))
2851 error ("Starting bit in POS must be an integer constant");
2852 start_bit_error
= 1;
2856 if (! integer_zerop (TREE_PURPOSE (temp
)))
2857 sorry ("Starting bit in POS within STEP must be 0");
2859 if (tree_int_cst_sgn (TREE_PURPOSE (temp
)) < 0)
2861 error ("Starting bit in POS must be >= 0");
2863 start_bit_error
= 1;
2866 start_bit
= tree_low_cst (TREE_PURPOSE (temp
), 0);
2867 if (start_bit
>= wordsize
)
2869 error ("Starting bit in POS must be < the width of a word");
2871 start_bit_error
= 1;
2875 temp
= TREE_VALUE (temp
);
2876 if (temp
!= NULL_TREE
)
2878 what
= TREE_PURPOSE (temp
);
2879 if (what
== integer_zero_node
)
2881 if (! host_integerp (TREE_VALUE (temp
), 0))
2883 error ("Length in POS must be an integer constant");
2888 length
= tree_low_cst (TREE_VALUE (temp
), 0);
2890 error ("Length in POS must be > 0");
2895 if (! host_integerp (TREE_VALUE (temp
), 0))
2897 error ("End bit in POS must be an integer constant");
2902 HOST_WIDE_INT end_bit
= tree_low_cst (TREE_VALUE (temp
), 0);
2904 if (end_bit
< start_bit
)
2906 error ("End bit in POS must be >= the start bit");
2907 end_bit
= wordsize
- 1;
2910 else if (end_bit
>= wordsize
)
2912 error ("End bit in POS must be < the width of a word");
2913 end_bit
= wordsize
- 1;
2916 else if (start_bit_error
)
2919 length
= end_bit
- start_bit
+ 1;
2923 if (! length_error
&& length
!= natural_length
)
2924 sorry ("The length specified on POS within STEP must be the natural length of the array element type");
2928 if (! length_error
&& stepsize_specified
&& stepsize
< length
)
2929 error ("Step size in STEP must be >= the length in POS");
2932 TYPE_PACKED (array_type
) = 1;
2936 layout_chill_array_type (array_type
)
2940 tree element_type
= TREE_TYPE (array_type
);
2942 if (TREE_CODE (element_type
) == ARRAY_TYPE
2943 && TYPE_SIZE (element_type
) == 0)
2944 layout_chill_array_type (element_type
);
2946 itype
= TYPE_DOMAIN (array_type
);
2948 if (TREE_CODE (itype
) == ERROR_MARK
2949 || TREE_CODE (element_type
) == ERROR_MARK
)
2950 return error_mark_node
;
2952 /* do a lower/upper bound check. */
2953 if (TREE_CODE (itype
) == INTEGER_CST
)
2955 error ("array index must be a range, not a single integer");
2956 return error_mark_node
;
2958 if (TREE_CODE_CLASS (TREE_CODE (itype
)) != 't'
2959 || !discrete_type_p (itype
))
2961 error ("array index is not a discrete mode");
2962 return error_mark_node
;
2965 /* apply the array layout, if specified. */
2966 apply_chill_array_layout (array_type
);
2967 TYPE_ATTRIBUTES (array_type
) = NULL_TREE
;
2969 /* Make sure TYPE_POINTER_TO (element_type) is filled in. */
2970 build_pointer_type (element_type
);
2972 if (TYPE_SIZE (array_type
) == 0)
2973 layout_type (array_type
);
2975 if (TYPE_READONLY_PROPERTY (element_type
))
2976 TYPE_FIELDS_READONLY (array_type
) = 1;
2978 TYPE_ARRAY_MAX_SIZE (array_type
) = size_in_bytes (array_type
);
2982 /* Build a CHILL array type.
2984 TYPE is the element type of the array.
2985 IDXLIST is the list of dimensions of the array.
2986 VARYING_P is non-zero if the array is a varying array.
2987 LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
2988 meaning (default, pack, nopack, STEP (...) ). */
2990 build_chill_array_type (type
, idxlist
, varying_p
, layouts
)
2995 tree array_type
= type
;
2997 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
2998 return error_mark_node
;
2999 if (idxlist
== NULL_TREE
|| TREE_CODE (idxlist
) == ERROR_MARK
)
3000 return error_mark_node
;
3002 /* We have to walk down the list of index decls, building inner
3003 array types as we go. We need to reverse the list of layouts so that the
3004 first layout applies to the last index etc. */
3005 layouts
= nreverse (layouts
);
3006 for ( ; idxlist
; idxlist
= TREE_CHAIN (idxlist
))
3008 if (layouts
!= NULL_TREE
)
3010 type
= build_simple_array_type (
3011 type
, TREE_VALUE (idxlist
), TREE_VALUE (layouts
));
3012 layouts
= TREE_CHAIN (layouts
);
3015 type
= build_simple_array_type (type
, TREE_VALUE (idxlist
), NULL_TREE
);
3019 array_type
= build_varying_struct (array_type
);
3023 /* Function to help qsort sort FIELD_DECLs by name order. */
3026 field_decl_cmp (x
, y
)
3029 return (long)DECL_NAME (*x
) - (long)DECL_NAME (*y
);
3033 make_chill_struct_type (fieldlist
)
3038 t
= make_node (TREE_UNION_ELEM (fieldlist
) ? UNION_TYPE
: RECORD_TYPE
);
3040 /* Install struct as DECL_CONTEXT of each field decl. */
3041 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3042 DECL_CONTEXT (x
) = t
;
3044 /* Delete all duplicate fields from the fieldlist */
3045 for (x
= fieldlist
; x
&& TREE_CHAIN (x
);)
3046 /* Anonymous fields aren't duplicates. */
3047 if (DECL_NAME (TREE_CHAIN (x
)) == 0)
3051 register tree y
= fieldlist
;
3055 if (DECL_NAME (y
) == DECL_NAME (TREE_CHAIN (x
)))
3061 if (DECL_NAME (y
) == DECL_NAME (TREE_CHAIN (x
)))
3063 error_with_decl (TREE_CHAIN (x
), "duplicate member `%s'");
3064 TREE_CHAIN (x
) = TREE_CHAIN (TREE_CHAIN (x
));
3066 else x
= TREE_CHAIN (x
);
3069 TYPE_FIELDS (t
) = fieldlist
;
3074 /* DECL is a FIELD_DECL.
3076 (NULL_TREE, integer_one_node, integer_zero_node, tree_list)
3078 (default, pack, nopack, POS (...) ).
3080 The return value is a boolean: 1 if POS specified, 0 if not */
3083 apply_chill_field_layout (decl
, next_struct_offset
)
3085 int *next_struct_offset
;
3087 tree layout
= DECL_INITIAL (decl
);
3088 tree type
= TREE_TYPE (decl
);
3090 HOST_WIDE_INT word
= 0;
3091 HOST_WIDE_INT wordsize
, start_bit
, offset
, length
, natural_length
;
3093 int is_discrete
= discrete_type_p (type
);
3097 = get_type_precision (TYPE_MIN_VALUE (type
), TYPE_MAX_VALUE (type
));
3098 else if (host_integerp (TYPE_SIZE (type
), 1))
3099 natural_length
= tree_low_cst (TYPE_SIZE (type
), 1);
3101 natural_length
= -1;
3103 if (layout
== integer_zero_node
) /* NOPACK */
3105 *next_struct_offset
+= natural_length
;
3106 return 0; /* not POS */
3109 if (layout
== integer_one_node
) /* PACK */
3113 DECL_BIT_FIELD (decl
) = 1;
3114 DECL_SIZE (decl
) = bitsize_int (natural_length
);
3118 DECL_ALIGN (decl
) = BITS_PER_UNIT
;
3119 DECL_USER_ALIGN (decl
) = 0;
3122 DECL_PACKED (decl
) = 1;
3123 *next_struct_offset
+= natural_length
;
3124 return 0; /* not POS */
3127 /* The layout is a POS (...). The current implementation restricts the use
3128 of POS to monotonically increasing fields whose width must be the
3129 natural width of the underlying type. */
3130 temp
= TREE_PURPOSE (layout
);
3132 if (! host_integerp (TREE_PURPOSE (temp
), 0))
3134 error ("Starting word in POS must be an integer constant");
3139 if (tree_int_cst_sgn (TREE_PURPOSE (temp
)) < 0)
3141 error ("Starting word in POS must be >= 0");
3146 word
= tree_low_cst (TREE_PURPOSE (temp
), 0);
3149 wordsize
= TYPE_PRECISION (chill_integer_type_node
);
3150 offset
= word
* wordsize
;
3151 length
= natural_length
;
3153 temp
= TREE_VALUE (temp
);
3154 if (temp
!= NULL_TREE
)
3156 if (! host_integerp (TREE_PURPOSE (temp
), 0))
3158 error ("Starting bit in POS must be an integer constant");
3159 start_bit
= *next_struct_offset
- offset
;
3164 if (tree_int_cst_sgn (TREE_PURPOSE (temp
)) < 0)
3166 error ("Starting bit in POS must be >= 0");
3167 start_bit
= *next_struct_offset
- offset
;
3171 start_bit
= tree_low_cst (TREE_PURPOSE (temp
), 0);
3172 if (start_bit
>= wordsize
)
3174 error ("Starting bit in POS must be < the width of a word");
3175 start_bit
= *next_struct_offset
- offset
;
3180 temp
= TREE_VALUE (temp
);
3181 if (temp
!= NULL_TREE
)
3183 what
= TREE_PURPOSE (temp
);
3184 if (what
== integer_zero_node
)
3186 if (! host_integerp (TREE_VALUE (temp
), 0))
3188 error ("Length in POS must be an integer constant");
3193 if (tree_int_cst_sgn (TREE_VALUE (temp
)) < 0)
3195 error ("Length in POS must be > 0");
3196 length
= natural_length
;
3200 length
= tree_low_cst (TREE_VALUE (temp
), 0);
3206 if (! host_integerp (TREE_VALUE (temp
), 0))
3208 error ("End bit in POS must be an integer constant");
3213 HOST_WIDE_INT end_bit
= tree_low_cst (TREE_VALUE (temp
), 0);
3215 if (end_bit
< start_bit
)
3217 error ("End bit in POS must be >= the start bit");
3220 else if (end_bit
>= wordsize
)
3222 error ("End bit in POS must be < the width of a word");
3226 length
= end_bit
- start_bit
+ 1;
3230 if (length
!= natural_length
&& ! pos_error
)
3232 sorry ("The length specified on POS must be the natural length of the field type");
3233 length
= natural_length
;
3237 offset
+= start_bit
;
3240 if (offset
!= *next_struct_offset
&& ! pos_error
)
3241 sorry ("STRUCT fields must be layed out in monotonically increasing order");
3243 DECL_PACKED (decl
) = 1;
3244 DECL_BIT_FIELD (decl
) = is_discrete
;
3247 DECL_SIZE (decl
) = bitsize_int (length
);
3249 *next_struct_offset
+= natural_length
;
3251 return 1; /* was POS */
3255 layout_chill_struct_type (t
)
3258 tree fieldlist
= TYPE_FIELDS (t
);
3264 int next_struct_offset
;
3266 old_momentary
= suspend_momentary ();
3268 /* Process specified field sizes. */
3269 next_struct_offset
= 0;
3270 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3272 /* An EVENT or BUFFER mode is implemented as a RECORD_TYPE
3273 which may contain a CONST_DECL for the maximum queue size. */
3274 if (TREE_CODE (x
) == CONST_DECL
)
3277 /* If any field is const, the structure type is pseudo-const. */
3278 /* A field that is pseudo-const makes the structure likewise. */
3279 if (TREE_READONLY (x
) || TYPE_READONLY_PROPERTY (TREE_TYPE (x
)))
3280 TYPE_FIELDS_READONLY (t
) = 1;
3282 /* Any field that is volatile means variables of this type must be
3283 treated in some ways as volatile. */
3284 if (TREE_THIS_VOLATILE (x
))
3285 C_TYPE_FIELDS_VOLATILE (t
) = 1;
3287 if (DECL_INITIAL (x
) != NULL_TREE
)
3289 was_pos
= apply_chill_field_layout (x
, &next_struct_offset
);
3290 DECL_INITIAL (x
) = NULL_TREE
;
3294 unsigned int min_align
= TYPE_ALIGN (TREE_TYPE (x
));
3295 DECL_ALIGN (x
) = MAX (DECL_ALIGN (x
), min_align
);
3298 if ((! was_pos
&& pos_seen
) || (was_pos
&& ! pos_seen
&& x
!= fieldlist
))
3300 pos_seen
|= was_pos
;
3304 error ("If one field has a POS layout, then all fields must have a POS layout");
3306 /* Now DECL_INITIAL is null on all fields. */
3310 /* Now we have the truly final field list.
3311 Store it in this type and in the variants. */
3313 TYPE_FIELDS (t
) = fieldlist
;
3315 /* If there are lots of fields, sort so we can look through them fast.
3316 We arbitrarily consider 16 or more elts to be "a lot". */
3320 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3331 len
+= list_length (x
);
3332 /* Use the same allocation policy here that make_node uses, to
3333 ensure that this lives as long as the rest of the struct decl.
3334 All decls in an inline function need to be saved. */
3335 if (allocation_temporary_p ())
3336 space
= savealloc (sizeof (struct lang_type
) + len
* sizeof (tree
));
3338 space
= oballoc (sizeof (struct lang_type
) + len
* sizeof (tree
));
3340 TYPE_LANG_SPECIFIC (t
) = (struct lang_type
*) space
;
3341 TYPE_LANG_SPECIFIC (t
)->foo
.rec
.len
= len
;
3343 field_array
= &TYPE_LANG_SPECIFIC (t
)->foo
.rec
.elts
[0];
3345 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3346 field_array
[len
++] = x
;
3348 qsort (field_array
, len
, sizeof (tree
),
3349 (int (*) PARAMS ((const void *, const void *))) field_decl_cmp
);
3353 for (x
= TYPE_MAIN_VARIANT (t
); x
; x
= TYPE_NEXT_VARIANT (x
))
3355 TYPE_FIELDS (x
) = TYPE_FIELDS (t
);
3356 TYPE_LANG_SPECIFIC (x
) = TYPE_LANG_SPECIFIC (t
);
3357 TYPE_ALIGN (x
) = TYPE_ALIGN (t
);
3358 TYPE_USER_ALIGN (x
) = TYPE_USER_ALIGN (t
);
3361 resume_momentary (old_momentary
);
3366 /* Given a list of fields, FIELDLIST, return a structure
3367 type that contains these fields. The returned type is
3368 always a new type. */
3370 build_chill_struct_type (fieldlist
)
3375 if (fieldlist
== NULL_TREE
|| TREE_CODE (fieldlist
) == ERROR_MARK
)
3376 return error_mark_node
;
3378 t
= make_chill_struct_type (fieldlist
);
3380 t
= layout_chill_struct_type (t
);
3382 /* pushtag (NULL_TREE, t); */
3387 /* Fix a LANG_TYPE. These are used for three different uses:
3388 - representing a 'READ M' (in which case TYPE_READONLY is set);
3389 - for a NEWMODE or SYNMODE (CH_NOVELTY is set for a NEWMODE); and
3390 - for a parameterised type (TREE_TYPE points to base type,
3391 while TYPE_DOMAIN is the parameter or parameter list).
3392 Called from satisfy. */
3394 smash_dummy_type (type
)
3397 /* Save fields that we don't want to copy from ORIGIN. */
3398 tree origin
= TREE_TYPE (type
);
3399 tree main_tree
= TYPE_MAIN_VARIANT (origin
);
3400 int save_uid
= TYPE_UID (type
);
3401 struct obstack
*save_obstack
= TYPE_OBSTACK (type
);
3402 tree save_name
= TYPE_NAME (type
);
3403 int save_permanent
= TREE_PERMANENT (type
);
3404 int save_readonly
= TYPE_READONLY (type
);
3405 tree save_novelty
= CH_NOVELTY (type
);
3406 tree save_domain
= TYPE_DOMAIN (type
);
3408 if (origin
== NULL_TREE
)
3413 if (TREE_CODE (save_domain
) == ERROR_MARK
)
3414 return error_mark_node
;
3415 if (origin
== char_type_node
)
3416 { /* Old-fashioned CHAR(N) declaration. */
3417 origin
= build_string_type (origin
, save_domain
);
3420 { /* Handle parameterised modes. */
3421 int is_varying
= chill_varying_type_p (origin
);
3422 tree new_max
= save_domain
;
3423 tree origin_novelty
= CH_NOVELTY (origin
);
3425 origin
= CH_VARYING_ARRAY_TYPE (origin
);
3426 if (CH_STRING_TYPE_P (origin
))
3428 tree oldindex
= TYPE_DOMAIN (origin
);
3429 new_max
= check_range (new_max
, new_max
, NULL_TREE
,
3430 fold (build (PLUS_EXPR
, integer_type_node
,
3431 TYPE_MAX_VALUE (oldindex
),
3432 integer_one_node
)));
3433 origin
= build_string_type (TREE_TYPE (origin
), new_max
);
3435 else if (TREE_CODE (origin
) == ARRAY_TYPE
)
3437 tree oldindex
= TYPE_DOMAIN (origin
);
3438 tree upper
= check_range (new_max
, new_max
, NULL_TREE
,
3439 TYPE_MAX_VALUE (oldindex
));
3441 = build_chill_range_type (TREE_TYPE (oldindex
),
3442 TYPE_MIN_VALUE (oldindex
), upper
);
3443 origin
= build_simple_array_type (TREE_TYPE (origin
), newindex
, NULL_TREE
);
3445 else if (TREE_CODE (origin
) == RECORD_TYPE
)
3447 error ("parameterised structures not implemented");
3448 return error_mark_node
;
3452 error ("invalid parameterised type");
3453 return error_mark_node
;
3456 SET_CH_NOVELTY (origin
, origin_novelty
);
3459 origin
= build_varying_struct (origin
);
3460 SET_CH_NOVELTY (origin
, origin_novelty
);
3463 save_domain
= NULL_TREE
;
3466 if (TREE_CODE (origin
) == ERROR_MARK
)
3467 return error_mark_node
;
3469 *(struct tree_type
*)type
= *(struct tree_type
*)origin
;
3470 /* The following is so that the debug code for
3471 the copy is different from the original type.
3472 The two statements usually duplicate each other
3473 (because they clear fields of the same union),
3474 but the optimizer should catch that. */
3475 TYPE_SYMTAB_POINTER (type
) = 0;
3476 TYPE_SYMTAB_ADDRESS (type
) = 0;
3478 /* Restore fields that we didn't want copied from ORIGIN. */
3479 TYPE_UID (type
) = save_uid
;
3480 TYPE_OBSTACK (type
) = save_obstack
;
3481 TREE_PERMANENT (type
) = save_permanent
;
3482 TYPE_NAME (type
) = save_name
;
3484 TREE_CHAIN (type
) = NULL_TREE
;
3485 TYPE_VOLATILE (type
) = 0;
3486 TYPE_POINTER_TO (type
) = 0;
3487 TYPE_REFERENCE_TO (type
) = 0;
3490 { /* TYPE is READ ORIGIN.
3491 Add this type to the chain of variants of TYPE. */
3492 TYPE_NEXT_VARIANT (type
) = TYPE_NEXT_VARIANT (main_tree
);
3493 TYPE_NEXT_VARIANT (main_tree
) = type
;
3494 TYPE_READONLY (type
) = save_readonly
;
3498 /* TYPE is the copy of the RHS in a NEWMODE or SYNMODE.
3499 We also get here after old-fashioned CHAR(N) declaration (see above). */
3500 TYPE_MAIN_VARIANT (type
) = type
;
3501 TYPE_NEXT_VARIANT (type
) = NULL_TREE
;
3503 DECL_ORIGINAL_TYPE (save_name
) = origin
;
3505 if (save_novelty
!= NULL_TREE
) /* A NEWMODE declaration. */
3507 CH_NOVELTY (type
) = save_novelty
;
3509 /* Z.200: "If the DEFINING mode of the NEWMODE name is a range mode,
3510 then the virtual mode &name is introduced as the PARENT mode
3511 of the NEWMODE name. The DEFINING mode of &name is the PARENT
3512 mode of the range mode, and the NOVELTY of &name is that of
3513 the NEWMODE name." */
3515 if (TREE_CODE (type
) == INTEGER_TYPE
&& TREE_TYPE (type
))
3518 /* PARENT is the virtual mode &name mentioned above. */
3519 push_obstacks_nochange ();
3520 end_temporary_allocation ();
3521 parent
= copy_novelty (save_novelty
,TREE_TYPE (type
));
3524 TREE_TYPE (type
) = parent
;
3525 TYPE_MIN_VALUE (type
) = convert (parent
, TYPE_MIN_VALUE (type
));
3526 TYPE_MAX_VALUE (type
) = convert (parent
, TYPE_MAX_VALUE (type
));
3533 /* This generates a LANG_TYPE node that represents 'READ TYPE'. */
3536 build_readonly_type (type
)
3539 tree node
= make_node (LANG_TYPE
);
3540 TREE_TYPE (node
) = type
;
3541 TYPE_READONLY (node
) = 1;
3543 node
= smash_dummy_type (node
);
3548 /* Return an unsigned type the same as TYPE in other respects. */
3551 unsigned_type (type
)
3554 tree type1
= TYPE_MAIN_VARIANT (type
);
3555 if (type1
== signed_char_type_node
|| type1
== char_type_node
)
3556 return unsigned_char_type_node
;
3557 if (type1
== integer_type_node
)
3558 return unsigned_type_node
;
3559 if (type1
== short_integer_type_node
)
3560 return short_unsigned_type_node
;
3561 if (type1
== long_integer_type_node
)
3562 return long_unsigned_type_node
;
3563 if (type1
== long_long_integer_type_node
)
3564 return long_long_unsigned_type_node
;
3566 return signed_or_unsigned_type (1, type
);
3569 /* Return a signed type the same as TYPE in other respects. */
3575 tree type1
= TYPE_MAIN_VARIANT (type
);
3576 while (TREE_CODE (type1
) == INTEGER_TYPE
&& TREE_TYPE (type1
) != NULL_TREE
)
3577 type1
= TREE_TYPE (type1
);
3578 if (type1
== unsigned_char_type_node
|| type1
== char_type_node
)
3579 return signed_char_type_node
;
3580 if (type1
== unsigned_type_node
)
3581 return integer_type_node
;
3582 if (type1
== short_unsigned_type_node
)
3583 return short_integer_type_node
;
3584 if (type1
== long_unsigned_type_node
)
3585 return long_integer_type_node
;
3586 if (type1
== long_long_unsigned_type_node
)
3587 return long_long_integer_type_node
;
3588 if (TYPE_PRECISION (type1
) == 1)
3589 return signed_boolean_type_node
;
3591 return signed_or_unsigned_type (0, type
);
3594 /* Return a type the same as TYPE except unsigned or
3595 signed according to UNSIGNEDP. */
3598 signed_or_unsigned_type (unsignedp
, type
)
3602 if (! INTEGRAL_TYPE_P (type
)
3603 || TREE_UNSIGNED (type
) == unsignedp
)
3606 if (TYPE_PRECISION (type
) == TYPE_PRECISION (signed_char_type_node
))
3607 return unsignedp
? unsigned_char_type_node
: signed_char_type_node
;
3608 if (TYPE_PRECISION (type
) == TYPE_PRECISION (integer_type_node
))
3609 return unsignedp
? unsigned_type_node
: integer_type_node
;
3610 if (TYPE_PRECISION (type
) == TYPE_PRECISION (short_integer_type_node
))
3611 return unsignedp
? short_unsigned_type_node
: short_integer_type_node
;
3612 if (TYPE_PRECISION (type
) == TYPE_PRECISION (long_integer_type_node
))
3613 return unsignedp
? long_unsigned_type_node
: long_integer_type_node
;
3614 if (TYPE_PRECISION (type
) == TYPE_PRECISION (long_long_integer_type_node
))
3615 return (unsignedp
? long_long_unsigned_type_node
3616 : long_long_integer_type_node
);
3620 /* Mark EXP saying that we need to be able to take the
3621 address of it; it should not be allocated in a register.
3622 Value is 1 if successful. */
3625 mark_addressable (exp
)
3628 register tree x
= exp
;
3630 switch (TREE_CODE (x
))
3637 x
= TREE_OPERAND (x
, 0);
3640 case TRUTH_ANDIF_EXPR
:
3641 case TRUTH_ORIF_EXPR
:
3643 x
= TREE_OPERAND (x
, 1);
3647 return mark_addressable (TREE_OPERAND (x
, 1))
3648 & mark_addressable (TREE_OPERAND (x
, 2));
3651 TREE_ADDRESSABLE (x
) = 1;
3655 /* We sometimes add a cast *(TYPE*)&FOO to handle type and mode
3656 incompatibility problems. Handle this case by marking FOO. */
3657 if (TREE_CODE (TREE_OPERAND (x
, 0)) == NOP_EXPR
3658 && TREE_CODE (TREE_OPERAND (TREE_OPERAND (x
, 0), 0)) == ADDR_EXPR
)
3660 x
= TREE_OPERAND (TREE_OPERAND (x
, 0), 0);
3663 if (TREE_CODE (TREE_OPERAND (x
, 0)) == ADDR_EXPR
)
3665 x
= TREE_OPERAND (x
, 0);
3674 if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
)
3675 && DECL_NONLOCAL (x
))
3677 if (TREE_PUBLIC (x
))
3679 error ("global register variable `%s' used in nested function",
3680 IDENTIFIER_POINTER (DECL_NAME (x
)));
3683 pedwarn ("register variable `%s' used in nested function",
3684 IDENTIFIER_POINTER (DECL_NAME (x
)));
3686 else if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
))
3688 if (TREE_PUBLIC (x
))
3690 error ("address of global register variable `%s' requested",
3691 IDENTIFIER_POINTER (DECL_NAME (x
)));
3695 /* If we are making this addressable due to its having
3696 volatile components, give a different error message. Also
3697 handle the case of an unnamed parameter by not trying
3698 to give the name. */
3700 else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x
)))
3702 error ("cannot put object with volatile field into register");
3706 pedwarn ("address of register variable `%s' requested",
3707 IDENTIFIER_POINTER (DECL_NAME (x
)));
3709 put_var_into_stack (x
);
3713 TREE_ADDRESSABLE (x
) = 1;
3714 #if 0 /* poplevel deals with this now. */
3715 if (DECL_CONTEXT (x
) == 0)
3716 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x
)) = 1;
3724 /* Return an integer type with BITS bits of precision,
3725 that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
3728 type_for_size (bits
, unsignedp
)
3732 if (bits
== TYPE_PRECISION (integer_type_node
))
3733 return unsignedp
? unsigned_type_node
: integer_type_node
;
3735 if (bits
== TYPE_PRECISION (signed_char_type_node
))
3736 return unsignedp
? unsigned_char_type_node
: signed_char_type_node
;
3738 if (bits
== TYPE_PRECISION (short_integer_type_node
))
3739 return unsignedp
? short_unsigned_type_node
: short_integer_type_node
;
3741 if (bits
== TYPE_PRECISION (long_integer_type_node
))
3742 return unsignedp
? long_unsigned_type_node
: long_integer_type_node
;
3744 if (bits
== TYPE_PRECISION (long_long_integer_type_node
))
3745 return (unsignedp
? long_long_unsigned_type_node
3746 : long_long_integer_type_node
);
3748 if (bits
<= TYPE_PRECISION (intQI_type_node
))
3749 return unsignedp
? unsigned_intQI_type_node
: intQI_type_node
;
3751 if (bits
<= TYPE_PRECISION (intHI_type_node
))
3752 return unsignedp
? unsigned_intHI_type_node
: intHI_type_node
;
3754 if (bits
<= TYPE_PRECISION (intSI_type_node
))
3755 return unsignedp
? unsigned_intSI_type_node
: intSI_type_node
;
3757 if (bits
<= TYPE_PRECISION (intDI_type_node
))
3758 return unsignedp
? unsigned_intDI_type_node
: intDI_type_node
;
3760 #if HOST_BITS_PER_WIDE_INT >= 64
3761 if (bits
<= TYPE_PRECISION (intTI_type_node
))
3762 return unsignedp
? unsigned_intTI_type_node
: intTI_type_node
;
3768 /* Return a data type that has machine mode MODE.
3769 If the mode is an integer,
3770 then UNSIGNEDP selects between signed and unsigned types. */
3773 type_for_mode (mode
, unsignedp
)
3774 enum machine_mode mode
;
3777 if ((int)mode
== (int)TYPE_MODE (integer_type_node
))
3778 return unsignedp
? unsigned_type_node
: integer_type_node
;
3780 if ((int)mode
== (int)TYPE_MODE (signed_char_type_node
))
3781 return unsignedp
? unsigned_char_type_node
: signed_char_type_node
;
3783 if ((int)mode
== (int)TYPE_MODE (short_integer_type_node
))
3784 return unsignedp
? short_unsigned_type_node
: short_integer_type_node
;
3786 if ((int)mode
== (int)TYPE_MODE (long_integer_type_node
))
3787 return unsignedp
? long_unsigned_type_node
: long_integer_type_node
;
3789 if ((int)mode
== (int)TYPE_MODE (long_long_integer_type_node
))
3790 return unsignedp
? long_long_unsigned_type_node
: long_long_integer_type_node
;
3792 if ((int)mode
== (int)TYPE_MODE (intQI_type_node
))
3793 return unsignedp
? unsigned_intQI_type_node
: intQI_type_node
;
3795 if ((int)mode
== (int)TYPE_MODE (intHI_type_node
))
3796 return unsignedp
? unsigned_intHI_type_node
: intHI_type_node
;
3798 if ((int)mode
== (int)TYPE_MODE (intSI_type_node
))
3799 return unsignedp
? unsigned_intSI_type_node
: intSI_type_node
;
3801 if ((int)mode
== (int)TYPE_MODE (intDI_type_node
))
3802 return unsignedp
? unsigned_intDI_type_node
: intDI_type_node
;
3804 #if HOST_BITS_PER_WIDE_INT >= 64
3805 if ((int)mode
== (int)TYPE_MODE (intTI_type_node
))
3806 return unsignedp
? unsigned_intTI_type_node
: intTI_type_node
;
3809 if ((int)mode
== (int)TYPE_MODE (float_type_node
))
3810 return float_type_node
;
3812 if ((int)mode
== (int)TYPE_MODE (double_type_node
))
3813 return double_type_node
;
3815 if ((int)mode
== (int)TYPE_MODE (long_double_type_node
))
3816 return long_double_type_node
;
3818 if ((int)mode
== (int)TYPE_MODE (build_pointer_type (char_type_node
)))
3819 return build_pointer_type (char_type_node
);
3821 if ((int)mode
== (int)TYPE_MODE (build_pointer_type (integer_type_node
)))
3822 return build_pointer_type (integer_type_node
);