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 tree make_chill_range_type
PARAMS ((tree
, tree
, tree
));
50 static void apply_chill_array_layout
PARAMS ((tree
));
51 static int field_decl_cmp
PARAMS ((tree
*, tree
*));
52 static tree make_chill_struct_type
PARAMS ((tree
));
53 static int apply_chill_field_layout
PARAMS ((tree
, int *));
56 * This function checks an array access.
57 * It calls error (ERROR_MESSAGE) if the condition (index <= domain max value
58 * index >= domain min value)
59 * is not met at compile time,
60 * If a runtime test is required and permitted,
61 * check_expression is used to do so.
62 * the global RANGE_CHECKING flags controls the
63 * generation of runtime checking code.
66 valid_array_index_p (array
, idx
, error_message
, is_varying_lhs
)
68 const char *error_message
;
71 tree cond
, low_limit
, high_cond
, atype
, domain
;
72 tree orig_index
= idx
;
73 enum chill_tree_code condition
;
75 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
76 || idx
== NULL_TREE
|| TREE_CODE (idx
) == ERROR_MARK
)
77 return error_mark_node
;
79 if (TREE_CODE (idx
) == TYPE_DECL
80 || TREE_CODE_CLASS (TREE_CODE (idx
)) == 't')
82 error ("array or string index is a mode (instead of a value)");
83 return error_mark_node
;
86 atype
= TREE_TYPE (array
);
88 if (chill_varying_type_p (atype
))
90 domain
= TYPE_DOMAIN (CH_VARYING_ARRAY_TYPE (atype
));
91 high_cond
= build_component_ref (array
, var_length_id
);
92 if (chill_varying_string_type_p (atype
))
104 domain
= TYPE_DOMAIN (atype
);
105 high_cond
= TYPE_MAX_VALUE (domain
);
109 if (CH_STRING_TYPE_P (atype
))
111 if (! CH_SIMILAR (TREE_TYPE (orig_index
), integer_type_node
))
113 error ("index is not an integer expression");
114 return error_mark_node
;
119 if (! CH_COMPATIBLE (orig_index
, domain
))
121 error ("index not compatible with index mode");
122 return error_mark_node
;
126 /* Convert BOOLS(1) to BOOL and CHARS(1) to CHAR. */
127 if (flag_old_strings
)
129 idx
= convert_to_discrete (idx
);
130 if (idx
== NULL
) /* should never happen */
131 error ("index is not discrete");
134 /* we know we'll refer to this value twice */
136 idx
= save_expr (idx
);
138 low_limit
= TYPE_MIN_VALUE (domain
);
139 high_cond
= build_compare_discrete_expr (condition
, idx
, high_cond
);
141 /* an invalid index expression meets this condition */
142 cond
= fold (build (TRUTH_ORIF_EXPR
, boolean_type_node
,
143 build_compare_discrete_expr (LT_EXPR
, idx
, low_limit
),
146 /* strip a redundant NOP_EXPR */
147 if (TREE_CODE (cond
) == NOP_EXPR
148 && TREE_TYPE (cond
) == boolean_type_node
149 && TREE_CODE (TREE_OPERAND (cond
, 0)) == INTEGER_CST
)
150 cond
= TREE_OPERAND (cond
, 0);
152 idx
= convert (CH_STRING_TYPE_P (atype
) ? integer_type_node
: domain
,
155 if (TREE_CODE (cond
) == INTEGER_CST
)
157 if (tree_int_cst_equal (cond
, boolean_false_node
))
158 return idx
; /* condition met at compile time */
159 error ("%s", error_message
); /* condition failed at compile time */
160 return error_mark_node
;
162 else if (range_checking
)
164 /* FIXME: often, several of these conditions will
165 be generated for the same source file and line number.
166 A great optimization would be to share the
167 cause_exception function call among them rather
168 than generating a cause_exception call for each. */
169 return check_expression (idx
, cond
,
170 ridpointers
[(int) RID_RANGEFAIL
]);
173 return idx
; /* don't know at compile time */
177 * Extract a slice from an array, which could look like a
178 * SET_TYPE if it's a bitstring. The array could also be VARYING
179 * if the element type is CHAR. The min_value and length values
180 * must have already been checked with valid_array_index_p. No
181 * checking is done here.
184 build_chill_slice (array
, min_value
, length
)
185 tree array
, min_value
, length
;
188 tree array_type
= TREE_TYPE (array
);
190 if (!CH_REFERABLE (array
) && TREE_CODE (array
) != SAVE_EXPR
191 && (TREE_CODE (array
) != COMPONENT_REF
192 || TREE_CODE (TREE_OPERAND (array
, 0)) != SAVE_EXPR
))
194 if (!TREE_CONSTANT (array
))
195 warning ("possible internal error - slice argument is neither referable nor constant");
199 NOTE: This could mean multiple identical copies of
200 the same constant. FIXME. */
201 tree mydecl
= decl_temp1 (get_unique_identifier("SLICEE"),
202 array_type
, 1, array
, 0, 0);
203 TREE_READONLY (mydecl
) = 1;
204 /* mark_addressable (mydecl); FIXME: necessary? */
210 The code-generation which uses a slice tree needs not only to
211 know the dynamic upper and lower limits of that slice, but the
212 original static allocation, to use to build temps where one or both
213 of the dynamic limits must be calculated at runtime.. We pass the
214 dynamic size by building a new array_type whose limits are the
215 min_value and min_value + length values passed to us.
217 The static allocation info is passed by using the parent array's
218 limits to compute a temp_size, which is passed in the lang_specific
219 field of the slice_type. */
221 if (TREE_CODE (array_type
) == ARRAY_TYPE
)
223 tree domain_type
= TYPE_DOMAIN (array_type
);
224 tree domain_min
= TYPE_MIN_VALUE (domain_type
);
226 = fold (build (PLUS_EXPR
, domain_type
,
228 fold (build (MINUS_EXPR
, integer_type_node
,
229 length
, integer_one_node
))));
230 tree index_type
= build_chill_range_type (TYPE_DOMAIN (array_type
),
234 tree element_type
= TREE_TYPE (array_type
);
235 tree slice_type
= build_simple_array_type (element_type
, index_type
, NULL_TREE
);
236 tree slice_pointer_type
;
239 if (CH_CHARS_TYPE_P (array_type
))
240 MARK_AS_STRING_TYPE (slice_type
);
242 TYPE_PACKED (slice_type
) = TYPE_PACKED (array_type
);
244 SET_CH_NOVELTY (slice_type
, CH_NOVELTY (array_type
));
246 if (TREE_CONSTANT (array
) && TREE_CODE (min_value
) == INTEGER_CST
247 && TREE_CODE (length
) == INTEGER_CST
)
249 int type_size
= int_size_in_bytes (array_type
);
250 unsigned char *buffer
= (unsigned char*) alloca (type_size
);
251 int delta
= int_size_in_bytes (element_type
)
252 * (TREE_INT_CST_LOW (min_value
) - TREE_INT_CST_LOW (domain_min
));
253 bzero (buffer
, type_size
);
254 if (expand_constant_to_buffer (array
, buffer
, type_size
))
256 result
= extract_constant_from_buffer (slice_type
,
264 /* Kludge used by case CONCAT_EXPR in chill_expand_expr.
265 Set TYPE_ARRAY_MAX_SIZE to a constant upper bound on the
267 max_size
= size_in_bytes (slice_type
);
268 if (TREE_CODE (max_size
) != INTEGER_CST
)
270 max_size
= TYPE_ARRAY_MAX_SIZE (array_type
);
271 if (max_size
== NULL_TREE
)
272 max_size
= size_in_bytes (array_type
);
274 TYPE_ARRAY_MAX_SIZE (slice_type
) = max_size
;
276 mark_addressable (array
);
277 /* Contruct a SLICE_EXPR to represent a slice of a packed array of bits. */
278 if (TYPE_PACKED (array_type
))
280 if (pass
== 2 && TREE_CODE (length
) != INTEGER_CST
)
282 sorry ("bit array slice with non-constant length");
283 return error_mark_node
;
285 if (domain_min
&& ! integer_zerop (domain_min
))
286 min_value
= size_binop (MINUS_EXPR
, min_value
,
287 convert (sizetype
, domain_min
));
288 result
= build (SLICE_EXPR
, slice_type
, array
, min_value
, length
);
289 TREE_READONLY (result
)
290 = TREE_READONLY (array
) | TYPE_READONLY (TREE_TYPE (array_type
));
294 slice_pointer_type
= build_chill_pointer_type (slice_type
);
295 if (TREE_CODE (min_value
) == INTEGER_CST
296 && domain_min
&& TREE_CODE (domain_min
) == INTEGER_CST
297 && compare_int_csts (EQ_EXPR
, min_value
, domain_min
))
298 result
= fold (build1 (ADDR_EXPR
, slice_pointer_type
, array
));
301 min_value
= convert (sizetype
, min_value
);
302 if (domain_min
&& ! integer_zerop (domain_min
))
303 min_value
= size_binop (MINUS_EXPR
, min_value
,
304 convert (sizetype
, domain_min
));
305 min_value
= size_binop (MULT_EXPR
, min_value
,
306 size_in_bytes (element_type
));
307 result
= fold (build (PLUS_EXPR
, slice_pointer_type
,
308 build1 (ADDR_EXPR
, slice_pointer_type
,
310 convert (slice_pointer_type
, min_value
)));
312 /* Return the final array value. */
313 result
= fold (build1 (INDIRECT_REF
, slice_type
, result
));
314 TREE_READONLY (result
)
315 = TREE_READONLY (array
) | TYPE_READONLY (element_type
);
318 else if (TREE_CODE (array_type
) == SET_TYPE
) /* actually a bitstring */
320 if (pass
== 2 && TREE_CODE (length
) != INTEGER_CST
)
322 sorry ("bitstring slice with non-constant length");
323 return error_mark_node
;
325 result
= build (SLICE_EXPR
, build_bitstring_type (length
),
326 array
, min_value
, length
);
327 TREE_READONLY (result
)
328 = TREE_READONLY (array
) | TYPE_READONLY (TREE_TYPE (array_type
));
331 else if (chill_varying_type_p (array_type
))
332 return build_chill_slice (varying_to_slice (array
), min_value
, length
);
335 error ("slice operation on non-array, non-bitstring value not supported");
336 return error_mark_node
;
341 build_empty_string (type
)
344 int orig_pass
= pass
;
347 range
= build_chill_range_type (type
, integer_zero_node
,
348 integer_minus_one_node
);
349 result
= build_chill_array_type (type
,
350 tree_cons (NULL_TREE
, range
, NULL_TREE
), 0, NULL_TREE
);
352 range
= build_chill_range_type (type
, integer_zero_node
,
353 integer_minus_one_node
);
354 result
= build_chill_array_type (type
,
355 tree_cons (NULL_TREE
, range
, NULL_TREE
), 0, NULL_TREE
);
358 return decl_temp1 (get_unique_identifier ("EMPTY_STRING"),
359 result
, 0, NULL_TREE
, 0, 0);
362 /* We build the runtime range-checking as a separate list
363 * rather than making a compound_expr with min_value
364 * (for example), to control when that comparison gets
365 * generated. We cannot allow it in a TYPE_MAX_VALUE or
366 * TYPE_MIN_VALUE expression, for instance, because that code
367 * will get generated when the slice is laid out, which would
368 * put it outside the scope of an exception handler for the
369 * statement we're generating. I.e. we would be generating
370 * cause_exception calls which might execute before the
371 * necessary ch_link_handler call.
374 build_chill_slice_with_range (array
, min_value
, max_value
)
375 tree array
, min_value
, max_value
;
377 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
378 || min_value
== NULL_TREE
|| TREE_CODE(min_value
) == ERROR_MARK
379 || max_value
== NULL_TREE
|| TREE_CODE(max_value
) == ERROR_MARK
)
380 return error_mark_node
;
382 if (TREE_TYPE (array
) == NULL_TREE
383 || (TREE_CODE (TREE_TYPE (array
)) != ARRAY_TYPE
384 && TREE_CODE (TREE_TYPE (array
)) != SET_TYPE
385 && !chill_varying_type_p (TREE_TYPE (array
))))
387 error ("can only take slice of array or string");
388 return error_mark_node
;
391 array
= save_if_needed (array
);
393 /* FIXME: test here for max_value >= min_value, except
394 for max_value == -1, min_value == 0 (empty string) */
395 min_value
= valid_array_index_p (array
, min_value
,
396 "slice lower limit out-of-range", 0);
397 if (TREE_CODE (min_value
) == ERROR_MARK
)
400 /* FIXME: suppress this test if max_value is the LENGTH of a
401 varying array, which has presumably already been checked. */
402 max_value
= valid_array_index_p (array
, max_value
,
403 "slice upper limit out-of-range", 0);
404 if (TREE_CODE (max_value
) == ERROR_MARK
)
405 return error_mark_node
;
407 if (TREE_CODE (min_value
) == INTEGER_CST
408 && TREE_CODE (max_value
) == INTEGER_CST
409 && tree_int_cst_lt (max_value
, min_value
))
410 return build_empty_string (TREE_TYPE (TREE_TYPE (array
)));
415 save_expr (fold (build (PLUS_EXPR
, integer_type_node
,
416 fold (build (MINUS_EXPR
, integer_type_node
,
417 max_value
, min_value
)),
418 integer_one_node
))));
422 build_chill_slice_with_length (array
, min_value
, length
)
423 tree array
, min_value
, length
;
426 tree cond
, high_cond
, atype
;
428 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
429 || min_value
== NULL_TREE
|| TREE_CODE(min_value
) == ERROR_MARK
430 || length
== NULL_TREE
|| TREE_CODE(length
) == ERROR_MARK
)
431 return error_mark_node
;
433 if (TREE_TYPE (array
) == NULL_TREE
434 || (TREE_CODE (TREE_TYPE (array
)) != ARRAY_TYPE
435 && TREE_CODE (TREE_TYPE (array
)) != SET_TYPE
436 && !chill_varying_type_p (TREE_TYPE (array
))))
438 error ("can only take slice of array or string");
439 return error_mark_node
;
442 if (TREE_CONSTANT (length
)
443 && tree_int_cst_lt (length
, integer_zero_node
))
444 return build_empty_string (TREE_TYPE (TREE_TYPE (array
)));
446 array
= save_if_needed (array
);
447 min_value
= save_expr (min_value
);
448 length
= save_expr (length
);
450 if (! CH_SIMILAR (TREE_TYPE (length
), integer_type_node
))
452 error ("slice length is not an integer");
453 length
= integer_one_node
;
456 max_index
= fold (build (MINUS_EXPR
, integer_type_node
,
457 fold (build (PLUS_EXPR
, integer_type_node
,
460 max_index
= convert_to_class (chill_expr_class (min_value
), max_index
);
462 min_value
= valid_array_index_p (array
, min_value
,
463 "slice start index out-of-range", 0);
464 if (TREE_CODE (min_value
) == ERROR_MARK
)
465 return error_mark_node
;
467 atype
= TREE_TYPE (array
);
469 if (chill_varying_type_p (atype
))
470 high_cond
= build_component_ref (array
, var_length_id
);
472 high_cond
= TYPE_MAX_VALUE (TYPE_DOMAIN (atype
));
474 /* an invalid index expression meets this condition */
475 cond
= fold (build (TRUTH_ORIF_EXPR
, boolean_type_node
,
476 build_compare_discrete_expr (LT_EXPR
,
477 length
, integer_zero_node
),
478 build_compare_discrete_expr (GT_EXPR
,
479 max_index
, high_cond
)));
481 if (TREE_CODE (cond
) == INTEGER_CST
)
483 if (! tree_int_cst_equal (cond
, boolean_false_node
))
485 error ("slice length out-of-range");
486 return error_mark_node
;
490 else if (range_checking
)
492 min_value
= check_expression (min_value
, cond
,
493 ridpointers
[(int) RID_RANGEFAIL
]);
496 return build_chill_slice (array
, min_value
, length
);
500 build_chill_array_ref (array
, indexlist
)
501 tree array
, indexlist
;
505 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
)
506 return error_mark_node
;
507 if (indexlist
== NULL_TREE
|| TREE_CODE (indexlist
) == ERROR_MARK
)
508 return error_mark_node
;
510 idx
= TREE_VALUE (indexlist
); /* handle first index */
512 idx
= valid_array_index_p (array
, idx
,
513 "array index out-of-range", 0);
514 if (TREE_CODE (idx
) == ERROR_MARK
)
515 return error_mark_node
;
517 array
= build_chill_array_ref_1 (array
, idx
);
519 if (array
&& TREE_CODE (array
) != ERROR_MARK
520 && TREE_CHAIN (indexlist
))
522 /* Z.200 (1988) section 4.2.8 says that:
523 <array> '(' <expression {',' <expression> }* ')'
524 is derived syntax (i.e. syntactic sugar) for:
525 <array> '(' <expression ')' { '(' <expression> ')' }*
526 The intent is clear if <array> has mode: ARRAY (...) ARRAY (...) XXX.
527 But what if <array> has mode: ARRAY (...) CHARS (N)
528 or: ARRAY (...) BOOLS (N).
529 Z.200 doesn't explicitly prohibit it, but the intent is unclear.
530 We'll allow it, since it seems reasonable and useful.
531 However, we won't allow it if <array> is:
532 ARRAY (...) PROC (...).
533 (The latter would make sense if we allowed general
534 Currying, which Chill doesn't.) */
535 if (TREE_CODE (TREE_TYPE (array
)) == ARRAY_TYPE
536 || chill_varying_type_p (TREE_TYPE (array
))
537 || CH_BOOLS_TYPE_P (TREE_TYPE (array
)))
538 array
= build_generalized_call (array
, TREE_CHAIN (indexlist
));
540 error ("too many index expressions");
546 * Don't error check the index in here. It's supposed to be
547 * checked by the caller.
550 build_chill_array_ref_1 (array
, idx
)
557 if (array
== NULL_TREE
|| TREE_CODE (array
) == ERROR_MARK
558 || idx
== NULL_TREE
|| TREE_CODE (idx
) == ERROR_MARK
)
559 return error_mark_node
;
561 if (chill_varying_type_p (TREE_TYPE (array
)))
562 array
= varying_to_slice (array
);
564 domain
= TYPE_DOMAIN (TREE_TYPE (array
));
567 if (! integer_zerop (TYPE_MIN_VALUE (domain
)))
569 /* The C part of the compiler doesn't understand how to do
570 arithmetic with dissimilar enum types. So we check compatability
571 here, and perform the math in INTEGER_TYPE. */
572 if (TREE_CODE (TREE_TYPE (idx
)) == ENUMERAL_TYPE
573 && chill_comptypes (TREE_TYPE (idx
), domain
, 0))
574 idx
= convert (TREE_TYPE (TYPE_MIN_VALUE (domain
)), idx
);
575 idx
= build_binary_op (MINUS_EXPR
, idx
, TYPE_MIN_VALUE (domain
), 0);
579 if (CH_STRING_TYPE_P (TREE_TYPE (array
)))
581 /* Could be bitstring or char string. */
582 if (TREE_TYPE (TREE_TYPE (array
)) == boolean_type_node
)
584 rval
= build (SET_IN_EXPR
, boolean_type_node
, idx
, array
);
585 TREE_READONLY (rval
) = TREE_READONLY (array
);
590 if (!discrete_type_p (TREE_TYPE (idx
)))
592 error ("array index is not discrete");
593 return error_mark_node
;
596 /* An array that is indexed by a non-constant
597 cannot be stored in a register; we must be able to do
598 address arithmetic on its address.
599 Likewise an array of elements of variable size. */
600 if (TREE_CODE (idx
) != INTEGER_CST
601 || (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array
))) != 0
602 && TREE_CODE (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array
)))) != INTEGER_CST
))
604 if (mark_addressable (array
) == 0)
605 return error_mark_node
;
608 type
= TREE_TYPE (TREE_TYPE (array
));
610 /* Do constant folding */
611 if (TREE_CODE (idx
) == INTEGER_CST
&& TREE_CONSTANT (array
))
613 struct ch_class
class;
614 class.kind
= CH_VALUE_CLASS
;
617 if (TREE_CODE (array
) == CONSTRUCTOR
)
619 tree list
= CONSTRUCTOR_ELTS (array
);
620 for ( ; list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
622 if (tree_int_cst_equal (TREE_PURPOSE (list
), idx
))
623 return convert_to_class (class, TREE_VALUE (list
));
626 else if (TREE_CODE (array
) == STRING_CST
627 && CH_CHARS_TYPE_P (TREE_TYPE (array
)))
629 HOST_WIDE_INT i
= TREE_INT_CST_LOW (idx
);
630 if (i
>= 0 && i
< TREE_STRING_LENGTH (array
))
632 char ch
= TREE_STRING_POINTER (array
) [i
];
633 return convert_to_class (class,
634 build_int_2 ((unsigned char)ch
, 0));
639 if (TYPE_PACKED (TREE_TYPE (array
)))
640 rval
= build (PACKED_ARRAY_REF
, type
, array
, idx
);
642 rval
= build (ARRAY_REF
, type
, array
, idx
);
644 /* Array ref is const/volatile if the array elements are
645 or if the array is. */
646 TREE_READONLY (rval
) = TREE_READONLY (array
) | TYPE_READONLY (type
);
647 TREE_SIDE_EFFECTS (rval
)
648 |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array
)))
649 | TREE_SIDE_EFFECTS (array
));
650 TREE_THIS_VOLATILE (rval
)
651 |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array
)))
652 /* This was added by rms on 16 Nov 91.
653 It fixes vol struct foo *a; a->elts[1]
654 in an inline function.
655 Hope it doesn't break something else. */
656 | TREE_THIS_VOLATILE (array
));
661 build_chill_bitref (bitstring
, indexlist
)
662 tree bitstring
, indexlist
;
664 if (TREE_CODE (bitstring
) == ERROR_MARK
)
666 if (TREE_CODE (indexlist
) == ERROR_MARK
)
669 if (TREE_CHAIN (indexlist
) != NULL_TREE
)
671 error ("invalid compound index for bitstring mode");
672 return error_mark_node
;
675 if (TREE_CODE (indexlist
) == TREE_LIST
)
677 tree result
= build (SET_IN_EXPR
, boolean_type_node
,
678 TREE_VALUE (indexlist
), bitstring
);
679 TREE_READONLY (result
) = TREE_READONLY (bitstring
);
687 discrete_type_p (type
)
690 return INTEGRAL_TYPE_P (type
);
693 /* Checks that EXP has discrete type, or can be converted to discrete.
694 Otherwise, returns NULL_TREE.
695 Normally returns the (possibly-converted) EXP. */
698 convert_to_discrete (exp
)
701 if (! discrete_type_p (TREE_TYPE (exp
)))
703 if (flag_old_strings
)
705 if (CH_CHARS_ONE_P (TREE_TYPE (exp
)))
706 return convert (char_type_node
, exp
);
707 if (CH_BOOLS_ONE_P (TREE_TYPE (exp
)))
708 return convert (boolean_type_node
, exp
);
715 /* Write into BUFFER the target-machine representation of VALUE.
716 Returns 1 on success, or 0 on failure. (Either the VALUE was
717 not constant, or we don't know how to do the conversion.) */
720 expand_constant_to_buffer (value
, buffer
, buf_size
)
722 unsigned char *buffer
;
725 tree type
= TREE_TYPE (value
);
726 int size
= int_size_in_bytes (type
);
728 if (size
< 0 || size
> buf_size
)
730 switch (TREE_CODE (value
))
734 HOST_WIDE_INT lo
= TREE_INT_CST_LOW (value
);
735 HOST_WIDE_INT hi
= TREE_INT_CST_HIGH (value
);
736 for (i
= 0; i
< size
; i
++)
738 /* Doesn't work if host and target BITS_PER_UNIT differ. */
739 unsigned char byte
= lo
& ((1 << BITS_PER_UNIT
) - 1);
740 if (BYTES_BIG_ENDIAN
)
741 buffer
[size
- i
- 1] = byte
;
744 rshift_double (lo
, hi
, BITS_PER_UNIT
, BITS_PER_UNIT
* size
,
751 size
= TREE_STRING_LENGTH (value
);
754 bcopy (TREE_STRING_POINTER (value
), buffer
, size
);
758 if (TREE_CODE (type
) == ARRAY_TYPE
)
760 tree element_type
= TREE_TYPE (type
);
761 int element_size
= int_size_in_bytes (element_type
);
762 tree list
= CONSTRUCTOR_ELTS (value
);
763 HOST_WIDE_INT next_index
;
764 HOST_WIDE_INT min_index
= 0;
765 if (element_size
< 0)
768 if (TYPE_DOMAIN (type
) != 0)
770 tree min_val
= TYPE_MIN_VALUE (TYPE_DOMAIN (type
));
773 if (TREE_CODE (min_val
) != INTEGER_CST
)
776 min_index
= TREE_INT_CST_LOW (min_val
);
780 next_index
= min_index
;
782 for (; list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
784 HOST_WIDE_INT offset
;
785 HOST_WIDE_INT last_index
;
786 tree purpose
= TREE_PURPOSE (list
);
789 if (TREE_CODE (purpose
) == INTEGER_CST
)
790 last_index
= next_index
= TREE_INT_CST_LOW (purpose
);
791 else if (TREE_CODE (purpose
) == RANGE_EXPR
)
793 next_index
= TREE_INT_CST_LOW (TREE_OPERAND(purpose
, 0));
794 last_index
= TREE_INT_CST_LOW (TREE_OPERAND(purpose
, 1));
800 last_index
= next_index
;
801 for ( ; next_index
<= last_index
; next_index
++)
803 offset
= (next_index
- min_index
) * element_size
;
804 if (!expand_constant_to_buffer (TREE_VALUE (list
),
812 else if (TREE_CODE (type
) == RECORD_TYPE
)
814 tree list
= CONSTRUCTOR_ELTS (value
);
815 for (; list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
817 tree field
= TREE_PURPOSE (list
);
818 HOST_WIDE_INT offset
;
819 if (field
== NULL_TREE
|| TREE_CODE (field
) != FIELD_DECL
)
821 if (DECL_BIT_FIELD (field
))
823 offset
= TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field
))
825 if (!expand_constant_to_buffer (TREE_VALUE (list
),
832 else if (TREE_CODE (type
) == SET_TYPE
)
834 if (get_set_constructor_bytes (value
, buffer
, buf_size
)
845 /* Given that BUFFER contains a target-machine representation of
846 a value of type TYPE, return that value as a tree.
847 Returns NULL_TREE on failure. (E.g. the TYPE might be variable size,
848 or perhaps we don't know how to do the conversion.) */
851 extract_constant_from_buffer (type
, buffer
, buf_size
)
853 const unsigned char *buffer
;
857 int size
= int_size_in_bytes (type
);
859 if (size
< 0 || size
> buf_size
)
861 switch (TREE_CODE (type
))
869 HOST_WIDE_INT lo
= 0, hi
= 0;
870 /* Accumulate (into (lo,hi) the bytes (from buffer). */
871 for (i
= size
; --i
>= 0; )
874 /* Get next byte (in big-endian order). */
875 if (BYTES_BIG_ENDIAN
)
876 byte
= buffer
[size
- i
- 1];
879 lshift_double (lo
, hi
, BITS_PER_UNIT
, TYPE_PRECISION (type
),
881 add_double (lo
, hi
, byte
, 0, &lo
, &hi
);
883 value
= build_int_2 (lo
, hi
);
884 TREE_TYPE (value
) = type
;
889 tree element_type
= TREE_TYPE (type
);
890 int element_size
= int_size_in_bytes (element_type
);
891 tree list
= NULL_TREE
;
892 HOST_WIDE_INT min_index
= 0, max_index
, cur_index
;
893 if (element_size
== 1 && CH_CHARS_TYPE_P (type
))
895 value
= build_string (size
, buffer
);
896 CH_DERIVED_FLAG (value
) = 1;
897 TREE_TYPE (value
) = type
;
900 if (TYPE_DOMAIN (type
) == 0)
902 value
= TYPE_MIN_VALUE (TYPE_DOMAIN (type
));
905 if (TREE_CODE (value
) != INTEGER_CST
)
908 min_index
= TREE_INT_CST_LOW (value
);
910 value
= TYPE_MAX_VALUE (TYPE_DOMAIN (type
));
911 if (value
== NULL_TREE
|| TREE_CODE (value
) != INTEGER_CST
)
914 max_index
= TREE_INT_CST_LOW (value
);
915 for (cur_index
= max_index
; cur_index
>= min_index
; cur_index
--)
917 HOST_WIDE_INT offset
= (cur_index
- min_index
) * element_size
;
918 value
= extract_constant_from_buffer (element_type
,
921 if (value
== NULL_TREE
)
923 list
= tree_cons (build_int_2 (cur_index
, 0), value
, list
);
925 value
= build (CONSTRUCTOR
, type
, NULL_TREE
, list
);
926 TREE_CONSTANT (value
) = 1;
927 TREE_STATIC (value
) = 1;
932 tree list
= NULL_TREE
;
933 tree field
= TYPE_FIELDS (type
);
934 for (; field
!= NULL_TREE
; field
= TREE_CHAIN (field
))
937 = TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field
)) / BITS_PER_UNIT
;
938 if (DECL_BIT_FIELD (field
))
940 value
= extract_constant_from_buffer (TREE_TYPE (field
),
943 if (value
== NULL_TREE
)
945 list
= tree_cons (field
, value
, list
);
947 value
= build (CONSTRUCTOR
, type
, NULL_TREE
, nreverse (list
));
948 TREE_CONSTANT (value
) = 1;
949 TREE_STATIC (value
) = 1;
955 tree longest_variant
= NULL_TREE
;
956 int longest_size
= 0;
957 tree field
= TYPE_FIELDS (type
);
959 /* This is a kludge. We assume that converting the data to te
960 longest variant will provide valid data for the "correct"
961 variant. This is usually the case, but is not guaranteed.
962 For example, the longest variant may include holes.
963 Also incorrect interpreting the given value as the longest
964 variant may confuse the compiler if that should happen
965 to yield invalid values. ??? */
967 for (; field
!= NULL_TREE
; field
= TREE_CHAIN (field
))
969 int size
= TREE_INT_CST_LOW (size_in_bytes (TREE_TYPE (field
)));
971 if (size
> longest_size
)
974 longest_variant
= field
;
977 if (longest_variant
== NULL_TREE
)
979 return extract_constant_from_buffer (TREE_TYPE (longest_variant
), buffer
, buf_size
);
984 tree list
= NULL_TREE
;
986 HOST_WIDE_INT min_index
, max_index
;
987 if (TYPE_DOMAIN (type
) == 0)
989 value
= TYPE_MIN_VALUE (TYPE_DOMAIN (type
));
990 if (value
== NULL_TREE
)
992 else if (TREE_CODE (value
) != INTEGER_CST
)
995 min_index
= TREE_INT_CST_LOW (value
);
996 value
= TYPE_MAX_VALUE (TYPE_DOMAIN (type
));
997 if (value
== NULL_TREE
)
999 else if (TREE_CODE (value
) != INTEGER_CST
)
1002 max_index
= TREE_INT_CST_LOW (value
);
1003 for (i
= max_index
+ 1 - min_index
; --i
>= 0; )
1005 unsigned char byte
= (unsigned char)buffer
[i
/ BITS_PER_UNIT
];
1006 unsigned bit_pos
= (unsigned)i
% (unsigned)BITS_PER_UNIT
;
1007 if (BYTES_BIG_ENDIAN
1008 ? (byte
& (1 << (BITS_PER_UNIT
- 1 - bit_pos
)))
1009 : (byte
& (1 << bit_pos
)))
1010 list
= tree_cons (NULL_TREE
,
1011 build_int_2 (i
+ min_index
, 0), list
);
1013 value
= build (CONSTRUCTOR
, type
, NULL_TREE
, list
);
1014 TREE_CONSTANT (value
) = 1;
1015 TREE_STATIC (value
) = 1;
1025 build_chill_cast (type
, expr
)
1031 int type_is_discrete
;
1032 int expr_type_is_discrete
;
1034 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
1035 return error_mark_node
;
1036 if (expr
== NULL_TREE
|| TREE_CODE (expr
) == ERROR_MARK
)
1037 return error_mark_node
;
1039 /* if expression was untyped because of its context (an
1040 if_expr or case_expr in a tuple, perhaps) just apply
1042 expr_type
= TREE_TYPE (expr
);
1043 if (expr_type
== NULL_TREE
1044 || TREE_CODE (expr_type
) == ERROR_MARK
)
1045 return convert (type
, expr
);
1047 if (expr_type
== type
)
1050 expr_type_size
= int_size_in_bytes (expr_type
);
1051 type_size
= int_size_in_bytes (type
);
1053 if (expr_type_size
== -1)
1055 error ("conversions from variable_size value");
1056 return error_mark_node
;
1058 if (type_size
== -1)
1060 error ("conversions to variable_size mode");
1061 return error_mark_node
;
1064 /* FIXME: process REAL ==> INT && INT ==> REAL && REAL ==> REAL. I hope this is correct. */
1065 if ((TREE_CODE (expr_type
) == INTEGER_TYPE
&& TREE_CODE (type
) == REAL_TYPE
) ||
1066 (TREE_CODE (expr_type
) == REAL_TYPE
&& TREE_CODE (type
) == INTEGER_TYPE
) ||
1067 (TREE_CODE (expr_type
) == REAL_TYPE
&& TREE_CODE (type
) == REAL_TYPE
))
1068 return convert (type
, expr
);
1070 /* FIXME: Don't know if this is correct */
1071 /* Don't allow conversions to or from REAL with others then integer */
1072 if (TREE_CODE (type
) == REAL_TYPE
)
1074 error ("cannot convert to float");
1075 return error_mark_node
;
1077 else if (TREE_CODE (expr_type
) == REAL_TYPE
)
1079 error ("cannot convert float to this mode");
1080 return error_mark_node
;
1083 if (expr_type_size
== type_size
&& CH_REFERABLE (expr
))
1084 goto do_location_conversion
;
1087 = discrete_type_p (type
) || TREE_CODE (type
) == POINTER_TYPE
;
1088 expr_type_is_discrete
1089 = discrete_type_p (expr_type
) || TREE_CODE (expr_type
) == POINTER_TYPE
;
1090 if (expr_type_is_discrete
&& type_is_discrete
)
1092 /* do an overflow check
1093 FIXME: is this always neccessary ??? */
1094 /* FIXME: don't do range chacking when target type is PTR.
1095 PTR doesn't have MIN and MAXVALUE. result is sigsegv. */
1096 if (range_checking
&& type
!= ptr_type_node
)
1101 if (TREE_CONSTANT (tmp
) && TREE_CODE (tmp
) != ADDR_EXPR
)
1103 if (compare_int_csts (LT_EXPR
, tmp
, TYPE_MIN_VALUE (type
)) ||
1104 compare_int_csts (GT_EXPR
, tmp
, TYPE_MAX_VALUE (type
)))
1106 error ("OVERFLOW in expression conversion");
1107 return error_mark_node
;
1112 int cond1
= tree_int_cst_lt (TYPE_SIZE (type
),
1113 TYPE_SIZE (expr_type
));
1114 int cond2
= TREE_UNSIGNED (type
) && (! TREE_UNSIGNED (expr_type
));
1115 int cond3
= (! TREE_UNSIGNED (type
))
1116 && TREE_UNSIGNED (expr_type
)
1117 && tree_int_cst_equal (TYPE_SIZE (type
),
1118 TYPE_SIZE (expr_type
));
1119 int cond4
= TREE_TYPE (type
) && type_is_discrete
;
1121 if (cond1
|| cond2
|| cond3
|| cond4
)
1123 tree type_min
= TYPE_MIN_VALUE (type
);
1124 tree type_max
= TYPE_MAX_VALUE (type
);
1126 expr
= save_if_needed (expr
);
1127 if (expr
&& type_min
&& type_max
)
1129 tree check
= test_range (expr
, type_min
, type_max
);
1130 if (!integer_zerop (check
))
1132 if (current_function_decl
== NULL_TREE
)
1134 if (TREE_CODE (check
) == INTEGER_CST
)
1135 error ("overflow (not inside function)");
1137 warning ("possible overflow (not inside function)");
1141 if (TREE_CODE (check
) == INTEGER_CST
)
1142 warning ("expression will always cause OVERFLOW");
1143 expr
= check_expression (expr
, check
,
1144 ridpointers
[(int) RID_OVERFLOW
]);
1151 return convert (type
, expr
);
1154 if (TREE_CODE (expr
) == INTEGER_CST
&& expr_type_size
!= type_size
)
1156 /* There should probably be a pedwarn here ... */
1157 tree itype
= type_for_size (type_size
* BITS_PER_UNIT
, 1);
1160 expr
= convert (itype
, expr
);
1161 expr_type
= TREE_TYPE (expr
);
1162 expr_type_size
= type_size
;
1166 /* If expr is a constant of the right size, use it to to
1167 initialize a static variable. */
1168 if (expr_type_size
== type_size
&& TREE_CONSTANT (expr
) && !pedantic
)
1170 unsigned char *buffer
= (unsigned char*) alloca (type_size
);
1172 bzero (buffer
, type_size
);
1173 if (!expand_constant_to_buffer (expr
, buffer
, type_size
))
1175 error ("not implemented: constant conversion from that kind of expression");
1176 return error_mark_node
;
1178 value
= extract_constant_from_buffer (type
, buffer
, type_size
);
1179 if (value
== NULL_TREE
)
1181 error ("not implemented: constant conversion to that kind of mode");
1182 return error_mark_node
;
1187 if (!CH_REFERABLE (expr
) && expr_type_size
== type_size
)
1189 tree temp
= decl_temp1 (get_unique_identifier ("CAST"),
1190 TREE_TYPE (expr
), 0, 0, 0, 0);
1191 tree convert1
= build_chill_modify_expr (temp
, expr
);
1192 pedwarn ("non-standard, non-portable value conversion");
1193 return build (COMPOUND_EXPR
, type
, convert1
,
1194 build_chill_cast (type
, temp
));
1197 if (CH_REFERABLE (expr
) && expr_type_size
!= type_size
)
1198 error ("location conversion between differently-sized modes");
1200 error ("unsupported value conversion");
1201 return error_mark_node
;
1203 do_location_conversion
:
1204 /* To avoid confusing other parts of gcc,
1205 represent this as the C expression: *(TYPE*)EXPR. */
1206 mark_addressable (expr
);
1207 expr
= build1 (INDIRECT_REF
, type
,
1208 build1 (NOP_EXPR
, build_pointer_type (type
),
1209 build1 (ADDR_EXPR
, build_pointer_type (expr_type
),
1211 TREE_READONLY (expr
) = TYPE_READONLY (type
);
1215 /* Given a set_type, build an integer array from it that C will grok. */
1218 build_array_from_set (type
)
1221 tree bytespint
, bit_array_size
, int_array_count
;
1223 if (type
== NULL_TREE
|| type
== error_mark_node
1224 || TREE_CODE (type
) != SET_TYPE
)
1225 return error_mark_node
;
1227 /* ??? Should this really be *HOST*?? */
1228 bytespint
= size_int (HOST_BITS_PER_INT
/ HOST_BITS_PER_CHAR
);
1229 bit_array_size
= size_in_bytes (type
);
1230 int_array_count
= size_binop (TRUNC_DIV_EXPR
, bit_array_size
, bytespint
);
1231 if (integer_zerop (int_array_count
))
1232 int_array_count
= size_one_node
;
1233 type
= build_array_type (integer_type_node
,
1234 build_index_type (int_array_count
));
1240 build_chill_bin_type (size
)
1246 if (TREE_CODE (size
) != INTEGER_CST
1247 || (isize
= TREE_INT_CST_LOW (size
), isize
<= 0))
1249 error ("operand to bin must be a non-negative integer literal");
1250 return error_mark_node
;
1252 if (isize
<= TYPE_PRECISION (unsigned_char_type_node
))
1253 return unsigned_char_type_node
;
1254 if (isize
<= TYPE_PRECISION (short_unsigned_type_node
))
1255 return short_unsigned_type_node
;
1256 if (isize
<= TYPE_PRECISION (unsigned_type_node
))
1257 return unsigned_type_node
;
1258 if (isize
<= TYPE_PRECISION (long_unsigned_type_node
))
1259 return long_unsigned_type_node
;
1260 if (isize
<= TYPE_PRECISION (long_long_unsigned_type_node
))
1261 return long_long_unsigned_type_node
;
1262 error ("size %d of BIN too big - no such integer mode", isize
);
1263 return error_mark_node
;
1269 bintype
= make_node (INTEGER_TYPE
);
1270 TREE_TYPE (bintype
) = ridpointers
[(int) RID_BIN
];
1271 TYPE_MIN_VALUE (bintype
) = size
;
1272 TYPE_MAX_VALUE (bintype
) = size
;
1276 error ("BIN in pass 2");
1277 return error_mark_node
;
1283 chill_expand_tuple (type
, constructor
)
1284 tree type
, constructor
;
1287 tree nonreft
= type
;
1289 if (TYPE_NAME (type
) != NULL_TREE
)
1291 if (TREE_CODE (TYPE_NAME (type
)) == IDENTIFIER_NODE
)
1292 name
= IDENTIFIER_POINTER (TYPE_NAME (type
));
1294 name
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (type
)));
1299 /* get to actual underlying type for digest_init */
1300 while (nonreft
&& TREE_CODE (nonreft
) == REFERENCE_TYPE
)
1301 nonreft
= TREE_TYPE (nonreft
);
1303 if (TREE_CODE (nonreft
) == ARRAY_TYPE
1304 || TREE_CODE (nonreft
) == RECORD_TYPE
1305 || TREE_CODE (nonreft
) == SET_TYPE
)
1306 return convert (nonreft
, constructor
);
1309 error ("mode of tuple is neither ARRAY, STRUCT, nor POWERSET");
1310 return error_mark_node
;
1314 /* This function classifies an expr into the Null class,
1315 the All class, the M-Value, the M-derived, or the M-reference class.
1316 It probably has some inaccuracies. */
1319 chill_expr_class (expr
)
1322 struct ch_class
class;
1323 /* The Null class contains the NULL pointer constant (only). */
1324 if (expr
== null_pointer_node
)
1326 class.kind
= CH_NULL_CLASS
;
1327 class.mode
= NULL_TREE
;
1331 /* The All class contains the <undefined value> "*". */
1332 if (TREE_CODE (expr
) == UNDEFINED_EXPR
)
1334 class.kind
= CH_ALL_CLASS
;
1335 class.mode
= NULL_TREE
;
1339 if (CH_DERIVED_FLAG (expr
))
1341 class.kind
= CH_DERIVED_CLASS
;
1342 class.mode
= TREE_TYPE (expr
);
1346 /* The M-Reference contains <references location> (address-of) expressions.
1347 Note that something that's been converted to a reference doesn't count. */
1348 if (TREE_CODE (expr
) == ADDR_EXPR
1349 && TREE_CODE (TREE_TYPE (expr
)) != REFERENCE_TYPE
)
1351 class.kind
= CH_REFERENCE_CLASS
;
1352 class.mode
= TREE_TYPE (TREE_TYPE (expr
));
1356 /* The M-Value class contains expressions with a known, specific mode M. */
1357 class.kind
= CH_VALUE_CLASS
;
1358 class.mode
= TREE_TYPE (expr
);
1362 /* Returns >= 1 iff REF is a location. Return 2 if it is referable. */
1364 int chill_location (ref
)
1367 register enum tree_code code
= TREE_CODE (ref
);
1374 case PACKED_ARRAY_REF
:
1376 case NOP_EXPR
: /* RETYPE_EXPR */
1377 return chill_location (TREE_OPERAND (ref
, 0));
1379 return chill_location (TREE_OPERAND (ref
, 1));
1383 /* A bit-string slice is nor referable. */
1384 return chill_location (TREE_OPERAND (ref
, 0)) == 0 ? 0 : 1;
1395 if (TREE_CODE (TREE_TYPE (ref
)) != FUNCTION_TYPE
1396 && TREE_CODE (TREE_TYPE (ref
)) != METHOD_TYPE
)
1407 chill_referable (val
)
1410 return chill_location (val
) > 1;
1413 /* Make a copy of MODE, but with the given NOVELTY. */
1416 copy_novelty (novelty
, mode
)
1419 if (CH_NOVELTY (mode
) != novelty
)
1421 mode
= copy_node (mode
);
1422 TYPE_MAIN_VARIANT (mode
) = mode
;
1423 TYPE_NEXT_VARIANT (mode
) = 0;
1424 TYPE_POINTER_TO (mode
) = 0;
1425 TYPE_REFERENCE_TO (mode
) = 0;
1426 SET_CH_NOVELTY (mode
, novelty
);
1434 struct mode_chain
*prev
;
1438 /* Tests if MODE1 and MODE2 are SIMILAR.
1439 This is more or less as defined in the Blue Book, though
1440 see FIXME for parts that are unfinished.
1441 CHAIN is used to catch infinite recursion: It is a list of pairs
1442 of mode arguments to calls to chill_similar "outer" to this call. */
1445 chill_similar (mode1
, mode2
, chain
)
1447 struct mode_chain
*chain
;
1449 int varying1
, varying2
;
1451 struct mode_chain
*link
, node
;
1452 if (mode1
== NULL_TREE
|| mode2
== NULL_TREE
)
1455 while (TREE_CODE (mode1
) == REFERENCE_TYPE
)
1456 mode1
= TREE_TYPE (mode1
);
1457 while (TREE_CODE (mode2
) == REFERENCE_TYPE
)
1458 mode2
= TREE_TYPE (mode2
);
1460 /* Range modes are similar to their parent types. */
1461 while (TREE_CODE (mode1
) == INTEGER_TYPE
&& TREE_TYPE (mode1
) != NULL_TREE
)
1462 mode1
= TREE_TYPE (mode1
);
1463 while (TREE_CODE (mode2
) == INTEGER_TYPE
&& TREE_TYPE (mode2
) != NULL_TREE
)
1464 mode2
= TREE_TYPE (mode2
);
1467 /* see Z.200 sections 12.1.2.2 and 13.2 - all integer precisions
1468 are similar to INT and to each other */
1469 if (mode1
== mode2
||
1470 (TREE_CODE (mode1
) == INTEGER_TYPE
&& TREE_CODE (mode2
) == INTEGER_TYPE
))
1473 /* This guards against certain kinds of recursion.
1475 SYNMODE a = STRUCT ( next REF a );
1476 SYNMODE b = STRUCT ( next REF b );
1477 These moes are similar, but will get an infite recursion trying
1478 to prove that. So, if we are recursing, assume the moes are similar.
1479 If they are not, we'll find some other discrepancy. */
1480 for (link
= chain
; link
!= NULL
; link
= link
->prev
)
1482 if (link
->mode1
== mode1
&& link
->mode2
== mode2
)
1490 varying1
= chill_varying_type_p (mode1
);
1491 varying2
= chill_varying_type_p (mode2
);
1492 /* FIXME: This isn't quite strict enough. */
1493 if ((varying1
&& varying2
)
1494 || (varying1
&& TREE_CODE (mode2
) == ARRAY_TYPE
)
1495 || (varying2
&& TREE_CODE (mode1
) == ARRAY_TYPE
))
1498 if (TREE_CODE(mode1
) != TREE_CODE(mode2
))
1500 if (flag_old_strings
)
1502 /* The recursion is to handle varying strings. */
1503 if ((TREE_CODE (mode1
) == CHAR_TYPE
1504 && CH_SIMILAR (mode2
, string_one_type_node
))
1505 || (TREE_CODE (mode2
) == CHAR_TYPE
1506 && CH_SIMILAR (mode1
, string_one_type_node
)))
1508 if ((TREE_CODE (mode1
) == BOOLEAN_TYPE
1509 && CH_SIMILAR (mode2
, bitstring_one_type_node
))
1510 || (TREE_CODE (mode2
) == BOOLEAN_TYPE
1511 && CH_SIMILAR (mode1
, bitstring_one_type_node
)))
1514 if (TREE_CODE (mode1
) == FUNCTION_TYPE
1515 && TREE_CODE (mode2
) == POINTER_TYPE
1516 && TREE_CODE (TREE_TYPE (mode2
)) == FUNCTION_TYPE
)
1517 mode2
= TREE_TYPE (mode2
);
1518 else if (TREE_CODE (mode2
) == FUNCTION_TYPE
1519 && TREE_CODE (mode1
) == POINTER_TYPE
1520 && TREE_CODE (TREE_TYPE (mode1
)) == FUNCTION_TYPE
)
1521 mode1
= TREE_TYPE (mode1
);
1526 if (CH_IS_BUFFER_MODE (mode1
) && CH_IS_BUFFER_MODE (mode2
))
1528 tree len1
= max_queue_size (mode1
);
1529 tree len2
= max_queue_size (mode2
);
1530 return tree_int_cst_equal (len1
, len2
);
1532 else if (CH_IS_EVENT_MODE (mode1
) && CH_IS_EVENT_MODE (mode2
))
1534 tree len1
= max_queue_size (mode1
);
1535 tree len2
= max_queue_size (mode2
);
1536 return tree_int_cst_equal (len1
, len2
);
1538 else if (CH_IS_ACCESS_MODE (mode1
) && CH_IS_ACCESS_MODE (mode2
))
1540 tree index1
= access_indexmode (mode1
);
1541 tree index2
= access_indexmode (mode2
);
1542 tree record1
= access_recordmode (mode1
);
1543 tree record2
= access_recordmode (mode2
);
1544 if (! chill_read_compatible (index1
, index2
))
1546 return chill_read_compatible (record1
, record2
);
1548 switch ((enum chill_tree_code
)TREE_CODE (mode1
))
1555 if (TYPE_VALUES (mode1
) == TYPE_VALUES (mode2
))
1559 /* FIXME: This is more strict than z.200, which seems to
1560 allow the elements to be reordered, as long as they
1561 have the same values. */
1563 tree field1
= TYPE_VALUES (mode1
);
1564 tree field2
= TYPE_VALUES (mode2
);
1566 while (field1
!= NULL_TREE
&& field2
!= NULL_TREE
)
1568 tree value1
, value2
;
1569 /* Check that the names are equal. */
1570 if (TREE_PURPOSE (field1
) != TREE_PURPOSE (field2
))
1573 value1
= TREE_VALUE (field1
);
1574 value2
= TREE_VALUE (field2
);
1575 /* This isn't quite sufficient in general, but will do ... */
1576 /* Note that proclaim_decl can cause the SET modes to be
1577 compared BEFORE they are satisfied, but otherwise
1578 chill_similar is mostly called after satisfaction. */
1579 if (TREE_CODE (value1
) == CONST_DECL
)
1580 value1
= DECL_INITIAL (value1
);
1581 if (TREE_CODE (value2
) == CONST_DECL
)
1582 value2
= DECL_INITIAL (value2
);
1583 /* Check that the values are equal or both NULL. */
1584 if (!(value1
== NULL_TREE
&& value2
== NULL_TREE
)
1585 && (value1
== NULL_TREE
|| value2
== NULL_TREE
1586 || ! tree_int_cst_equal (value1
, value2
)))
1588 field1
= TREE_CHAIN (field1
);
1589 field2
= TREE_CHAIN (field2
);
1591 return field1
== NULL_TREE
&& field2
== NULL_TREE
;
1594 /* check for bit strings */
1595 if (CH_BOOLS_TYPE_P (mode1
))
1596 return CH_BOOLS_TYPE_P (mode2
);
1597 if (CH_BOOLS_TYPE_P (mode2
))
1598 return CH_BOOLS_TYPE_P (mode1
);
1599 /* both are powerset modes */
1600 return CH_EQUIVALENT (TYPE_DOMAIN (mode1
), TYPE_DOMAIN (mode2
));
1603 /* Are the referenced modes equivalent? */
1604 return !integer_zerop (chill_equivalent (TREE_TYPE (mode1
),
1609 /* char for char strings */
1610 if (CH_CHARS_TYPE_P (mode1
))
1611 return CH_CHARS_TYPE_P (mode2
);
1612 if (CH_CHARS_TYPE_P (mode2
))
1613 return CH_CHARS_TYPE_P (mode1
);
1615 if (CH_V_EQUIVALENT (TYPE_DOMAIN (mode1
), TYPE_DOMAIN (mode2
))
1616 /* Are the elements modes equivalent? */
1617 && !integer_zerop (chill_equivalent (TREE_TYPE (mode1
),
1621 /* FIXME: Check that element layouts are equivalent */
1623 tree count1
= fold (build (MINUS_EXPR
, sizetype
,
1624 TYPE_MAX_VALUE (TYPE_DOMAIN (mode1
)),
1625 TYPE_MIN_VALUE (TYPE_DOMAIN (mode1
))));
1626 tree count2
= fold (build (MINUS_EXPR
, sizetype
,
1627 TYPE_MAX_VALUE (TYPE_DOMAIN (mode2
)),
1628 TYPE_MIN_VALUE (TYPE_DOMAIN (mode2
))));
1629 tree cond
= build_compare_discrete_expr (EQ_EXPR
, count1
, count2
);
1630 if (TREE_CODE (cond
) == INTEGER_CST
)
1631 return !integer_zerop (cond
);
1635 extern int ignoring
;
1638 && current_function_decl
)
1648 for (t1
= TYPE_FIELDS (mode1
), t2
= TYPE_FIELDS (mode2
);
1649 t1
&& t2
; t1
= TREE_CHAIN (t1
), t2
= TREE_CHAIN (t2
))
1651 if (TREE_CODE (t1
) != TREE_CODE (t2
))
1653 /* Are the field modes equivalent? */
1654 if (integer_zerop (chill_equivalent (TREE_TYPE (t1
),
1662 if (!chill_l_equivalent (TREE_TYPE (mode1
), TREE_TYPE (mode2
), &node
))
1664 for (t1
= TYPE_ARG_TYPES (mode1
), t2
= TYPE_ARG_TYPES (mode2
);
1665 t1
!= NULL_TREE
&& t2
!= NULL_TREE
;
1666 t1
= TREE_CHAIN (t1
), t2
= TREE_CHAIN (t2
))
1668 tree attr1
= TREE_PURPOSE (t1
)
1669 ? TREE_PURPOSE (t1
) : ridpointers
[(int) RID_IN
];
1670 tree attr2
= TREE_PURPOSE (t2
)
1671 ? TREE_PURPOSE (t2
) : ridpointers
[(int) RID_IN
];
1674 if (!chill_l_equivalent (TREE_VALUE (t1
), TREE_VALUE (t2
), &node
))
1677 if (t1
!= t2
) /* Both NULL_TREE */
1679 /* check list of exception names */
1680 t1
= TYPE_RAISES_EXCEPTIONS (mode1
);
1681 t2
= TYPE_RAISES_EXCEPTIONS (mode2
);
1682 if (t1
== NULL_TREE
&& t2
!= NULL_TREE
)
1684 if (t1
!= NULL_TREE
&& t2
== NULL_TREE
)
1686 if (list_length (t1
) != list_length (t2
))
1688 while (t1
!= NULL_TREE
)
1690 if (value_member (TREE_VALUE (t1
), t2
) == NULL_TREE
)
1692 t1
= TREE_CHAIN (t1
);
1694 /* FIXME: Should also check they have the same RECURSIVITY */
1700 /* Need to handle row modes, instance modes,
1701 association modes, access modes, text modes,
1702 duration modes, absolute time modes, structure modes,
1703 parameterized structure modes */
1709 /* Return a node that is true iff MODE1 and MODE2 are equivalent.
1710 This is normally boolean_true_node or boolean_false_node,
1711 but can be dynamic for dynamic types.
1712 CHAIN is as for chill_similar. */
1715 chill_equivalent (mode1
, mode2
, chain
)
1717 struct mode_chain
*chain
;
1719 int varying1
, varying2
;
1720 int is_string1
, is_string2
;
1721 tree base_mode1
, base_mode2
;
1723 /* Are the modes v-equivalent? */
1725 if (!chill_similar (mode1
, mode2
, chain
)
1726 || CH_NOVELTY(mode1
) != CH_NOVELTY(mode2
))
1727 return boolean_false_node
;
1729 if (!chill_similar (mode1
, mode2
, chain
))
1730 return boolean_false_node
;
1731 else if (TREE_CODE (mode2
) == FUNCTION_TYPE
1732 && TREE_CODE (mode1
) == POINTER_TYPE
1733 && TREE_CODE (TREE_TYPE (mode1
)) == FUNCTION_TYPE
)
1734 /* don't check novelty in this case to avoid error in case of
1735 NEWMODE'd proceduremode gets assigned a function */
1736 return boolean_true_node
;
1737 else if (CH_NOVELTY(mode1
) != CH_NOVELTY(mode2
))
1738 return boolean_false_node
;
1740 varying1
= chill_varying_type_p (mode1
);
1741 varying2
= chill_varying_type_p (mode2
);
1743 if (varying1
!= varying2
)
1744 return boolean_false_node
;
1745 base_mode1
= varying1
? CH_VARYING_ARRAY_TYPE (mode1
) : mode1
;
1746 base_mode2
= varying2
? CH_VARYING_ARRAY_TYPE (mode2
) : mode2
;
1747 is_string1
= CH_STRING_TYPE_P (base_mode1
);
1748 is_string2
= CH_STRING_TYPE_P (base_mode2
);
1749 if (is_string1
|| is_string2
)
1751 if (is_string1
!= is_string2
)
1752 return boolean_false_node
;
1753 return fold (build (EQ_EXPR
, boolean_type_node
,
1754 TYPE_SIZE (base_mode1
),
1755 TYPE_SIZE (base_mode2
)));
1758 /* && some more stuff FIXME! */
1759 if (TREE_CODE(mode1
) == INTEGER_TYPE
|| TREE_CODE(mode2
) == INTEGER_TYPE
)
1761 if (TREE_CODE(mode1
) != INTEGER_TYPE
|| TREE_CODE(mode2
) != INTEGER_TYPE
)
1762 return boolean_false_node
;
1763 /* If one is a range, the other has to be a range. */
1764 if ((TREE_TYPE (mode1
) != NULL_TREE
) != (TREE_TYPE (mode2
) != NULL_TREE
))
1765 return boolean_false_node
;
1766 if (TYPE_PRECISION (mode1
) != TYPE_PRECISION (mode2
))
1767 return boolean_false_node
;
1768 if (!tree_int_cst_equal (TYPE_MIN_VALUE (mode1
), TYPE_MIN_VALUE (mode2
)))
1769 return boolean_false_node
;
1770 if (!tree_int_cst_equal (TYPE_MAX_VALUE (mode1
), TYPE_MAX_VALUE (mode2
)))
1771 return boolean_false_node
;
1773 return boolean_true_node
;
1777 chill_l_equivalent (mode1
, mode2
, chain
)
1779 struct mode_chain
*chain
;
1781 /* Are the modes equivalent? */
1782 if (integer_zerop (chill_equivalent (mode1
, mode2
, chain
)))
1784 if (TYPE_READONLY (mode1
) != TYPE_READONLY (mode2
))
1787 ... other conditions
...;
1792 /* See Z200 12.1.2.12 */
1795 chill_read_compatible (modeM
, modeN
)
1798 while (TREE_CODE (modeM
) == REFERENCE_TYPE
)
1799 modeM
= TREE_TYPE (modeM
);
1800 while (TREE_CODE (modeN
) == REFERENCE_TYPE
)
1801 modeN
= TREE_TYPE (modeN
);
1803 if (!CH_EQUIVALENT (modeM
, modeN
))
1805 if (TYPE_READONLY (modeN
))
1807 if (!TYPE_READONLY (modeM
))
1809 if (CH_IS_BOUND_REFERENCE_MODE (modeM
)
1810 && CH_IS_BOUND_REFERENCE_MODE (modeN
))
1812 return chill_l_equivalent (TREE_TYPE (modeM
), TREE_TYPE (modeN
), 0);
1821 /* Tests if MODE is compatible with the class of EXPR.
1822 Cfr. Chill Blue Book 12.1.2.15. */
1825 chill_compatible (expr
, mode
)
1828 struct ch_class
class;
1830 if (expr
== NULL_TREE
|| TREE_CODE (expr
) == ERROR_MARK
)
1832 if (mode
== NULL_TREE
|| TREE_CODE (mode
) == ERROR_MARK
)
1835 while (TREE_CODE (mode
) == REFERENCE_TYPE
)
1836 mode
= TREE_TYPE (mode
);
1838 if (TREE_TYPE (expr
) == NULL_TREE
)
1840 if (TREE_CODE (expr
) == CONSTRUCTOR
)
1841 return TREE_CODE (mode
) == RECORD_TYPE
1842 || ((TREE_CODE (mode
) == SET_TYPE
|| TREE_CODE (mode
) == ARRAY_TYPE
)
1843 && ! TYPE_STRING_FLAG (mode
));
1845 return TREE_CODE (expr
) == CASE_EXPR
|| TREE_CODE (expr
) == COND_EXPR
;
1848 class = chill_expr_class (expr
);
1854 return CH_IS_REFERENCE_MODE (mode
) || CH_IS_PROCEDURE_MODE (mode
)
1855 || CH_IS_INSTANCE_MODE (mode
);
1856 case CH_VALUE_CLASS
:
1857 if (CH_HAS_REFERENCING_PROPERTY (mode
))
1858 return CH_RESTRICTABLE_TO(mode
, class.mode
);
1860 return CH_V_EQUIVALENT(mode
, class.mode
);
1861 case CH_DERIVED_CLASS
:
1862 return CH_SIMILAR (class.mode
, mode
);
1863 case CH_REFERENCE_CLASS
:
1864 if (!CH_IS_REFERENCE_MODE (mode
))
1868 if (class.mode is a row mode
)
1870 else if (class.mode is
not a
static mode
)
1871 return 0; /* is this possible? FIXME */
1873 return !CH_IS_BOUND_REFERENCE_MODE(mode
)
1874 || CH_READ_COMPATIBLE (TREE_TYPE (mode
), class.mode
);
1876 return 0; /* ERROR! */
1879 /* Tests if the class of of EXPR1 and EXPR2 are compatible.
1880 Cfr. Chill Blue Book 12.1.2.16. */
1883 chill_compatible_classes (expr1
, expr2
)
1886 struct ch_class temp
;
1887 struct ch_class class1
, class2
;
1888 class1
= chill_expr_class (expr1
);
1889 class2
= chill_expr_class (expr2
);
1891 switch (class1
.kind
)
1896 switch (class2
.kind
)
1900 case CH_REFERENCE_CLASS
:
1902 case CH_VALUE_CLASS
:
1903 case CH_DERIVED_CLASS
:
1906 case CH_REFERENCE_CLASS
:
1907 switch (class2
.kind
)
1912 case CH_REFERENCE_CLASS
:
1913 return CH_EQUIVALENT (class1
.mode
, class2
.mode
);
1914 case CH_VALUE_CLASS
:
1916 case CH_DERIVED_CLASS
:
1919 case CH_DERIVED_CLASS
:
1920 switch (class2
.kind
)
1924 case CH_VALUE_CLASS
:
1925 case CH_DERIVED_CLASS
:
1926 return CH_SIMILAR (class1
.mode
, class2
.mode
);
1930 case CH_REFERENCE_CLASS
:
1933 case CH_VALUE_CLASS
:
1934 switch (class2
.kind
)
1938 case CH_DERIVED_CLASS
:
1939 return CH_SIMILAR (class1
.mode
, class2
.mode
);
1940 case CH_VALUE_CLASS
:
1941 return CH_V_EQUIVALENT (class1
.mode
, class2
.mode
);
1945 case CH_REFERENCE_CLASS
:
1946 temp
= class1
; class1
= class2
; class2
= temp
;
1951 /* The Null class is Compatible with the M-derived class or M-value class
1952 if and only if M is a reference mdoe, procedure mode or instance mode.*/
1953 return CH_IS_REFERENCE_MODE (class2
.mode
)
1954 || CH_IS_PROCEDURE_MODE (class2
.mode
)
1955 || CH_IS_INSTANCE_MODE (class2
.mode
);
1958 /* The M-reference class is compatible with the N-value class if and
1959 only if N is a reference mode and ... */
1960 if (!CH_IS_REFERENCE_MODE (class2
.mode
))
1962 if (1) /* If M is a static mode - FIXME */
1964 if (!CH_IS_BOUND_REFERENCE_MODE (class2
.mode
))
1966 if (CH_EQUIVALENT (TREE_TYPE (class2
.mode
), class1
.mode
))
1969 /* If N is a row mode whose .... FIXME */
1973 /* Cfr. Blue Book 12.1.1.6, with some "extensions." */
1976 chill_root_mode (mode
)
1979 /* Reference types are not user-visible types.
1980 This seems like a good place to get rid of them. */
1981 if (TREE_CODE (mode
) == REFERENCE_TYPE
)
1982 mode
= TREE_TYPE (mode
);
1984 while (TREE_CODE (mode
) == INTEGER_TYPE
&& TREE_TYPE (mode
) != NULL_TREE
)
1985 mode
= TREE_TYPE (mode
); /* a sub-range */
1987 /* This extension in not in the Blue Book - which only has a
1988 single Integer type.
1989 We should probably use chill_integer_type_node rather
1990 than integer_type_node, but that is likely to bomb.
1991 At some point, these will become the same, I hope. FIXME */
1992 if (TREE_CODE (mode
) == INTEGER_TYPE
1993 && TYPE_PRECISION (mode
) < TYPE_PRECISION (integer_type_node
)
1994 && CH_NOVELTY (mode
) == NULL_TREE
)
1995 mode
= integer_type_node
;
1997 if (TREE_CODE (mode
) == FUNCTION_TYPE
)
1998 return build_pointer_type (mode
);
2003 /* Cfr. Blue Book 12.1.1.7. */
2006 chill_resulting_mode (mode1
, mode2
)
2009 mode1
= CH_ROOT_MODE (mode1
);
2010 mode2
= CH_ROOT_MODE (mode2
);
2011 if (chill_varying_type_p (mode1
))
2013 if (chill_varying_type_p (mode2
))
2018 /* Cfr. Blue Book (z200, 1988) 12.1.1.7 Resulting class. */
2021 chill_resulting_class (class1
, class2
)
2022 struct ch_class class1
, class2
;
2024 struct ch_class
class;
2025 switch (class1
.kind
)
2027 case CH_VALUE_CLASS
:
2028 switch (class2
.kind
)
2030 case CH_DERIVED_CLASS
:
2032 class.kind
= CH_VALUE_CLASS
;
2033 class.mode
= CH_ROOT_MODE (class1
.mode
);
2035 case CH_VALUE_CLASS
:
2036 class.kind
= CH_VALUE_CLASS
;
2038 = CH_ROOT_MODE (CH_RESULTING_MODE (class1
.mode
, class2
.mode
));
2044 case CH_DERIVED_CLASS
:
2045 switch (class2
.kind
)
2047 case CH_VALUE_CLASS
:
2048 class.kind
= CH_VALUE_CLASS
;
2049 class.mode
= CH_ROOT_MODE (class2
.mode
);
2051 case CH_DERIVED_CLASS
:
2052 class.kind
= CH_DERIVED_CLASS
;
2053 class.mode
= CH_RESULTING_MODE (class1
.mode
, class2
.mode
);
2056 class.kind
= CH_DERIVED_CLASS
;
2057 class.mode
= CH_ROOT_MODE (class1
.mode
);
2064 switch (class2
.kind
)
2066 case CH_VALUE_CLASS
:
2067 class.kind
= CH_VALUE_CLASS
;
2068 class.mode
= CH_ROOT_MODE (class2
.mode
);
2071 class.kind
= CH_ALL_CLASS
;
2072 class.mode
= NULL_TREE
;
2074 case CH_DERIVED_CLASS
:
2075 class.kind
= CH_DERIVED_CLASS
;
2076 class.mode
= CH_ROOT_MODE (class2
.mode
);
2085 error ("internal error in chill_root_resulting_mode");
2086 class.kind
= CH_VALUE_CLASS
;
2087 class.mode
= CH_ROOT_MODE (class1
.mode
);
2093 * See Z.200, section 6.3, static conditions. This function
2094 * returns bool_false_node if the condition is not met at compile time,
2095 * bool_true_node if the condition is detectably met at compile time
2096 * an expression if a runtime check would be required or was generated.
2097 * It should only be called with string modes and values.
2100 string_assignment_condition (lhs_mode
, rhs_value
)
2101 tree lhs_mode
, rhs_value
;
2103 tree lhs_size
, rhs_size
, cond
;
2104 tree rhs_mode
= TREE_TYPE (rhs_value
);
2105 int lhs_varying
= chill_varying_type_p (lhs_mode
);
2108 lhs_size
= size_in_bytes (CH_VARYING_ARRAY_TYPE (lhs_mode
));
2109 else if (CH_BOOLS_TYPE_P (lhs_mode
))
2110 lhs_size
= TYPE_MAX_VALUE (TYPE_DOMAIN (lhs_mode
));
2112 lhs_size
= size_in_bytes (lhs_mode
);
2113 lhs_size
= convert (chill_unsigned_type_node
, lhs_size
);
2115 if (rhs_mode
&& TREE_CODE (rhs_mode
) == REFERENCE_TYPE
)
2116 rhs_mode
= TREE_TYPE (rhs_mode
);
2117 if (rhs_mode
== NULL_TREE
)
2119 /* actually, count constructor's length */
2122 else if (chill_varying_type_p (rhs_mode
))
2123 rhs_size
= build_component_ref (rhs_value
, var_length_id
);
2124 else if (CH_BOOLS_TYPE_P (rhs_mode
))
2125 rhs_size
= TYPE_MAX_VALUE (TYPE_DOMAIN (rhs_mode
));
2127 rhs_size
= size_in_bytes (rhs_mode
);
2128 rhs_size
= convert (chill_unsigned_type_node
, rhs_size
);
2130 /* validity condition */
2131 cond
= fold (build (lhs_varying
? GE_EXPR
: EQ_EXPR
,
2132 boolean_type_node
, lhs_size
, rhs_size
));
2137 * take a basic CHILL type and wrap it in a VARYING structure.
2138 * Be sure the length field is initialized. Return the wrapper.
2141 build_varying_struct (type
)
2144 tree decl1
, decl2
, result
;
2146 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
2147 return error_mark_node
;
2149 decl1
= build_decl (FIELD_DECL
, var_length_id
, chill_integer_type_node
);
2150 decl2
= build_decl (FIELD_DECL
, var_data_id
, type
);
2151 TREE_CHAIN (decl1
) = decl2
;
2152 TREE_CHAIN (decl2
) = NULL_TREE
;
2153 result
= build_chill_struct_type (decl1
);
2155 /* mark this so we don't complain about missing initializers.
2156 It's fine for a VARYING array to be partially initialized.. */
2157 C_TYPE_VARIABLE_SIZE(type
) = 1;
2163 * This is the struct type that forms the runtime initializer
2164 * list. There's at least one of these generated per module.
2165 * It's attached to the global initializer list by the module's
2166 * 'constructor' code. Should only be called in pass 2.
2169 build_init_struct ()
2171 tree decl1
, decl2
, result
;
2172 /* We temporarily reset the maximum_field_alignment to zero so the
2173 compiler's init data structures can be compatible with the
2174 run-time system, even when we're compiling with -fpack. */
2175 unsigned int save_maximum_field_alignment
= maximum_field_alignment
;
2176 maximum_field_alignment
= 0;
2178 decl1
= build_decl (FIELD_DECL
, get_identifier ("__INIT_ENTRY"),
2179 build_chill_pointer_type (
2180 build_function_type (void_type_node
, NULL_TREE
)));
2182 decl2
= build_decl (FIELD_DECL
, get_identifier ("__INIT_NEXT"),
2183 build_chill_pointer_type (void_type_node
));
2185 TREE_CHAIN (decl1
) = decl2
;
2186 TREE_CHAIN (decl2
) = NULL_TREE
;
2187 result
= build_chill_struct_type (decl1
);
2188 maximum_field_alignment
= save_maximum_field_alignment
;
2194 * Return 1 if the given type is a single-bit boolean set,
2195 * in which the domain's min and max values
2197 * 0 if not. This can become a macro later..
2200 ch_singleton_set (type
)
2203 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
2205 if (TREE_CODE (type
) != SET_TYPE
)
2207 if (TREE_TYPE (type
) == NULL_TREE
2208 || TREE_CODE (TREE_TYPE (type
)) != BOOLEAN_TYPE
)
2210 if (TYPE_DOMAIN (type
) == NULL_TREE
)
2212 if (! tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type
)),
2215 if (! tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type
)),
2221 /* return non-zero if TYPE is a compiler-generated VARYING
2222 array of some base type */
2224 chill_varying_type_p (type
)
2227 if (type
== NULL_TREE
)
2229 if (TREE_CODE (type
) != RECORD_TYPE
)
2231 if (TYPE_FIELDS (type
) == NULL_TREE
2232 || TREE_CHAIN (TYPE_FIELDS (type
)) == NULL_TREE
)
2234 if (DECL_NAME (TYPE_FIELDS (type
)) != var_length_id
)
2236 if (DECL_NAME (TREE_CHAIN (TYPE_FIELDS (type
))) != var_data_id
)
2238 if (TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (type
))) != NULL_TREE
)
2243 /* return non-zero if TYPE is a compiler-generated VARYING
2246 chill_varying_string_type_p (type
)
2251 if (!chill_varying_type_p (type
))
2254 var_data_type
= CH_VARYING_ARRAY_TYPE (type
);
2255 return CH_CHARS_TYPE_P (var_data_type
);
2258 /* swiped from c-typeck.c */
2259 /* Build an assignment expression of lvalue LHS from value RHS. */
2262 build_chill_modify_expr (lhs
, rhs
)
2265 register tree result
;
2268 tree lhstype
= TREE_TYPE (lhs
);
2270 /* Avoid duplicate error messages from operands that had errors. */
2271 if (lhs
== NULL_TREE
|| TREE_CODE (lhs
) == ERROR_MARK
|| rhs
== NULL_TREE
|| TREE_CODE (rhs
) == ERROR_MARK
)
2272 return error_mark_node
;
2274 /* Strip NON_LVALUE_EXPRs since we aren't using as an lvalue. */
2275 /* Do not use STRIP_NOPS here. We do not want an enumerator
2276 whose value is 0 to count as a null pointer constant. */
2277 if (TREE_CODE (rhs
) == NON_LVALUE_EXPR
)
2278 rhs
= TREE_OPERAND (rhs
, 0);
2281 /* Handle a cast used as an "lvalue".
2282 We have already performed any binary operator using the value as cast.
2283 Now convert the result to the cast type of the lhs,
2284 and then true type of the lhs and store it there;
2285 then convert result back to the cast type to be the value
2286 of the assignment. */
2288 switch (TREE_CODE (lhs
))
2293 case FIX_TRUNC_EXPR
:
2294 case FIX_FLOOR_EXPR
:
2295 case FIX_ROUND_EXPR
:
2298 tree inner_lhs
= TREE_OPERAND (lhs
, 0);
2300 result
= build_chill_modify_expr (inner_lhs
,
2301 convert (TREE_TYPE (inner_lhs
),
2302 convert (lhstype
, rhs
)));
2303 pedantic_lvalue_warning (CONVERT_EXPR
);
2304 return convert (TREE_TYPE (lhs
), result
);
2308 /* Now we have handled acceptable kinds of LHS that are not truly lvalues.
2309 Reject anything strange now. */
2311 if (!lvalue_or_else (lhs
, "assignment"))
2312 return error_mark_node
;
2314 /* FIXME: need to generate a RANGEFAIL if the RHS won't
2315 fit into the LHS. */
2317 if (TREE_CODE (lhs
) != VAR_DECL
2318 && ((TREE_CODE (TREE_TYPE (lhs
)) == ARRAY_TYPE
&&
2319 (TREE_TYPE (rhs
) && TREE_CODE (TREE_TYPE (rhs
)) == ARRAY_TYPE
)) ||
2320 chill_varying_type_p (TREE_TYPE (lhs
)) ||
2321 chill_varying_type_p (TREE_TYPE (rhs
))))
2323 int lhs_varying
= chill_varying_type_p (TREE_TYPE (lhs
));
2324 int rhs_varying
= chill_varying_type_p (TREE_TYPE (rhs
));
2326 /* point at actual RHS data's type */
2327 tree rhs_data_type
= rhs_varying
?
2328 CH_VARYING_ARRAY_TYPE (TREE_TYPE (rhs
)) :
2331 /* point at actual LHS data's type */
2332 tree lhs_data_type
= lhs_varying
?
2333 CH_VARYING_ARRAY_TYPE (TREE_TYPE (lhs
)) :
2336 int lhs_bytes
= int_size_in_bytes (lhs_data_type
);
2337 int rhs_bytes
= int_size_in_bytes (rhs_data_type
);
2339 /* if both sides not varying, and sizes not dynamically
2340 computed, sizes must *match* */
2341 if (! lhs_varying
&& ! rhs_varying
&& lhs_bytes
!= rhs_bytes
2342 && lhs_bytes
> 0 && rhs_bytes
> 0)
2344 error ("string lengths not equal");
2345 return error_mark_node
;
2347 /* Must have enough space on LHS for static size of RHS */
2349 if (lhs_bytes
> 0 && rhs_bytes
> 0
2350 && lhs_bytes
< rhs_bytes
)
2354 /* FIXME: generate runtime test for room */
2359 error ("can't do ARRAY assignment - too large");
2360 return error_mark_node
;
2365 /* now we know the RHS will fit in LHS, build trees for the
2366 emit_block_move parameters */
2369 rhs
= convert (TREE_TYPE (lhs
), rhs
);
2373 rhs
= build_component_ref (rhs
, var_data_id
);
2375 if (! mark_addressable (rhs
))
2377 error ("rhs of array assignment is not addressable");
2378 return error_mark_node
;
2381 lhs
= force_addr_of (lhs
);
2382 rhs
= build1 (ADDR_EXPR
, const_ptr_type_node
, rhs
);
2384 build_chill_function_call (lookup_name (get_identifier ("memmove")),
2385 tree_cons (NULL_TREE
, lhs
,
2386 tree_cons (NULL_TREE
, rhs
,
2387 tree_cons (NULL_TREE
, size_in_bytes (rhs_data_type
),
2392 result
= build (MODIFY_EXPR
, lhstype
, lhs
, rhs
);
2393 TREE_SIDE_EFFECTS (result
) = 1;
2398 /* Constructors for pointer, array and function types.
2399 (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
2400 constructed by language-dependent code, not here.) */
2402 /* Construct, lay out and return the type of pointers to TO_TYPE.
2403 If such a type has already been constructed, reuse it. */
2406 make_chill_pointer_type (to_type
, code
)
2408 enum tree_code code
; /* POINTER_TYPE or REFERENCE_TYPE */
2410 extern struct obstack
*current_obstack
;
2411 extern struct obstack
*saveable_obstack
;
2412 extern struct obstack permanent_obstack
;
2414 register struct obstack
*ambient_obstack
= current_obstack
;
2415 register struct obstack
*ambient_saveable_obstack
= saveable_obstack
;
2417 /* If TO_TYPE is permanent, make this permanent too. */
2418 if (TREE_PERMANENT (to_type
))
2420 current_obstack
= &permanent_obstack
;
2421 saveable_obstack
= &permanent_obstack
;
2424 t
= make_node (code
);
2425 TREE_TYPE (t
) = to_type
;
2427 current_obstack
= ambient_obstack
;
2428 saveable_obstack
= ambient_saveable_obstack
;
2434 build_chill_pointer_type (to_type
)
2437 int is_type_node
= TREE_CODE_CLASS (TREE_CODE (to_type
)) == 't';
2438 register tree t
= is_type_node
? TYPE_POINTER_TO (to_type
) : NULL_TREE
;
2440 /* First, if we already have a type for pointers to TO_TYPE, use it. */
2445 /* We need a new one. */
2446 t
= make_chill_pointer_type (to_type
, POINTER_TYPE
);
2448 /* Lay out the type. This function has many callers that are concerned
2449 with expression-construction, and this simplifies them all.
2450 Also, it guarantees the TYPE_SIZE is permanent if the type is. */
2451 if ((is_type_node
&& (TYPE_SIZE (to_type
) != NULL_TREE
))
2454 /* Record this type as the pointer to TO_TYPE. */
2455 TYPE_POINTER_TO (to_type
) = t
;
2463 build_chill_reference_type (to_type
)
2466 int is_type_node
= TREE_CODE_CLASS (TREE_CODE (to_type
)) == 't';
2467 register tree t
= is_type_node
? TYPE_REFERENCE_TO (to_type
) : NULL_TREE
;
2469 /* First, if we already have a type for references to TO_TYPE, use it. */
2474 /* We need a new one. */
2475 t
= make_chill_pointer_type (to_type
, REFERENCE_TYPE
);
2477 /* Lay out the type. This function has many callers that are concerned
2478 with expression-construction, and this simplifies them all.
2479 Also, it guarantees the TYPE_SIZE is permanent if the type is. */
2480 if ((is_type_node
&& (TYPE_SIZE (to_type
) != NULL_TREE
))
2483 /* Record this type as the reference to TO_TYPE. */
2484 TYPE_REFERENCE_TO (to_type
) = t
;
2486 CH_NOVELTY (t
) = CH_NOVELTY (to_type
);
2493 make_chill_range_type (type
, lowval
, highval
)
2494 tree type
, lowval
, highval
;
2496 register tree itype
= make_node (INTEGER_TYPE
);
2497 TREE_TYPE (itype
) = type
;
2498 TYPE_MIN_VALUE (itype
) = lowval
;
2499 TYPE_MAX_VALUE (itype
) = highval
;
2504 layout_chill_range_type (rangetype
, must_be_const
)
2508 tree type
= TREE_TYPE (rangetype
);
2509 tree lowval
= TYPE_MIN_VALUE (rangetype
);
2510 tree highval
= TYPE_MAX_VALUE (rangetype
);
2513 if (TYPE_SIZE (rangetype
) != NULL_TREE
)
2517 if (type
== ridpointers
[(int) RID_BIN
])
2521 /* make a range out of it */
2522 if (TREE_CODE (highval
) != INTEGER_CST
)
2524 error ("non-constant expression for BIN");
2525 return error_mark_node
;
2527 binsize
= TREE_INT_CST_LOW (highval
);
2530 error ("expression for BIN must not be negative");
2531 return error_mark_node
;
2535 error ("cannot process BIN (>32)");
2536 return error_mark_node
;
2538 type
= ridpointers
[(int) RID_RANGE
];
2539 lowval
= integer_zero_node
;
2540 highval
= build_int_2 ((1 << binsize
) - 1, 0);
2543 if (TREE_CODE (lowval
) == ERROR_MARK
||
2544 TREE_CODE (highval
) == ERROR_MARK
)
2545 return error_mark_node
;
2547 if (!CH_COMPATIBLE_CLASSES (lowval
, highval
))
2549 error ("bounds of range are not compatible");
2550 return error_mark_node
;
2553 if (type
== string_index_type_dummy
)
2555 if (TREE_CODE (highval
) == INTEGER_CST
2556 && compare_int_csts (LT_EXPR
, highval
, integer_minus_one_node
))
2558 error ("negative string length");
2559 highval
= integer_minus_one_node
;
2561 if (compare_int_csts (EQ_EXPR
, highval
, integer_minus_one_node
))
2562 type
= integer_type_node
;
2565 TREE_TYPE (rangetype
) = type
;
2567 else if (type
== ridpointers
[(int) RID_RANGE
])
2569 /* This isn't 100% right, since the Blue Book definition
2570 uses Resulting Class, rather than Resulting Mode,
2571 but it's close enough. */
2572 type
= CH_ROOT_RESULTING_CLASS (lowval
, highval
).mode
;
2574 /* The default TYPE is the type of the constants -
2575 except if the constants are integers, we choose an
2576 integer type that fits. */
2577 if (TREE_CODE (type
) == INTEGER_TYPE
2578 && TREE_CODE (lowval
) == INTEGER_CST
2579 && TREE_CODE (highval
) == INTEGER_CST
)
2581 /* The logic of this code has been copied from finish_enum
2582 in c-decl.c. FIXME duplication! */
2584 HOST_WIDE_INT maxvalue
= TREE_INT_CST_LOW (highval
);
2585 HOST_WIDE_INT minvalue
= TREE_INT_CST_LOW (lowval
);
2586 if (TREE_INT_CST_HIGH (lowval
) >= 0
2587 ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node
), highval
)
2588 : (tree_int_cst_lt (lowval
, TYPE_MIN_VALUE (integer_type_node
))
2589 || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node
), highval
)))
2590 precision
= TYPE_PRECISION (long_long_integer_type_node
);
2594 precision
= floor_log2 (maxvalue
) + 1;
2597 /* Compute number of bits to represent magnitude of a
2598 negative value. Add one to MINVALUE since range of
2599 negative numbers includes the power of two. */
2600 int negprecision
= floor_log2 (-minvalue
- 1) + 1;
2601 if (negprecision
> precision
)
2602 precision
= negprecision
;
2603 precision
+= 1; /* room for sign bit */
2609 type
= type_for_size (precision
, minvalue
>= 0);
2612 TREE_TYPE (rangetype
) = type
;
2616 if (!CH_COMPATIBLE (lowval
, type
))
2618 error ("range's lower bound and parent mode don't match");
2619 return integer_type_node
; /* an innocuous fake */
2621 if (!CH_COMPATIBLE (highval
, type
))
2623 error ("range's upper bound and parent mode don't match");
2624 return integer_type_node
; /* an innocuous fake */
2628 if (TREE_CODE (type
) == ERROR_MARK
)
2630 else if (TREE_CODE_CLASS (TREE_CODE (type
)) != 't')
2632 error ("making range from non-mode");
2633 return error_mark_node
;
2636 if (TREE_CODE (lowval
) == REAL_CST
|| TREE_CODE (highval
) == REAL_CST
)
2638 sorry ("floating point ranges");
2639 return integer_type_node
; /* another fake */
2642 if (TREE_CODE (lowval
) != INTEGER_CST
|| TREE_CODE (highval
) != INTEGER_CST
)
2646 error ("range mode has non-constant limits");
2650 else if (tree_int_cst_equal (lowval
, integer_zero_node
)
2651 && tree_int_cst_equal (highval
, integer_minus_one_node
))
2652 ; /* do nothing - this is the index type for an empty string */
2653 else if (compare_int_csts (LT_EXPR
, highval
, TYPE_MIN_VALUE (type
)))
2655 error ("range's high bound < mode's low bound");
2658 else if (compare_int_csts (GT_EXPR
, highval
, TYPE_MAX_VALUE (type
)))
2660 error ("range's high bound > mode's high bound");
2663 else if (compare_int_csts (LT_EXPR
, highval
, lowval
))
2665 error ("range mode high bound < range mode low bound");
2668 else if (compare_int_csts (LT_EXPR
, lowval
, TYPE_MIN_VALUE (type
)))
2670 error ("range's low bound < mode's low bound");
2673 else if (compare_int_csts (GT_EXPR
, lowval
, TYPE_MAX_VALUE (type
)))
2675 error ("range's low bound > mode's high bound");
2681 lowval
= TYPE_MIN_VALUE (type
);
2685 highval
= convert (type
, highval
);
2686 lowval
= convert (type
, lowval
);
2687 TYPE_MIN_VALUE (rangetype
) = lowval
;
2688 TYPE_MAX_VALUE (rangetype
) = highval
;
2689 TYPE_PRECISION (rangetype
) = TYPE_PRECISION (type
);
2690 TYPE_MODE (rangetype
) = TYPE_MODE (type
);
2691 TYPE_SIZE (rangetype
) = TYPE_SIZE (type
);
2692 TYPE_SIZE_UNIT (rangetype
) = TYPE_SIZE_UNIT (type
);
2693 TYPE_ALIGN (rangetype
) = TYPE_ALIGN (type
);
2694 TREE_UNSIGNED (rangetype
) = TREE_UNSIGNED (type
);
2695 CH_NOVELTY (rangetype
) = CH_NOVELTY (type
);
2699 /* Build a _TYPE node that has range bounds associated with its values.
2700 TYPE is the base type for the range type. */
2702 build_chill_range_type (type
, lowval
, highval
)
2703 tree type
, lowval
, highval
;
2707 if (type
== NULL_TREE
)
2708 type
= ridpointers
[(int) RID_RANGE
];
2709 else if (TREE_CODE (type
) == ERROR_MARK
)
2710 return error_mark_node
;
2712 rangetype
= make_chill_range_type (type
, lowval
, highval
);
2714 rangetype
= layout_chill_range_type (rangetype
, 0);
2719 /* Build a CHILL array type, but with minimal checking etc. */
2722 build_simple_array_type (type
, idx
, layout
)
2723 tree type
, idx
, layout
;
2725 tree array_type
= make_node (ARRAY_TYPE
);
2726 TREE_TYPE (array_type
) = type
;
2727 TYPE_DOMAIN (array_type
) = idx
;
2728 TYPE_ATTRIBUTES (array_type
) = layout
;
2730 array_type
= layout_chill_array_type (array_type
);
2735 apply_chill_array_layout (array_type
)
2738 tree layout
, temp
, what
, element_type
;
2739 int stepsize
=0, word
, start_bit
=0, length
, natural_length
;
2740 int stepsize_specified
;
2741 int start_bit_error
= 0;
2742 int length_error
= 0;
2744 layout
= TYPE_ATTRIBUTES (array_type
);
2745 if (layout
== NULL_TREE
)
2748 if (layout
== integer_zero_node
) /* NOPACK */
2750 TYPE_PACKED (array_type
) = 0;
2754 /* Allow for the packing of 1 bit discrete modes at the bit level. */
2755 element_type
= TREE_TYPE (array_type
);
2756 if (discrete_type_p (element_type
)
2757 && get_type_precision (TYPE_MIN_VALUE (element_type
),
2758 TYPE_MAX_VALUE (element_type
)) == 1)
2761 natural_length
= TREE_INT_CST_LOW (TYPE_SIZE (element_type
));
2763 if (layout
== integer_one_node
) /* PACK */
2765 if (natural_length
== 1)
2766 TYPE_PACKED (array_type
) = 1;
2770 /* The layout is a STEP (...).
2771 The current implementation restricts STEP specifications to be of the form
2772 STEP(POS(0,0,n),n) where n is the natural size of the element mode. */
2773 stepsize_specified
= 0;
2774 temp
= TREE_VALUE (layout
);
2775 if (TREE_VALUE (temp
) != NULL_TREE
)
2777 if (TREE_CODE (TREE_VALUE (temp
)) != INTEGER_CST
)
2778 error ("Stepsize in STEP must be an integer constant");
2781 stepsize
= TREE_INT_CST_LOW (TREE_VALUE (temp
));
2783 error ("Stepsize in STEP must be > 0");
2785 stepsize_specified
= 1;
2787 if (stepsize
!= natural_length
)
2788 sorry ("Stepsize in STEP must be the natural width of the array element mode");
2792 temp
= TREE_PURPOSE (temp
);
2793 if (TREE_CODE (TREE_PURPOSE (temp
)) != INTEGER_CST
)
2794 error ("Starting word in POS must be an integer constant");
2797 word
= TREE_INT_CST_LOW (TREE_PURPOSE (temp
));
2799 error ("Starting word in POS must be >= 0");
2801 sorry ("Starting word in POS within STEP must be 0");
2804 length
= natural_length
;
2805 temp
= TREE_VALUE (temp
);
2806 if (temp
!= NULL_TREE
)
2808 int wordsize
= TYPE_PRECISION (chill_integer_type_node
);
2809 if (TREE_CODE (TREE_PURPOSE (temp
)) != INTEGER_CST
)
2811 error ("Starting bit in POS must be an integer constant");
2812 start_bit_error
= 1;
2816 start_bit
= TREE_INT_CST_LOW (TREE_PURPOSE (temp
));
2818 sorry ("Starting bit in POS within STEP must be 0");
2821 error ("Starting bit in POS must be >= 0");
2823 start_bit_error
= 1;
2825 else if (start_bit
>= wordsize
)
2827 error ("Starting bit in POS must be < the width of a word");
2829 start_bit_error
= 1;
2833 temp
= TREE_VALUE (temp
);
2834 if (temp
!= NULL_TREE
)
2836 what
= TREE_PURPOSE (temp
);
2837 if (what
== integer_zero_node
)
2839 if (TREE_CODE (TREE_VALUE (temp
)) != INTEGER_CST
)
2841 error ("Length in POS must be an integer constant");
2846 length
= TREE_INT_CST_LOW (TREE_VALUE (temp
));
2848 error ("Length in POS must be > 0");
2853 if (TREE_CODE (TREE_VALUE (temp
)) != INTEGER_CST
)
2855 error ("End bit in POS must be an integer constant");
2860 int end_bit
= TREE_INT_CST_LOW (TREE_VALUE (temp
));
2861 if (end_bit
< start_bit
)
2863 error ("End bit in POS must be >= the start bit");
2864 end_bit
= wordsize
- 1;
2867 else if (end_bit
>= wordsize
)
2869 error ("End bit in POS must be < the width of a word");
2870 end_bit
= wordsize
- 1;
2873 else if (start_bit_error
)
2876 length
= end_bit
- start_bit
+ 1;
2879 if (! length_error
&& length
!= natural_length
)
2881 sorry ("The length specified on POS within STEP must be the natural length of the array element type");
2886 if (! length_error
&& stepsize_specified
&& stepsize
< length
)
2887 error ("Step size in STEP must be >= the length in POS");
2890 TYPE_PACKED (array_type
) = 1;
2894 layout_chill_array_type (array_type
)
2898 tree element_type
= TREE_TYPE (array_type
);
2900 if (TREE_CODE (element_type
) == ARRAY_TYPE
2901 && TYPE_SIZE (element_type
) == 0)
2902 layout_chill_array_type (element_type
);
2904 itype
= TYPE_DOMAIN (array_type
);
2906 if (TREE_CODE (itype
) == ERROR_MARK
2907 || TREE_CODE (element_type
) == ERROR_MARK
)
2908 return error_mark_node
;
2910 /* do a lower/upper bound check. */
2911 if (TREE_CODE (itype
) == INTEGER_CST
)
2913 error ("array index must be a range, not a single integer");
2914 return error_mark_node
;
2916 if (TREE_CODE_CLASS (TREE_CODE (itype
)) != 't'
2917 || !discrete_type_p (itype
))
2919 error ("array index is not a discrete mode");
2920 return error_mark_node
;
2923 /* apply the array layout, if specified. */
2924 apply_chill_array_layout (array_type
);
2925 TYPE_ATTRIBUTES (array_type
) = NULL_TREE
;
2927 /* Make sure TYPE_POINTER_TO (element_type) is filled in. */
2928 build_pointer_type (element_type
);
2930 if (TYPE_SIZE (array_type
) == 0)
2931 layout_type (array_type
);
2933 if (TYPE_READONLY_PROPERTY (element_type
))
2934 TYPE_FIELDS_READONLY (array_type
) = 1;
2936 TYPE_ARRAY_MAX_SIZE (array_type
) = size_in_bytes (array_type
);
2940 /* Build a CHILL array type.
2942 TYPE is the element type of the array.
2943 IDXLIST is the list of dimensions of the array.
2944 VARYING_P is non-zero if the array is a varying array.
2945 LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
2946 meaning (default, pack, nopack, STEP (...) ). */
2948 build_chill_array_type (type
, idxlist
, varying_p
, layouts
)
2953 tree array_type
= type
;
2955 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
2956 return error_mark_node
;
2957 if (idxlist
== NULL_TREE
|| TREE_CODE (idxlist
) == ERROR_MARK
)
2958 return error_mark_node
;
2960 /* We have to walk down the list of index decls, building inner
2961 array types as we go. We need to reverse the list of layouts so that the
2962 first layout applies to the last index etc. */
2963 layouts
= nreverse (layouts
);
2964 for ( ; idxlist
; idxlist
= TREE_CHAIN (idxlist
))
2966 if (layouts
!= NULL_TREE
)
2968 type
= build_simple_array_type (
2969 type
, TREE_VALUE (idxlist
), TREE_VALUE (layouts
));
2970 layouts
= TREE_CHAIN (layouts
);
2973 type
= build_simple_array_type (type
, TREE_VALUE (idxlist
), NULL_TREE
);
2977 array_type
= build_varying_struct (array_type
);
2981 /* Function to help qsort sort FIELD_DECLs by name order. */
2984 field_decl_cmp (x
, y
)
2987 return (long)DECL_NAME (*x
) - (long)DECL_NAME (*y
);
2991 make_chill_struct_type (fieldlist
)
2996 t
= make_node (TREE_UNION_ELEM (fieldlist
) ? UNION_TYPE
: RECORD_TYPE
);
2998 /* Install struct as DECL_CONTEXT of each field decl. */
2999 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3000 DECL_CONTEXT (x
) = t
;
3002 /* Delete all duplicate fields from the fieldlist */
3003 for (x
= fieldlist
; x
&& TREE_CHAIN (x
);)
3004 /* Anonymous fields aren't duplicates. */
3005 if (DECL_NAME (TREE_CHAIN (x
)) == 0)
3009 register tree y
= fieldlist
;
3013 if (DECL_NAME (y
) == DECL_NAME (TREE_CHAIN (x
)))
3019 if (DECL_NAME (y
) == DECL_NAME (TREE_CHAIN (x
)))
3021 error_with_decl (TREE_CHAIN (x
), "duplicate member `%s'");
3022 TREE_CHAIN (x
) = TREE_CHAIN (TREE_CHAIN (x
));
3024 else x
= TREE_CHAIN (x
);
3027 TYPE_FIELDS (t
) = fieldlist
;
3032 /* DECL is a FIELD_DECL.
3034 (NULL_TREE, integer_one_node, integer_zero_node, tree_list)
3036 (default, pack, nopack, POS (...) ).
3038 The return value is a boolean: 1 if POS specified, 0 if not */
3041 apply_chill_field_layout (decl
, next_struct_offset
)
3043 int *next_struct_offset
;
3045 tree layout
= DECL_INITIAL (decl
);
3046 tree type
= TREE_TYPE (decl
);
3048 HOST_WIDE_INT word
= 0;
3049 HOST_WIDE_INT wordsize
, start_bit
, offset
, length
, natural_length
;
3051 int is_discrete
= discrete_type_p (type
);
3055 = get_type_precision (TYPE_MIN_VALUE (type
), TYPE_MAX_VALUE (type
));
3057 natural_length
= TREE_INT_CST_LOW (TYPE_SIZE (type
));
3059 if (layout
== integer_zero_node
) /* NOPACK */
3061 *next_struct_offset
+= natural_length
;
3062 return 0; /* not POS */
3065 if (layout
== integer_one_node
) /* PACK */
3069 DECL_BIT_FIELD (decl
) = 1;
3070 DECL_SIZE (decl
) = bitsize_int (natural_length
);
3073 DECL_ALIGN (decl
) = BITS_PER_UNIT
;
3075 DECL_PACKED (decl
) = 1;
3076 *next_struct_offset
+= natural_length
;
3077 return 0; /* not POS */
3080 /* The layout is a POS (...). The current implementation restricts the use
3081 of POS to monotonically increasing fields whose width must be the
3082 natural width of the underlying type. */
3083 temp
= TREE_PURPOSE (layout
);
3085 if (TREE_CODE (TREE_PURPOSE (temp
)) != INTEGER_CST
)
3087 error ("Starting word in POS must be an integer constant");
3092 word
= TREE_INT_CST_LOW (TREE_PURPOSE (temp
));
3093 if (tree_int_cst_sgn (TREE_PURPOSE (temp
)) < 0)
3095 error ("Starting word in POS must be >= 0");
3101 wordsize
= TYPE_PRECISION (chill_integer_type_node
);
3102 offset
= word
* wordsize
;
3103 length
= natural_length
;
3105 temp
= TREE_VALUE (temp
);
3106 if (temp
!= NULL_TREE
)
3108 if (TREE_CODE (TREE_PURPOSE (temp
)) != INTEGER_CST
)
3110 error ("Starting bit in POS must be an integer constant");
3111 start_bit
= *next_struct_offset
- offset
;
3116 start_bit
= TREE_INT_CST_LOW (TREE_PURPOSE (temp
));
3117 if (tree_int_cst_sgn (TREE_PURPOSE (temp
)) < 0)
3119 error ("Starting bit in POS must be >= 0");
3120 start_bit
= *next_struct_offset
- offset
;
3123 else if (start_bit
>= wordsize
)
3125 error ("Starting bit in POS must be < the width of a word");
3126 start_bit
= *next_struct_offset
- offset
;
3131 temp
= TREE_VALUE (temp
);
3132 if (temp
!= NULL_TREE
)
3134 what
= TREE_PURPOSE (temp
);
3135 if (what
== integer_zero_node
)
3137 if (TREE_CODE (TREE_VALUE (temp
)) != INTEGER_CST
)
3139 error ("Length in POS must be an integer constant");
3144 length
= TREE_INT_CST_LOW (TREE_VALUE (temp
));
3145 if (tree_int_cst_sgn (TREE_VALUE (temp
)) < 0)
3147 error ("Length in POS must be > 0");
3148 length
= natural_length
;
3155 if (TREE_CODE (TREE_VALUE (temp
)) != INTEGER_CST
)
3157 error ("End bit in POS must be an integer constant");
3162 HOST_WIDE_INT end_bit
= TREE_INT_CST_LOW (TREE_VALUE (temp
));
3164 if (end_bit
< start_bit
)
3166 error ("End bit in POS must be >= the start bit");
3169 else if (end_bit
>= wordsize
)
3171 error ("End bit in POS must be < the width of a word");
3175 length
= end_bit
- start_bit
+ 1;
3179 if (length
!= natural_length
&& ! pos_error
)
3181 sorry ("The length specified on POS must be the natural length of the field type");
3182 length
= natural_length
;
3186 offset
+= start_bit
;
3189 if (offset
!= *next_struct_offset
&& ! pos_error
)
3190 sorry ("STRUCT fields must be layed out in monotonically increasing order");
3192 DECL_PACKED (decl
) = 1;
3193 DECL_BIT_FIELD (decl
) = is_discrete
;
3196 DECL_SIZE (decl
) = bitsize_int (length
);
3198 *next_struct_offset
+= natural_length
;
3200 return 1; /* was POS */
3204 layout_chill_struct_type (t
)
3207 tree fieldlist
= TYPE_FIELDS (t
);
3213 int next_struct_offset
;
3215 old_momentary
= suspend_momentary ();
3217 /* Process specified field sizes. */
3218 next_struct_offset
= 0;
3219 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3221 /* An EVENT or BUFFER mode is implemented as a RECORD_TYPE
3222 which may contain a CONST_DECL for the maximum queue size. */
3223 if (TREE_CODE (x
) == CONST_DECL
)
3226 /* If any field is const, the structure type is pseudo-const. */
3227 /* A field that is pseudo-const makes the structure likewise. */
3228 if (TREE_READONLY (x
) || TYPE_READONLY_PROPERTY (TREE_TYPE (x
)))
3229 TYPE_FIELDS_READONLY (t
) = 1;
3231 /* Any field that is volatile means variables of this type must be
3232 treated in some ways as volatile. */
3233 if (TREE_THIS_VOLATILE (x
))
3234 C_TYPE_FIELDS_VOLATILE (t
) = 1;
3236 if (DECL_INITIAL (x
) != NULL_TREE
)
3238 was_pos
= apply_chill_field_layout (x
, &next_struct_offset
);
3239 DECL_INITIAL (x
) = NULL_TREE
;
3243 unsigned int min_align
= TYPE_ALIGN (TREE_TYPE (x
));
3244 DECL_ALIGN (x
) = MAX (DECL_ALIGN (x
), min_align
);
3247 if ((! was_pos
&& pos_seen
) || (was_pos
&& ! pos_seen
&& x
!= fieldlist
))
3249 pos_seen
|= was_pos
;
3253 error ("If one field has a POS layout, then all fields must have a POS layout");
3255 /* Now DECL_INITIAL is null on all fields. */
3259 /* Now we have the truly final field list.
3260 Store it in this type and in the variants. */
3262 TYPE_FIELDS (t
) = fieldlist
;
3264 /* If there are lots of fields, sort so we can look through them fast.
3265 We arbitrarily consider 16 or more elts to be "a lot". */
3269 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3280 len
+= list_length (x
);
3281 /* Use the same allocation policy here that make_node uses, to
3282 ensure that this lives as long as the rest of the struct decl.
3283 All decls in an inline function need to be saved. */
3284 if (allocation_temporary_p ())
3285 space
= savealloc (sizeof (struct lang_type
) + len
* sizeof (tree
));
3287 space
= oballoc (sizeof (struct lang_type
) + len
* sizeof (tree
));
3289 TYPE_LANG_SPECIFIC (t
) = (struct lang_type
*) space
;
3290 TYPE_LANG_SPECIFIC (t
)->foo
.rec
.len
= len
;
3292 field_array
= &TYPE_LANG_SPECIFIC (t
)->foo
.rec
.elts
[0];
3294 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
3295 field_array
[len
++] = x
;
3297 qsort (field_array
, len
, sizeof (tree
),
3298 (int (*) PARAMS ((const void *, const void *))) field_decl_cmp
);
3302 for (x
= TYPE_MAIN_VARIANT (t
); x
; x
= TYPE_NEXT_VARIANT (x
))
3304 TYPE_FIELDS (x
) = TYPE_FIELDS (t
);
3305 TYPE_LANG_SPECIFIC (x
) = TYPE_LANG_SPECIFIC (t
);
3306 TYPE_ALIGN (x
) = TYPE_ALIGN (t
);
3309 resume_momentary (old_momentary
);
3314 /* Given a list of fields, FIELDLIST, return a structure
3315 type that contains these fields. The returned type is
3316 always a new type. */
3318 build_chill_struct_type (fieldlist
)
3323 if (fieldlist
== NULL_TREE
|| TREE_CODE (fieldlist
) == ERROR_MARK
)
3324 return error_mark_node
;
3326 t
= make_chill_struct_type (fieldlist
);
3328 t
= layout_chill_struct_type (t
);
3330 /* pushtag (NULL_TREE, t); */
3335 /* Fix a LANG_TYPE. These are used for three different uses:
3336 - representing a 'READ M' (in which case TYPE_READONLY is set);
3337 - for a NEWMODE or SYNMODE (CH_NOVELTY is set for a NEWMODE); and
3338 - for a parameterised type (TREE_TYPE points to base type,
3339 while TYPE_DOMAIN is the parameter or parameter list).
3340 Called from satisfy. */
3342 smash_dummy_type (type
)
3345 /* Save fields that we don't want to copy from ORIGIN. */
3346 tree origin
= TREE_TYPE (type
);
3347 tree main_tree
= TYPE_MAIN_VARIANT (origin
);
3348 int save_uid
= TYPE_UID (type
);
3349 struct obstack
*save_obstack
= TYPE_OBSTACK (type
);
3350 tree save_name
= TYPE_NAME (type
);
3351 int save_permanent
= TREE_PERMANENT (type
);
3352 int save_readonly
= TYPE_READONLY (type
);
3353 tree save_novelty
= CH_NOVELTY (type
);
3354 tree save_domain
= TYPE_DOMAIN (type
);
3356 if (origin
== NULL_TREE
)
3361 if (TREE_CODE (save_domain
) == ERROR_MARK
)
3362 return error_mark_node
;
3363 if (origin
== char_type_node
)
3364 { /* Old-fashioned CHAR(N) declaration. */
3365 origin
= build_string_type (origin
, save_domain
);
3368 { /* Handle parameterised modes. */
3369 int is_varying
= chill_varying_type_p (origin
);
3370 tree new_max
= save_domain
;
3371 tree origin_novelty
= CH_NOVELTY (origin
);
3373 origin
= CH_VARYING_ARRAY_TYPE (origin
);
3374 if (CH_STRING_TYPE_P (origin
))
3376 tree oldindex
= TYPE_DOMAIN (origin
);
3377 new_max
= check_range (new_max
, new_max
, NULL_TREE
,
3378 fold (build (PLUS_EXPR
, integer_type_node
,
3379 TYPE_MAX_VALUE (oldindex
),
3380 integer_one_node
)));
3381 origin
= build_string_type (TREE_TYPE (origin
), new_max
);
3383 else if (TREE_CODE (origin
) == ARRAY_TYPE
)
3385 tree oldindex
= TYPE_DOMAIN (origin
);
3386 tree upper
= check_range (new_max
, new_max
, NULL_TREE
,
3387 TYPE_MAX_VALUE (oldindex
));
3389 = build_chill_range_type (TREE_TYPE (oldindex
),
3390 TYPE_MIN_VALUE (oldindex
), upper
);
3391 origin
= build_simple_array_type (TREE_TYPE (origin
), newindex
, NULL_TREE
);
3393 else if (TREE_CODE (origin
) == RECORD_TYPE
)
3395 error ("parameterised structures not implemented");
3396 return error_mark_node
;
3400 error ("invalid parameterised type");
3401 return error_mark_node
;
3404 SET_CH_NOVELTY (origin
, origin_novelty
);
3407 origin
= build_varying_struct (origin
);
3408 SET_CH_NOVELTY (origin
, origin_novelty
);
3411 save_domain
= NULL_TREE
;
3414 if (TREE_CODE (origin
) == ERROR_MARK
)
3415 return error_mark_node
;
3417 *(struct tree_type
*)type
= *(struct tree_type
*)origin
;
3418 /* The following is so that the debug code for
3419 the copy is different from the original type.
3420 The two statements usually duplicate each other
3421 (because they clear fields of the same union),
3422 but the optimizer should catch that. */
3423 TYPE_SYMTAB_POINTER (type
) = 0;
3424 TYPE_SYMTAB_ADDRESS (type
) = 0;
3426 /* Restore fields that we didn't want copied from ORIGIN. */
3427 TYPE_UID (type
) = save_uid
;
3428 TYPE_OBSTACK (type
) = save_obstack
;
3429 TREE_PERMANENT (type
) = save_permanent
;
3430 TYPE_NAME (type
) = save_name
;
3432 TREE_CHAIN (type
) = NULL_TREE
;
3433 TYPE_VOLATILE (type
) = 0;
3434 TYPE_POINTER_TO (type
) = 0;
3435 TYPE_REFERENCE_TO (type
) = 0;
3438 { /* TYPE is READ ORIGIN.
3439 Add this type to the chain of variants of TYPE. */
3440 TYPE_NEXT_VARIANT (type
) = TYPE_NEXT_VARIANT (main_tree
);
3441 TYPE_NEXT_VARIANT (main_tree
) = type
;
3442 TYPE_READONLY (type
) = save_readonly
;
3446 /* TYPE is the copy of the RHS in a NEWMODE or SYNMODE.
3447 We also get here after old-fashioned CHAR(N) declaration (see above). */
3448 TYPE_MAIN_VARIANT (type
) = type
;
3449 TYPE_NEXT_VARIANT (type
) = NULL_TREE
;
3451 DECL_ORIGINAL_TYPE (save_name
) = origin
;
3453 if (save_novelty
!= NULL_TREE
) /* A NEWMODE declaration. */
3455 CH_NOVELTY (type
) = save_novelty
;
3457 /* Z.200: "If the DEFINING mode of the NEWMODE name is a range mode,
3458 then the virtual mode &name is introduced as the PARENT mode
3459 of the NEWMODE name. The DEFINING mode of &name is the PARENT
3460 mode of the range mode, and the NOVELTY of &name is that of
3461 the NEWMODE name." */
3463 if (TREE_CODE (type
) == INTEGER_TYPE
&& TREE_TYPE (type
))
3466 /* PARENT is the virtual mode &name mentioned above. */
3467 push_obstacks_nochange ();
3468 end_temporary_allocation ();
3469 parent
= copy_novelty (save_novelty
,TREE_TYPE (type
));
3472 TREE_TYPE (type
) = parent
;
3473 TYPE_MIN_VALUE (type
) = convert (parent
, TYPE_MIN_VALUE (type
));
3474 TYPE_MAX_VALUE (type
) = convert (parent
, TYPE_MAX_VALUE (type
));
3481 /* This generates a LANG_TYPE node that represents 'READ TYPE'. */
3484 build_readonly_type (type
)
3487 tree node
= make_node (LANG_TYPE
);
3488 TREE_TYPE (node
) = type
;
3489 TYPE_READONLY (node
) = 1;
3491 node
= smash_dummy_type (node
);
3496 /* Return an unsigned type the same as TYPE in other respects. */
3499 unsigned_type (type
)
3502 tree type1
= TYPE_MAIN_VARIANT (type
);
3503 if (type1
== signed_char_type_node
|| type1
== char_type_node
)
3504 return unsigned_char_type_node
;
3505 if (type1
== integer_type_node
)
3506 return unsigned_type_node
;
3507 if (type1
== short_integer_type_node
)
3508 return short_unsigned_type_node
;
3509 if (type1
== long_integer_type_node
)
3510 return long_unsigned_type_node
;
3511 if (type1
== long_long_integer_type_node
)
3512 return long_long_unsigned_type_node
;
3514 return signed_or_unsigned_type (1, type
);
3517 /* Return a signed type the same as TYPE in other respects. */
3523 tree type1
= TYPE_MAIN_VARIANT (type
);
3524 while (TREE_CODE (type1
) == INTEGER_TYPE
&& TREE_TYPE (type1
) != NULL_TREE
)
3525 type1
= TREE_TYPE (type1
);
3526 if (type1
== unsigned_char_type_node
|| type1
== char_type_node
)
3527 return signed_char_type_node
;
3528 if (type1
== unsigned_type_node
)
3529 return integer_type_node
;
3530 if (type1
== short_unsigned_type_node
)
3531 return short_integer_type_node
;
3532 if (type1
== long_unsigned_type_node
)
3533 return long_integer_type_node
;
3534 if (type1
== long_long_unsigned_type_node
)
3535 return long_long_integer_type_node
;
3536 if (TYPE_PRECISION (type1
) == 1)
3537 return signed_boolean_type_node
;
3539 return signed_or_unsigned_type (0, type
);
3542 /* Return a type the same as TYPE except unsigned or
3543 signed according to UNSIGNEDP. */
3546 signed_or_unsigned_type (unsignedp
, type
)
3550 if (! INTEGRAL_TYPE_P (type
)
3551 || TREE_UNSIGNED (type
) == unsignedp
)
3554 if (TYPE_PRECISION (type
) == TYPE_PRECISION (signed_char_type_node
))
3555 return unsignedp
? unsigned_char_type_node
: signed_char_type_node
;
3556 if (TYPE_PRECISION (type
) == TYPE_PRECISION (integer_type_node
))
3557 return unsignedp
? unsigned_type_node
: integer_type_node
;
3558 if (TYPE_PRECISION (type
) == TYPE_PRECISION (short_integer_type_node
))
3559 return unsignedp
? short_unsigned_type_node
: short_integer_type_node
;
3560 if (TYPE_PRECISION (type
) == TYPE_PRECISION (long_integer_type_node
))
3561 return unsignedp
? long_unsigned_type_node
: long_integer_type_node
;
3562 if (TYPE_PRECISION (type
) == TYPE_PRECISION (long_long_integer_type_node
))
3563 return (unsignedp
? long_long_unsigned_type_node
3564 : long_long_integer_type_node
);
3568 /* Mark EXP saying that we need to be able to take the
3569 address of it; it should not be allocated in a register.
3570 Value is 1 if successful. */
3573 mark_addressable (exp
)
3576 register tree x
= exp
;
3578 switch (TREE_CODE (x
))
3585 x
= TREE_OPERAND (x
, 0);
3588 case TRUTH_ANDIF_EXPR
:
3589 case TRUTH_ORIF_EXPR
:
3591 x
= TREE_OPERAND (x
, 1);
3595 return mark_addressable (TREE_OPERAND (x
, 1))
3596 & mark_addressable (TREE_OPERAND (x
, 2));
3599 TREE_ADDRESSABLE (x
) = 1;
3603 /* We sometimes add a cast *(TYPE*)&FOO to handle type and mode
3604 incompatibility problems. Handle this case by marking FOO. */
3605 if (TREE_CODE (TREE_OPERAND (x
, 0)) == NOP_EXPR
3606 && TREE_CODE (TREE_OPERAND (TREE_OPERAND (x
, 0), 0)) == ADDR_EXPR
)
3608 x
= TREE_OPERAND (TREE_OPERAND (x
, 0), 0);
3611 if (TREE_CODE (TREE_OPERAND (x
, 0)) == ADDR_EXPR
)
3613 x
= TREE_OPERAND (x
, 0);
3622 if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
)
3623 && DECL_NONLOCAL (x
))
3625 if (TREE_PUBLIC (x
))
3627 error ("global register variable `%s' used in nested function",
3628 IDENTIFIER_POINTER (DECL_NAME (x
)));
3631 pedwarn ("register variable `%s' used in nested function",
3632 IDENTIFIER_POINTER (DECL_NAME (x
)));
3634 else if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
))
3636 if (TREE_PUBLIC (x
))
3638 error ("address of global register variable `%s' requested",
3639 IDENTIFIER_POINTER (DECL_NAME (x
)));
3643 /* If we are making this addressable due to its having
3644 volatile components, give a different error message. Also
3645 handle the case of an unnamed parameter by not trying
3646 to give the name. */
3648 else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x
)))
3650 error ("cannot put object with volatile field into register");
3654 pedwarn ("address of register variable `%s' requested",
3655 IDENTIFIER_POINTER (DECL_NAME (x
)));
3657 put_var_into_stack (x
);
3661 TREE_ADDRESSABLE (x
) = 1;
3662 #if 0 /* poplevel deals with this now. */
3663 if (DECL_CONTEXT (x
) == 0)
3664 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x
)) = 1;
3672 /* Return an integer type with BITS bits of precision,
3673 that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
3676 type_for_size (bits
, unsignedp
)
3680 if (bits
== TYPE_PRECISION (integer_type_node
))
3681 return unsignedp
? unsigned_type_node
: integer_type_node
;
3683 if (bits
== TYPE_PRECISION (signed_char_type_node
))
3684 return unsignedp
? unsigned_char_type_node
: signed_char_type_node
;
3686 if (bits
== TYPE_PRECISION (short_integer_type_node
))
3687 return unsignedp
? short_unsigned_type_node
: short_integer_type_node
;
3689 if (bits
== TYPE_PRECISION (long_integer_type_node
))
3690 return unsignedp
? long_unsigned_type_node
: long_integer_type_node
;
3692 if (bits
== TYPE_PRECISION (long_long_integer_type_node
))
3693 return (unsignedp
? long_long_unsigned_type_node
3694 : long_long_integer_type_node
);
3696 if (bits
<= TYPE_PRECISION (intQI_type_node
))
3697 return unsignedp
? unsigned_intQI_type_node
: intQI_type_node
;
3699 if (bits
<= TYPE_PRECISION (intHI_type_node
))
3700 return unsignedp
? unsigned_intHI_type_node
: intHI_type_node
;
3702 if (bits
<= TYPE_PRECISION (intSI_type_node
))
3703 return unsignedp
? unsigned_intSI_type_node
: intSI_type_node
;
3705 if (bits
<= TYPE_PRECISION (intDI_type_node
))
3706 return unsignedp
? unsigned_intDI_type_node
: intDI_type_node
;
3708 #if HOST_BITS_PER_WIDE_INT >= 64
3709 if (bits
<= TYPE_PRECISION (intTI_type_node
))
3710 return unsignedp
? unsigned_intTI_type_node
: intTI_type_node
;
3716 /* Return a data type that has machine mode MODE.
3717 If the mode is an integer,
3718 then UNSIGNEDP selects between signed and unsigned types. */
3721 type_for_mode (mode
, unsignedp
)
3722 enum machine_mode mode
;
3725 if ((int)mode
== (int)TYPE_MODE (integer_type_node
))
3726 return unsignedp
? unsigned_type_node
: integer_type_node
;
3728 if ((int)mode
== (int)TYPE_MODE (signed_char_type_node
))
3729 return unsignedp
? unsigned_char_type_node
: signed_char_type_node
;
3731 if ((int)mode
== (int)TYPE_MODE (short_integer_type_node
))
3732 return unsignedp
? short_unsigned_type_node
: short_integer_type_node
;
3734 if ((int)mode
== (int)TYPE_MODE (long_integer_type_node
))
3735 return unsignedp
? long_unsigned_type_node
: long_integer_type_node
;
3737 if ((int)mode
== (int)TYPE_MODE (long_long_integer_type_node
))
3738 return unsignedp
? long_long_unsigned_type_node
: long_long_integer_type_node
;
3740 if ((int)mode
== (int)TYPE_MODE (intQI_type_node
))
3741 return unsignedp
? unsigned_intQI_type_node
: intQI_type_node
;
3743 if ((int)mode
== (int)TYPE_MODE (intHI_type_node
))
3744 return unsignedp
? unsigned_intHI_type_node
: intHI_type_node
;
3746 if ((int)mode
== (int)TYPE_MODE (intSI_type_node
))
3747 return unsignedp
? unsigned_intSI_type_node
: intSI_type_node
;
3749 if ((int)mode
== (int)TYPE_MODE (intDI_type_node
))
3750 return unsignedp
? unsigned_intDI_type_node
: intDI_type_node
;
3752 #if HOST_BITS_PER_WIDE_INT >= 64
3753 if ((int)mode
== (int)TYPE_MODE (intTI_type_node
))
3754 return unsignedp
? unsigned_intTI_type_node
: intTI_type_node
;
3757 if ((int)mode
== (int)TYPE_MODE (float_type_node
))
3758 return float_type_node
;
3760 if ((int)mode
== (int)TYPE_MODE (double_type_node
))
3761 return double_type_node
;
3763 if ((int)mode
== (int)TYPE_MODE (long_double_type_node
))
3764 return long_double_type_node
;
3766 if ((int)mode
== (int)TYPE_MODE (build_pointer_type (char_type_node
)))
3767 return build_pointer_type (char_type_node
);
3769 if ((int)mode
== (int)TYPE_MODE (build_pointer_type (integer_type_node
)))
3770 return build_pointer_type (integer_type_node
);